[Fencommits] fenserve: make addCategory a redirect

[Benja Fallenstein]

Wed May 23 16:12:03 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * make addCategory a redirect
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-23 16:12:09.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-23 16:12:09.000000000 +0300
@@ -9,7 +9,7 @@
 import qualified Data.Map as Map
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Char (toUpper)
+import Data.Char (toUpper, toLower)
 
 import qualified System.IO.Unsafe
 import qualified Control.Exception
@@ -228,7 +228,7 @@
         field name = name ++ "<br>\n"
     respond $ "<h2>Categories</h2>"
            ++ "<p>Add category: "
-           ++ "<form method=post action=addcat>"
+           ++ "<form method=post action=addCategory>"
            ++ "<input type=text name=name>"
            ++ "</form>"
            ++ concatMap category (Map.toList $ stateSchema state) 
@@ -266,10 +266,8 @@
     put $ state { stateSchema = Map.insert cat (fs ++ [name]) (stateSchema state) }
     view
 
-addCategory cat = do
-    state <- get
-    put $ state { stateSchema = Map.insert cat [] $ stateSchema state}
-    run showTable ()
+addCategory (c:cs) s = ("table",
+    s { stateSchema = Map.insert (toLower c : cs) [] $ stateSchema s})
 
 expand s (Call n args) = case readFun s n of 
     Fun _ _ body -> Just $
@@ -397,7 +395,7 @@
         . concatFor (Map.toList fields) $ \(f:fs,v) ->
             "<b>" ++ (toUpper f : fs) ++ ":</b> " ++ v ++ "<br>",
     s) where new = ("<p><form action='newItem' method=post>" ++) .
-                   (++"<a href='addcat'>[Add category]</a></form>") .
+                   (++"<a href='addCategory'>[Add category]</a></form>") .
                    concatFor (Map.keys $ stateSchema s) $ \cat ->
                        "<button style='cursor: pointer; background: none; border: none; font: inherit; margin: 0; padding: 0' name=cat value='"++cat++"'>[New "++cat++"]</button>"++mdot
                  
@@ -452,11 +450,11 @@
                
                , h [""] GET  $ ok $ \() () -> view
                , h ["addfield"] POST $ ok $ \() (cid,name) -> addField cid name
-               , h ["addcat"]   GET  $ ok $ \() () -> respond $
+               , h ["addCategory"]   GET  $ ok $ \() () -> respond $
                      "<h2>Add category</h2>\
                      \<form method=post>Name: <input name=name>\
                      \<input type=submit value='Submit'></form>"
-               , h ["addcat"]   POST $ ok $ \() name -> addCategory name
+               , h ["addCategory"]   POST $ seeOther $ \() -> runRedirect addCategory
                , h ["addpotion"] POST $ seeOther $ \() -> runRedirect addPotion
                ]