[Fencommits] fenserve: twid showItem, merge

[Benja Fallenstein]

Fri Jun  1 02:51:41 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * twid showItem, merge
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-06-01 02:51:49.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-06-01 02:51:49.000000000 +0300
@@ -60,8 +60,7 @@
   , formP ""
       ( "Field: " & textfield "name" ""
       , channel ["category", "item"]
-      , hidden "returnTo" $ fromMaybe ("item/"++lookE "item")
-                                      (lookIM "returnTo")
+      , hidden "returnTo" $ lookI "returnTo" ("item/"++lookE "item")
       , submit "Submit" ) )
       
 addFieldPost = runPost (lookE "returnTo")
@@ -69,22 +68,8 @@
   , u_items $ Map.map $ fIf' (`hasCat` (lookE "category")) $ 
         u_fields $ insertIfNew (lookE "name") "" ]
 
-{-addField req state = (returnTo,state') where
-    state' = state { stateSchema = Map.insert cat (fs ++ [name]) (stateSchema state),
-                     stateItems = Map.map addField' (stateItems state) }
-    fs = stateSchema state Map.! cat
-    addField' item@(Item fields cats) 
-                  | cat `Set.member` cats 
-                  = Item (Map.union fields (Map.singleton name "")) cats
-                  | otherwise = item
-    Just cat = lookM req "category"
-    Just item = lookM req "item"
-    Just name = lookM req "field" 
-    returnTo = fromMaybe ("item/"++item) (lookM req "returnTo")-}
-
-addCategory req s = ("table",
-    s { stateSchema = Map.insert (uncapitalize name) ["name"] $ stateSchema s})
-  where Just name = lookM req "name"
+addCategory = runPost "table"
+  [ u_schema $ insertIfNew (uncapitalize $ lookE "name") ["name"] ]
 
 subst :: Int -> Exp -> Exp -> Exp
 subst i repl e = everywhere (mkT f)  e where
@@ -263,12 +248,13 @@
                       \(_, Item _ cats) -> cat `Set.member` cats
           cols = lookRD "cols" (take 1 $ schema Map.! cat)
                  
-showItem :: (?root :: String, ?state :: MyState) => 
+showItem :: (?root :: String, ?state :: MyState, ?req :: Request) => 
             String -> Request -> MyState -> (HTML, MyState)
 showItem item req s = let Item fields cats = stateItems s Map.! read item in (
-  makePage "Item editor" "" $
-    formP "" . ((returnTo&buttons&hr)&) . (&hr&buttons) .
-      catFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
+  makePage "Item editor" "" $ formP ""
+    ( channel ["returnTo"]
+    , buttons, hr
+    , catFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
         ( h3 (capitalize cat)
         , para $ catFor cfs $ \field ->
             (  capitalize field, ": "
@@ -280,10 +266,9 @@
             , P "category" cat
             , P "returnTo" $ "item/"++item++escape ("?returnTo="++escape uri)
             ]
-            ("[Add a field to the ", capitalize cat, " category]")),
+            ("[Add a field to the ", capitalize cat, " category]") )
+    , hr, buttons ),
   s) where uri = fromMaybe "" $ lookM req "returnTo"
-           returnTo = flip (maybe $ HTML "") (lookM req "returnTo") $
-               hidden "returnTo"
            buttons = para ( button "[Save]", " ", mdot, " "
                           , link (?root++uri) "[Cancel]" )
     
@@ -348,7 +333,8 @@
         ( h2 "Add category"
         , formP "" ( "Name: " & textfield "name" ""
         , submit "Submit" ) )
-  , h ["addCategory"]   POST $ seeOther $ \() -> runRedirect addCategory
+  , h ["addCategory"]   POST $ addCategory
   , h ["addpotion"] POST $ seeOther $ \() -> runRedirect addPotion
   , h ["addToSidebar"] POST $ seeOther $ \() -> runRedirect addToSidebar
   ]
+