[Fencommits] fenserve: show the right page after editing

[Benja Fallenstein]

Sun Apr 29 17:40:36 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * show the right page after editing
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	2007-04-29 17:40:47.000000000 +0300
+++ new-fenserve/notetaker/Main.hs	2007-04-29 17:40:47.000000000 +0300
@@ -42,13 +42,20 @@
 
 page path nick = do 
     (lines :: [Line]) <- get
-    let v = if path == [] then 0 else -1
-    case getPath path $ executeAll lines of
+    let r = executeAll lines; p = getPage path r; v = if p == [] then 0 else -1
+    case getPath p r of
       Just (Note title _ notes) ->
-        respond $ style ++ "<h2>" ++ renderPath path ++ " " ++ title ++ "</h2>"
-               ++ renderNotes path nick notes ++ views v nick ++ form nick
+        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 = fromMaybe [] $ g p note where
+    f []     _  = Nothing
+    f (i:is) cs | i < 0 || i >= length cs = Nothing
+                | otherwise = fmap (i:) $ g is (cs !! i)
+    g p (Note _ o cs) = f p cs `mplus` (if o then Just [] else Nothing)
+
 getPath [] note = Just note
 getPath (i:is) (Note _ _ cs) | i >= 0 && i < length cs = getPath is (cs !! i)
                              | otherwise = Nothing
@@ -143,6 +150,15 @@
 renderTime t0 = printf "%02u:%02u" (ctHour t) (ctMin t)
     where t = toUTCTime (TOD (fromIntegral t0) 0)
     
+bodyView (Body _) nick = renderLog nick True
+bodyView (Add p _) nick = page p nick
+bodyView (Edit p _) nick = page p nick
+bodyView (Move _ q) nick = page q nick
+bodyView (DeleteOne p) nick = page p nick
+bodyView (Delete p) nick = page p nick
+bodyView (MakeOwnPage p) nick = page p nick
+bodyView (Unpage p) nick = page p nick
+
 main = stdHTTP [ debugFilter
                , h ["log"] GET  $ ok $ \() nick -> renderLog nick False
                , h ["lastlog"] GET  $ ok $ \() nick -> renderLog nick True
@@ -155,8 +171,7 @@
                        else do
                          time <- getTime; let body = readBody line
                          modify (++[Line time nick body])
-                         case body of Body _ -> renderLog nick True
-                                      _      -> page [] nick
+                         bodyView body nick
                , h () POST $ ok $ \() () -> respond "Huh."
                , h (Prefix ["item"]) GET $ ok $ \[p] n -> page (readPath p) n
                ]