[Fencommits] fenserve: add nicks and a log view

[Benja Fallenstein]

Fri Apr 27 18:34:35 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * add nicks and a log view
diff -rN -u old-fenserve/notetaker/Main.hs new-fenserve/notetaker/Main.hs
--- old-fenserve/notetaker/Main.hs	2007-04-27 18:34:47.000000000 +0300
+++ new-fenserve/notetaker/Main.hs	2007-04-27 18:34:47.000000000 +0300
@@ -6,22 +6,34 @@
 import Data.Binary hiding (get,put)
 import Data.Char
 import Data.List (isPrefixOf)
+import Data.Maybe (fromMaybe)
+import Text.Printf
+
+data Line = Line { lineTime :: EpochTime, lineNick :: String, 
+                   lineBody :: String } deriving (Eq,Ord,Read,Show,Typeable)
+                   
+instance Binary Line where
 
 data Note = Note String [Note] deriving (Eq,Ord,Read,Show,Typeable)
 
-page = do lines <- get; let notes = foldl (flip execute) [] lines
-          respond $ "<form id='myform' action='' method='post'>\
-                    \    <input name='line' id='myline' type='text' size=60>\
-                    \</form>\
-                    \<script type='text/javascript'>\
-                    \    document.forms[0].elements[0].focus();\
-                    \</script>" ++ renderNotes notes
+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
                     
 renderNotes notes = "<ol>" ++ concatMap renderNote notes ++ "</ol>" where
     renderNote (Note title children) = "<li>" ++ title ++ renderNotes children
     
-execute line0 = if ":del " `isPrefixOf` line0 
-                    then delete (map (subtract 1) $ read $ drop 5 line)
+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)
@@ -36,12 +48,25 @@
         where Note title children = notes !! i
               note' = Note title (addToPath is line children)
 
+getNick m = case lookM m "nick" of Nothing -> "(anon)"; Just "" -> "(anon)"
+                                   Just x  -> x
+
 instance FromMessage String where
-    fromMessageM m = lookM m "line"
+    fromMessageM m = return (getNick m)
+
+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
     
 main = stdHTTP [ debugFilter
-               , h () GET $ ok $ \() () -> page
-               , h () POST $ ok $ \() line -> do modify (++[line]); page
+               , h ["log"] GET $ ok $ \() () -> renderLog
+               , h () GET $ ok $ \() nick -> page nick
+               , h () POST $ ok $ \() (nick,line) -> do 
+                     time <- getTime
+                     modify (++[Line time nick line]); page nick
                , h () POST $ ok $ \() () -> respond "Huh."
                ]