[Fencommits] fenserve: refactor: add a function for creating query links

Benja Fallenstein benja.fallenstein at gmail.com
Wed May 30 20:35:46 EEST 2007


Wed May 30 20:35:26 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * refactor: add a function for creating query links
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-30 20:35:46.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-30 20:35:46.000000000 +0300
@@ -100,7 +100,7 @@
            then (HTML $ head $ evalStateT (runExp env exp) s)
            else toHTML "(Incomplete expression.)"
     Fun _ _ funBody = readFun s fun
-    expandLink = (para $ link (?root++"potion?exp="++escape' (show funBody)++"&name="++fun) "[edit page]")
+    expandLink = (para $ qlink "potion" [P "exp" funBody, P "name" fun] "[edit page]")
              +++ maybe (HTML "") (\page ->
                    (if page `elem` stateSidebarPages s then HTML "" else
                     para $ formP (?root++"addToSidebar") (hidden "page" (show page)
@@ -123,8 +123,7 @@
     rendered = let ?state=s; ?link=True; ?name=name in renderExp exp id string
     env = Map.fromList $ zip [0..length args-1] args
     saveLinks = formP (?root++"addpotion") $ (+++hidden "exp" (show exp)) $
-                (+++link (?root++"makefun?exp="++escape' (show exp)) 
-                         "[Save as...]") $
+                (+++ qlink "makefun" [P "exp" exp] "[Save as...]") $
                 flip (maybe $ HTML "") name $ \name' ->
                     hidden "name" name' +++
                     button ("[Save as "++name'++"]")+++" "+++mdot+++" "
@@ -216,18 +215,23 @@
     makePage s ("List of "++plural cat++" in the database") "" $
     tag "table" [("border","1")] $
     (tag "tr" [] $ catFor cols $ \col -> tag "th" [] $ capitalize col) +++
-    (tag "tr" [] $ tag "td" [("colspan", show $ length cols), ("style", "text-align: center")] new) +++
+    (tag "tr" [] $ tag "td" [("colspan", show $ length cols), 
+                             ("style", "text-align: center")] $
+         if not $ null items then new else
+             ital ("There are no "++plural cat++" in the database. ") +++
+             mdot +++ new) +++
     (catFor (Map.toList $ stateItems s) $ \(id, Item fields cats) ->
       if cat `Set.member` cats then tag "tr" [] $
         catFor cols $ \col -> tag "td" [] $ 
-            link (?root++"item/"++show id++"?returnTo=table") $ 
-                fields Map.! col
+            qlink ("item/"++show id) [P "returnTo" "table"] $ fields Map.! col
       else toHTML ""),
     s) where new = formP (?root++"newItem") $ foldl1 (+++)
                        [ hidden "returnTo" "table"
                        , hidden "cat" cat
                        , button $ bold ("[New "+++cat+++"]") ]
              cat = fromMaybe (head $ Map.keys $ stateSchema s) (lookM req "cat")
+             items = flip filter (Map.toList $ stateItems s) $
+                         \(_, Item _ cats) -> cat `Set.member` cats
              cols = flip fromMaybe (fmap read $ lookM req "cols") $
                         take 1 $ stateSchema s Map.! cat
                  
diff -rN -u old-fenserve/fendata/UI.hs new-fenserve/fendata/UI.hs
--- old-fenserve/fendata/UI.hs	2007-05-30 20:35:46.000000000 +0300
+++ new-fenserve/fendata/UI.hs	2007-05-30 20:35:46.000000000 +0300
@@ -49,10 +49,9 @@
                         uri = ?root++"potion/"++fun++concat ["/"++a | a <- args]
                  in para $ bold $ link uri $ renderExp exp id string) +++
             hr +++
-            para (link (?root++"potion?exp="++(escape' $ show $ Block [])) "New page") +++
+            para (qlink "potion" [P "exp" $ Block []] "New page") +++
             catFor (Map.keys $ stateSchema state) (\cat ->
-                para (link (?root++"table?cat="++escape' cat) 
-                           ("New "++cat++" view"))) +++
+                para (qlink "table" [P "cat" cat] ("New "++cat++" view"))) +++
             para (link (?root++"addCategory") "Add category")) +++
         tag "div" [("class", "content")] body) +++
     tag "div" [("class", "footer")]
diff -rN -u old-fenserve/fendata/Utils.hs new-fenserve/fendata/Utils.hs
--- old-fenserve/fendata/Utils.hs	2007-05-30 20:35:46.000000000 +0300
+++ new-fenserve/fendata/Utils.hs	2007-05-30 20:35:46.000000000 +0300
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}
 
 module Utils where
 
@@ -8,6 +9,11 @@
 import Data.List (intersperse)
 
 
+class ToString a where toString :: a -> String
+instance ToString String where toString = id
+instance Show a => ToString a where toString = show
+
+
 for :: [a] -> (a -> b) -> [b]
 for = flip map
 
@@ -19,6 +25,12 @@
   escapeMore '[' = "%5b"; escapeMore ']' = "%5d"; 
       escapeMore '&' = "%26"; escapeMore c = [c]
 
+data Param key = forall value. ToString value => P key value
+
+qlink path params = link $ ?root ++ path ++ "?" ++ concatFor params 
+                                      (\(P k v) -> k++"="++escape' (toString v))
+
+
 commaList :: ToHTML a => [a] -> HTML
 commaList [] = toHTML ""
 commaList [x] = toHTML x




More information about the Fencommits mailing list