[Fencommits] fenserve: link items to logs
Benja Fallenstein
benja.fallenstein at gmail.com
Tue May 1 23:00:05 EEST 2007
Tue May 1 22:59:56 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* link items to logs
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs 2007-05-01 23:00:05.000000000 +0300
+++ new-fenserve/notetaker/Main.hs 2007-05-01 23:00:05.000000000 +0300
@@ -22,9 +22,9 @@
instance Binary Line where
-data Note = Note String Bool [Note] deriving (Eq,Ord,Read,Show)
+data Note = Note String Bool [Line] [Note] deriving (Eq,Ord,Read,Show)
-style = "<style type='text/css'>li, p.logline { margin-bottom: 0.3em; margin-top: 0.3em }</style>"
+style = "<style type='text/css'>li, p.logline { margin-bottom: 0.3em; margin-top: 0.3em }\nspan.loglink { color: #aaa; font-size: small }\nspan.loglink a { color: #aaa }</style>"
form nick = "<p><form id='myform' action='/?nick="++nick++"' method='post'>\
\ Nick: <input name='nick' type='text' size=8 \
@@ -46,34 +46,37 @@
(lines :: [Line]) <- get
let r = executeAll lines; p = getPage path r; v = if p == [] then 0 else -1
case getPath p r of
- Just (Note title _ notes) ->
+ Just (Note title _ _ notes) ->
respond $ style ++ "<h2>" ++ renderPath p ++ " " ++ title ++ "</h2>"
++ renderNotes p nick notes ++ views v nick ++ form nick
Nothing -> respond $ "Path not found: " ++ renderPath path
-- get the path of the closest ancestor that is its own page
getPage p note = last $ filter isOwnPage $ inits p where
- isOwnPage q = case getPath q note of Just (Note _ o _) -> o; _ -> False
+ isOwnPage q = case getPath q note of Just (Note _ o _ _) -> o; _ -> False
getPath [] note = Just note
-getPath (i:is) (Note _ _ cs) | i >= 0 && i < length cs = getPath is (cs !! i)
- | otherwise = Nothing
+getPath (i:is) (Note _ _ _ cs) | i >= 0 && i < length cs = getPath is (cs !! i)
+ | otherwise = Nothing
renderNotes p nick notes =
"<ol>" ++ concat [renderNote (p++[i]) (notes !! i)
| i <- [0..length notes - 1]] ++ "</ol>" where
- renderNote p (Note title False cs) = "<li>" ++ title ++ renderNotes p nick cs
- renderNote p (Note title True cs) =
+ link p = " <span class='loglink'>(<a href='/log/"++renderPath p++"'>log</a>)</span>"
+
+ renderNote p (Note title False _ cs) = "<li>" ++ title ++ renderNotes p nick cs ++ link p
+ renderNote p (Note title True _ cs) =
"<li>" ++ title ++ " (<a href='/item/"
++ renderPath p ++ "?nick=" ++ nick ++ "'><i>"
++ countable (length cs) "child" "ren" ++ "</i></a>, "
++ countable (gather ((+1) . sum) 1 cs - 1) "descendant" "s" ++ ", "
- ++ countable (gather ((+1) . maximum) 0 cs) "level" "s" ++ ")"
+ ++ countable (gather ((+1) . maximum) 0 cs) "level" "s" ++ ")" ++ link p
where countable 1 s _ = "1 " ++ s
countable n s pl = printf "%s %s%s" (show n) s pl
gather _ leaf [] = leaf
- gather op leaf cs = op $ map (\(Note _ _ x) -> gather op leaf x) cs
+ gather op leaf cs = op $ map (\(Note _ _ _ x) -> gather op leaf x) cs
+
readPath :: String -> Path
readPath s = readPath' s 0 (\p _ -> p)
@@ -98,34 +101,35 @@
where f s = format (quote s)
-executeAll = foldl (\n (Line _ _ b) -> execute b n) (Note "HOME" True [])
+executeAll = foldl (flip execute) (Note "HOME" True [] [])
. processReverts [] . reverse where
processReverts ls' (Line _ _ (Revert n) : ls) = processReverts ls' (drop n ls)
processReverts ls' (l : ls) = processReverts (l:ls') ls
processReverts ls' [] = ls'
-execute (Body _) = id
-execute body = case body of
- Add p l -> on p $ \(Note t o cs) -> [Note t o (cs++[Note l False []])]
- Edit p l -> on p $ \(Note _ o cs) -> [Note l o cs]
+execute (Line _ _ (Body _)) = id
+execute line@(Line _ _ body) = case body of
+ Add p l -> on p $ \(Note t o ls cs) -> [Note t o ls (cs++[Note l False [line] []])]
+ Edit p l -> on p $ \(Note _ o ls cs) -> [Note l o (ls++[line]) cs]
Move p q -> move p q
- DeleteOne p -> on p $ \(Note _ _ cs) -> cs
- Delete p -> on p $ \(Note _ _ cs) -> []
- MakeOwnPage p -> on p $ \(Note t _ cs) -> [Note t True cs]
- Unpage p -> on p $ \(Note t _ cs) -> [Note t False cs]
+ DeleteOne p -> on p $ \(Note _ _ _ cs) -> cs
+ Delete p -> on p $ \(Note _ _ _ cs) -> []
+ MakeOwnPage p -> on p $ \(Note t _ ls cs) -> [Note t True (ls++[line]) cs]
+ Unpage p -> on p $ \(Note t _ ls cs) -> [Note t False (ls++[line]) cs]
Revert n -> error "execute called on Revert"
where
on is f note = head $ on' is f note
on' [] f note = f note
- on' (i:is) f (Note t o cs) | i < 0 || i >= length cs = [Note t o cs]
- | otherwise =
- [Note t o (take i cs ++ on' is f (cs !! i) ++ drop (i+1) cs)]
+ on' (i:is) f (Note t o ls cs) | i < 0 || i >= length cs = [Note t o ls cs]
+ | otherwise =
+ [Note t o ls (take i cs ++ on' is f (cs !! i) ++ drop (i+1) cs)]
move p q root = case getPath p root of
Nothing -> root
- Just n -> (on p $ \(Note _ _ cs) -> []) $
- (on q $ \(Note t o cs) -> [Note t o (cs++[n])]) $ root
+ Just (Note nt no nls ncs) -> let n = Note nt no (nls++[line]) ncs in
+ (on p $ \(Note _ _ _ _) -> []) $
+ (on q $ \(Note t o ls cs) -> [Note t o ls (cs++[n])]) $ root
getNick m = case lookM m "nick" of Nothing -> "(anon)"; Just "" -> "(anon)"
Just x -> x
@@ -139,10 +143,20 @@
renderLog nick lastlog = do
lines <- if not lastlog then get
else get >>= return . reverse . take 15 . reverse
- respond $ style ++ flip concatMap lines (\(Line time nick body) ->
- "<p class='logline'>" ++ renderTime time ++ " "
- ++ renderBody nick body)
+ respond $ style ++ flip concatMap lines renderLine
++ views (if lastlog then 2 else 1) nick ++ form nick
+
+itemLog nick path = do
+ lines <- get; respond $ case getPath path (executeAll lines) of
+ Nothing -> "Path not found: " ++ renderPath path
+ Just (Note _ _ ls _) -> style ++ concatMap renderLine' ls
+ ++ views (-1) (nick :: String)
+ where renderLine' l@(Line t _ _) =
+ renderLine l ++ " (<a href='/log#"++show t++"'>context</a>)"
+
+renderLine (Line time nick body) =
+ "<p class='logline' id='"++show time++"'>"
+ ++ renderTime time ++ " " ++ renderBody nick body
renderBody :: String -> Body -> String
renderBody nick (Body s) = printf "<<b>%s</b>> %s" nick s
@@ -175,7 +189,7 @@
bodyView (Revert n) nick = page [] nick
export path notes = concatMap f [0..length notes-1] where
- f i | Note title own cs <- notes !! i =
+ f i | Note title own _ cs <- notes !! i =
":add " ++ renderPath path ++ " " ++ unquote (unformat title) ++ "\n"
++ (if own then ":page " ++ renderPath (path++[i]) ++ "\n" else "")
++ export (path++[i]) cs where
@@ -184,9 +198,10 @@
main = stdHTTP [ debugFilter
, h ["log"] GET $ ok $ \() nick -> renderLog nick False
+ , h (Prefix ["log"]) GET $ ok $ \[p] nick -> itemLog nick (readPath p)
, h ["lastlog"] GET $ ok $ \() nick -> renderLog nick True
, h (Prefix ["export"]) GET $ ok $ \[p] () -> do
- lines <- get; let (Note _ _ notes) = executeAll lines
+ lines <- get; let (Note _ _ _ notes) = executeAll lines
respond $ plain $ export (readPath p) notes
, h ["dump"] GET $ ok $ \() () -> get >>= respond . plain . show
, h [""] GET $ ok $ \() nick -> page [] nick
More information about the Fencommits
mailing list