[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