[Fencommits] fenserve: add ':edit <path> <newtext>'

[Benja Fallenstein]

Fri Apr 27 20:30:58 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add ':edit <path> <newtext>'
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	2007-04-27 20:31:08.000000000 +0300
+++ new-fenserve/notetaker/Main.hs	2007-04-27 20:31:08.000000000 +0300
@@ -17,7 +17,7 @@
 
 data Note = Note String [Note] deriving (Eq,Ord,Read,Show,Typeable)
 
-form nick = "<form id='myform' action='' method='post'>\
+form nick = "<form id='myform' action='/log' method='post'>\
             \    Nick: <input name='nick' type='text' size=8 \
                              \value='" ++ nick ++ "'> \
             \    <input name='line' id='myline' type='text' size=60>\
@@ -29,7 +29,7 @@
 
 page nick = do 
     (lines :: [Line]) <- get
-    let notes = foldl (flip execute) [] lines
+    let Note _ notes = foldl (flip execute) (Note "HOME" []) lines
     respond $ form nick 
            ++ "Views: <b>main</b> | <a href='/log?nick="++nick++"'>log</a><p>"
            ++ renderNotes notes
@@ -37,23 +37,28 @@
 renderNotes notes = "<ol>" ++ concatMap renderNote notes ++ "</ol>" where
     renderNote (Note title children) = "<li>" ++ title ++ renderNotes children
     
-execute (Line _ _ line0) =
+execute (Line time nick line0) =
     if ":del " `isPrefixOf` line0 
         then delete (map (subtract 1) $ read $ drop 5 line0)
     else if ":add " `isPrefixOf` line0
         then let (path, line1) = head $ reads (drop 5 line0)
               in addToPath (map (subtract 1) path) (dropWhile isSpace line1)
+    else if ":edit " `isPrefixOf` line0
+        then let (path, line1) = head $ reads (drop 6 line0)
+              in edit (map (subtract 1) path) (dropWhile isSpace line1)
     else id where
+    
+    replace i notes' notes = take i notes ++ notes' ++ drop (i+1) notes
                                        
-    delete [i] notes = take i notes ++ drop (i+1) notes
-    delete (i:is) notes = take i notes ++ [note'] ++ drop (i+1) notes
-        where Note title children = notes !! i
-              note' = Note title (delete is children)
+    delete [i]    (Note t cs) = Note t (replace i [] cs)
+    delete (i:is) (Note t cs) = Note t (replace i [delete is $ cs !! i] cs)
                                        
-    addToPath [] line notes = notes ++ [Note line []]
-    addToPath (i:is) line notes = take i notes ++ [note'] ++ drop (i+1) notes
-        where Note title children = notes !! i
-              note' = Note title (addToPath is line children)
+    addToPath []     line (Note t cs) = Note t (cs ++ [Note line []])
+    addToPath (i:is) line (Note t cs) =
+        Note t (replace i [addToPath is line $ cs !! i] cs)
+
+    edit []     line (Note _ cs) = Note line cs
+    edit (i:is) line (Note t cs) = Note t (replace i [edit is line $ cs !! i] cs)
 
 getNick m = case lookM m "nick" of Nothing -> "(anon)"; Just "" -> "(anon)"
                                    Just x  -> x
@@ -69,16 +74,16 @@
     respond $ form nick 
            ++ "Views: <a href='/?nick="++nick++"'>main</a> | <b>log</b><p>"
            ++ flip concatMap lines (\(Line t n l) ->
-               printf "%s &lt;%s&gt; %s<br>" (renderTime t) n l :: String)
+               printf "%s &lt;<b>%s</b>&gt; %s<br>" (renderTime t) n l :: String)
                
 renderTime :: EpochTime -> String
 renderTime t0 = printf "%02u:%02u" (ctHour t) (ctMin t)
     where t = toUTCTime (TOD (fromIntegral t0) 0)
     
 main = stdHTTP [ debugFilter
-               , h ["log"] GET $ ok $ \() nick -> renderLog nick
-               , h () GET $ ok $ \() nick -> page nick
-               , h () POST $ ok $ \() (nick,line) -> do 
+               , h ["log"] GET  $ ok $ \() nick -> renderLog nick
+               , h [""]    GET  $ ok $ \() nick -> page nick
+               , h ["log"] POST $ ok $ \() (nick,line) -> do 
                      time <- getTime
                      modify (++[Line time nick line]); renderLog nick
                , h () POST $ ok $ \() () -> respond "Huh."