[Fencommits] fenserve: refactor; fix (insert "&" between query parameters)

[Benja Fallenstein]

Thu May 31 01:50:03 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * refactor; fix (insert "&" between query parameters)
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-31 12:04:50.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-31 12:04:50.000000000 +0300
@@ -281,13 +281,13 @@
     
 main = stdHTTP [ debugFilter
                , h (Prefix ()) () $ \(path::[String]) req ->
-                   getTime >>= \time ->
-                   let ?time = time; ?req = req
+                   getTime >>= \time -> get >>= \state ->
+                   let ?time = time; ?state = state; ?req = req
                        ?root = concatMap (const "../") $ drop 1 path
                    in runServerParts [app] req
                ]
 
-app :: (?root :: String, ?time :: Int64)
+app :: (?root :: String, ?time :: Int64, ?req :: Request, ?state :: MyState)
        => ServerPart (Ev MyState ev) Request IO Result
 app = multi    [ h ["potion"] GET $ ok $ \() -> run $
                    \req s -> potionGet (read $ fromJust $ lookM req "exp") (readArgs req) (lookM req "name") s
@@ -308,22 +308,18 @@
                , h ["delItem"] POST $ seeOther $ \() -> runRedirect delItem
                
                , h [""] GET  $ seeOther $ \() -> runRedirect $ \() s -> ("potion/" ++ (case head $ stateSidebarPages s of (fn,args) -> fn ++ concat ["/"++a | a <- args]), s)
-               , h ["addField"] GET $ ok $ \() req -> 
-                   let Just cat = lookM req "category"
-                       Just item = lookM req "item"
-                       returnTo = fromMaybe ("item/"++item) (lookM req "returnTo")
-                   in respond $
-                     "<h2>Add field to category "++cat++"</h2>\
-                     \<form method=post>Field: <input name=field>\
-                     \<input type=hidden name=category value='"++cat++"'>\
-                     \<input type=hidden name=item value='"++item++"'>\
-                     \<input type=hidden name=returnTo value='"++html returnTo++"'>\
-                     \<input type=submit value='Submit'></form>"
+               , h ["addField"] GET $ ok $ \() () -> respond $ html $
+                     ( h2 ("Add field to category ", lookE "category")
+                     , formP "" ( "Field: " & textfield "field" ""
+                                , channel ["category", "item"]
+                                , hidden "returnTo" $ lookI "returnTo" $
+                                      "item/"++lookE "item"
+                                , submit "Submit" ) )
                , h ["addField"] POST $ seeOther $ \() -> runRedirect addField
-               , h ["addCategory"]   GET  $ ok $ \() () -> respond $
-                     "<h2>Add category</h2>\
-                     \<form method=post>Name: <input name=name>\
-                     \<input type=submit value='Submit'></form>"
+               , h ["addCategory"]   GET  $ ok $ \() () -> respond $ html $
+                     ( h2 "Add category"
+                     , formP "" ( "Name: " & textfield "name" ""
+                                , submit "Submit" ) )
                , h ["addCategory"]   POST $ seeOther $ \() -> runRedirect addCategory
                , h ["addpotion"] POST $ seeOther $ \() -> runRedirect addPotion
                , h ["addToSidebar"] POST $ seeOther $ \() -> runRedirect addToSidebar
diff -rN -u old-fenserve/fendata/PotionTypes.hs new-fenserve/fendata/PotionTypes.hs
--- old-fenserve/fendata/PotionTypes.hs	2007-05-31 12:04:50.000000000 +0300
+++ new-fenserve/fendata/PotionTypes.hs	2007-05-31 12:04:50.000000000 +0300
@@ -44,6 +44,9 @@
 
 data Item = Item { itemFields :: Map String String, itemCategories :: Set String }
     deriving (Read, Show, Typeable, Data)
+    
+u_fields f i = i { itemFields = f (itemFields i) }
+u_categories f i = i { itemCategories = f (itemCategories i) }
 
 nextId :: Map Id a -> Id
 nextId m = if Map.null m then 0 else fst (Map.findMax m) + 1
@@ -54,4 +57,8 @@
                      stateSidebarPages :: [(String, [String])] }
              deriving (Read, Show, Typeable, Data)
 
+u_items f s = s { stateItems = f (stateItems s) }
+u_schema f s = s { stateSchema = f (stateSchema s) }
+u_potions f s = s { statePotions = f (statePotions s) }
+u_sidebarPages f s = s { stateSidebarPages = f (stateSidebarPages s) }
 
diff -rN -u old-fenserve/fendata/Utils.hs new-fenserve/fendata/Utils.hs
--- old-fenserve/fendata/Utils.hs	2007-05-31 12:04:50.000000000 +0300
+++ new-fenserve/fendata/Utils.hs	2007-05-31 12:04:50.000000000 +0300
@@ -7,6 +7,7 @@
 
 import Data.Char (toUpper, toLower)
 import Data.List (intersperse)
+import Data.Maybe (fromMaybe)
 
 
 for :: [a] -> (a -> b) -> [b]
@@ -20,8 +21,15 @@
   escapeMore '[' = "%5b"; escapeMore ']' = "%5d"; 
       escapeMore '&' = "%26"; escapeMore c = [c]
 
-qlink path params = link $ ?root ++ path ++ "?" ++ concatFor params 
-                                      (\(P k v) -> k++"="++escape' (toString v))
+qlink path params = link $ ?root ++ path ++ "?" ++ 
+    concat (intersperse "&" $ for params $ \(P k v) -> 
+                k ++ "=" ++ escape' (toString v))
+                                      
+                                      
+lookI :: (?req :: Request) => String -> String -> String
+lookI field deflt = fromMaybe deflt (lookM ?req field)
+
+lookE field = lookI field ""
 
 
 commaList :: ToHTML a => [a] -> HTML
@@ -42,6 +50,6 @@
 mdot = style "margin-left: 0.5em; margin-right: 0.5em; font-weight: bold" $
            HTML "&#xb7;"
 
-mdotted = cat . intersperse (" "&mdot&" ")
+mdotted = cat . intersperse (" " & mdot & " ")