[Fencommits] fenserve: links between the different views

[Benja Fallenstein]

Fri Apr 27 18:47:06 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * links between the different views
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	2007-04-27 18:47:14.000000000 +0300
+++ new-fenserve/notetaker/Main.hs	2007-04-27 18:47:14.000000000 +0300
@@ -16,27 +16,32 @@
 
 data Note = Note String [Note] deriving (Eq,Ord,Read,Show,Typeable)
 
+form nick = "<form id='myform' action='' method='post'>\
+            \    Nick: <input name='nick' type='text' size=8 \
+                             \value='" ++ nick ++ "'> \
+            \    <input name='line' id='myline' type='text' size=60>\
+            \    <input type='submit' value='Submit'>\
+            \</form>\
+            \<script type='text/javascript'>\
+            \    document.forms[0].elements[1].focus();\
+            \</script>"
+
 page nick = do 
     (lines :: [Line]) <- get
     let notes = foldl (flip execute) [] lines
-    respond $ "<form id='myform' action='' method='post'>\
-              \    Nick: <input name='nick' type='text' size=8 \
-                               \value='" ++ nick ++ "'> \
-              \    <input name='line' id='myline' type='text' size=60>\
-              \    <input type='submit' value='Submit'>\
-              \</form>\
-              \<script type='text/javascript'>\
-              \    document.forms[0].elements[1].focus();\
-              \</script>" ++ renderNotes notes
+    respond $ form nick ++ "Views: <b>main</b> | <a href='/log'>log</a><p>"
+           ++ renderNotes notes
                     
 renderNotes notes = "<ol>" ++ concatMap renderNote notes ++ "</ol>" where
     renderNote (Note title children) = "<li>" ++ title ++ renderNotes children
     
-execute (Line _ _ line0) = if ":del " `isPrefixOf` line0 
-                    then delete (map (subtract 1) $ read $ drop 5 line0)
-                    else addToPath (map (subtract 1) path) line where
-    (path, line) = case reads line0 of ((p,l):_) -> (p, dropWhile isSpace l)
-                                       []        -> ([], line0)
+execute (Line _ _ 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 id where
                                        
     delete [i] notes = take i notes ++ drop (i+1) notes
     delete (i:is) notes = take i notes ++ [note'] ++ drop (i+1) notes
@@ -57,12 +62,14 @@
 instance FromMessage (String,String) where
     fromMessageM m = do l <- lookM m "line"; return (getNick m, l)
     
-renderLog = do lines <- get
-               respond $ ("<h1>Log</h1>"++) $ flip concatMap lines $
-                   \(Line t n l) -> printf "&lt;%s&gt; %s<br>" n l :: String
+renderLog nick = do 
+    lines <- get
+    respond $ form nick ++ "Views: <a href='/'>main</a> | <b>log</b><p>"
+           ++ flip concatMap lines 
+                  (\(Line t n l) -> printf "&lt;%s&gt; %s<br>" n l :: String)
     
 main = stdHTTP [ debugFilter
-               , h ["log"] GET $ ok $ \() () -> renderLog
+               , h ["log"] GET $ ok $ \() nick -> renderLog nick
                , h () GET $ ok $ \() nick -> page nick
                , h () POST $ ok $ \() (nick,line) -> do 
                      time <- getTime