[Fencommits] fenserve: a simple table of all entries (in Haskell)

[Benja Fallenstein]

Tue May 22 21:40:42 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * a simple table of all entries (in Haskell)
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-22 21:40:59.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-22 21:40:59.000000000 +0300
@@ -9,6 +9,7 @@
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Char (toUpper)
 
 import qualified System.IO.Unsafe
 import qualified Control.Exception
@@ -384,6 +385,13 @@
     f ('$':cs) part = reverse part : f cs ""
     f (c:cs) part = f cs (c:part)
     f "" part = [reverse part]
+    
+showTable :: () -> MyState -> (String, MyState)
+showTable () s = (
+    concatFor (Map.toList $ stateItems s) $ \(_, Item fields _) ->
+        ("<p>"++) . concatFor (Map.toList fields) $ \(f:fs,v) ->
+            "<b>" ++ (toUpper f : fs) ++ ":</b> " ++ v ++ "<br>",
+    s)
 
 main = stdHTTP [ debugFilter
                , h ["potion"] GET $ ok $ \() -> run $ 
@@ -397,6 +405,8 @@
                , h ["edit"] GET $ ok $ \() -> run edit
                , h ["editTemplate"] GET $ seeOther $ \() -> runRedirect editTemplate
                , h ["makefun"] GET $ ok $ \() -> run makeFun
+               , h ["table"] GET $ ok $ \() -> run showTable
+               
                , h [""] GET  $ ok $ \() () -> view
                , h ["addfield"] POST $ ok $ \() (cid,name) -> addField cid name
                , h ["addcat"]   POST $ ok $ \() name -> addCategory name