[Fencommits] fenserve: simplify passing arguments to potions

[Benja Fallenstein]

Thu May 24 22:35:29 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * simplify passing arguments to potions
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-24 22:35:35.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-24 22:35:35.000000000 +0300
@@ -111,7 +111,7 @@
             (Exp -> Exp) -> Exp -> Type -> a -> HTML
 editLink f old t s | not ?link = toHTML s | otherwise =
   flip (tag "a") s [("class", "editLink"), ("href",
-      "/edit?exp="++(show $ f $ Var (-1))++"&old="++show old++"&type="++show t
+      "/edit?exp="++(escape' $ show $ f $ Var (-1))++"&old="++(escape' $ show old)++"&type="++show t
     ++maybe "" ("&name="++) ?name)]
                   
 renderMaybeExp (Just exp) cx ty = renderExp' exp cx ty
@@ -329,13 +329,13 @@
     rendered = let ?state=s; ?link=True; ?name=name in renderExp exp id string
     env = Map.fromList $ zip [0..length args-1] args
     expanded = expand s exp; expandable = isJust expanded
-    expandLink = (para $ link ("/potion?exp="++show e++"&name="++n) "[edit page]")
+    expandLink = (para $ link ("/potion?exp="++escape' (show e)++"&name="++n) "[edit page]")
              +++ if exp `elem` stateSidebarPages s then HTML "" else
                  (para $ formP "/addToSidebar" (hidden "exp" (show exp)
                                             +++ button "[add to sidebar]"))
         where Just (e,n) = expanded
     saveLinks = formP "addpotion" $ (+++hidden "exp" (show exp)) $
-                (+++link ("makefun?exp="++show exp) "[Save as...]") $
+                (+++link ("makefun?exp="++escape' (show exp)) "[Save as...]") $
                 flip (maybe $ HTML "") name $ \name' ->
                     hidden "name" name' +++
                     button ("[Save as "++name'++"]")+++" "+++mdot+++" "
@@ -378,14 +378,16 @@
  +++ formP "addpotion" (para (textarea "template" 3 80 "")
                     +++ para (submit "Save") +++ hidden "exp" (show exp)), s)
     where Just exp = fmap read $ lookM msg "exp"
+    
+escape' = concatMap escapeMore . escape where
+  escapeMore '[' = "%5b"; escapeMore ']' = "%5d"; 
+      escapeMore '&' = "%26"; escapeMore c = [c]
 
 editTemplate :: Request -> MyState -> (String, MyState)
 editTemplate msg s = 
-    ("/potion?exp=" ++ concatMap escapeMore (escape (show (subst (-1) new exp)))
+    ("/potion?exp=" ++ escape' (show (subst (-1) new exp))
      ++ maybe "" ("&name="++) (lookM msg "name")
     , s) where
-  escapeMore '[' = "%5b"; escapeMore ']' = "%5d"; 
-      escapeMore '&' = "%26"; escapeMore c = [c]
   Just exp = fmap read $ lookM msg "exp"
   Just (Concat olds) = fmap read $ lookM msg "old"
   Just tmp = lookM msg "template"
@@ -420,7 +422,7 @@
     f "" part = ([reverse part], [])
 
 addToSidebar :: Request -> MyState -> (String, MyState)
-addToSidebar msg s = ("/potion?exp="++show exp, s') where
+addToSidebar msg s = ("/potion?exp="++escape' (show exp), s') where
     s' = s { stateSidebarPages = stateSidebarPages s ++ [read exp] }
     Just exp = lookM msg "exp"
 
@@ -510,7 +512,7 @@
             para "Welcome to Fendata!" +++ sidebar +++ hr +++
             catFor (stateSidebarPages state) (\exp ->
                 let ?state=state; ?link=False; ?name=Nothing
-                 in para $ bold $ link ("/potion?exp="++show exp) $
+                 in para $ bold $ link ("/potion?exp="++escape' (show exp)) $
                     renderExp exp id string) +++ hr +++
             link "/table" "List of items in the database") +++
         tag "div" [("class", "content")] body) +++
@@ -527,8 +529,8 @@
                    \(exp,args,name) s -> potionGet exp args name s
                , h ["potion"] POST $ ok $ \() -> run $ 
                    \(exp,args,name::Maybe String) s -> potionPost exp args s
-               , h (Prefix ["potion"]) GET $ ok $ \[fun] -> run $ 
-                   \(args,name) s -> potionGet (Call fun (map (Just . Str) args)) args name s
+               , h (Prefix ["potion"]) GET $ ok $ \(fun:args) -> run $ 
+                   \(_::[String],name) s -> potionGet (Call fun (map (Just . Str) args)) args name s
                , h (Prefix ["potion"]) POST $ ok $ \[fun] -> run $ 
                    \(args,name::Maybe String) s -> potionPost (Call fun (map (Just . Str) args)) args s
                , h ["edit"] GET $ ok $ \() -> run edit