[Fencommits] fenserve: try to get rid of all absolute paths
Tuukka Hastrup
Tuukka.Hastrup at iki.fi
Fri May 25 02:15:34 EEST 2007
Fri May 25 02:14:38 EEST 2007 Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
* try to get rid of all absolute paths
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-05-25 02:15:33.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-05-25 02:15:33.000000000 +0300
@@ -107,18 +107,19 @@
expType (Concat _) = string
expType (Str _) = string
-editLink :: (?link :: Bool, ?name :: Maybe String, ToHTML a) =>
- (Exp -> Exp) -> Exp -> Type -> a -> HTML
+editLink :: (?link :: Bool, ?name :: Maybe String, ?root :: String,
+ ToHTML a) => (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="++(escape' $ show $ f $ Var (-1))++"&old="++(escape' $ show old)++"&type="++show t
+ ?root++"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
renderMaybeExp Nothing cx ty = editLink cx (Var 0) ty $ surround $ bold $
"[" +++ typeQuestion ty +++ "]"
-renderExp :: (?state :: MyState, ?link :: Bool, ?name :: Maybe String) => Exp -> (Exp -> Exp) -> Type -> HTML
+renderExp :: (?state :: MyState, ?link :: Bool, ?name :: Maybe String,
+ ?root :: String) => Exp -> (Exp -> Exp) -> Type -> HTML
renderExp exp@(Call fname args) cx ty = f (funTypes fun) (funParts fun) args 0 where
fun = readFun ?state fname
cx' n e = cx $ Call fname $ take n args ++ [Just e] ++ drop (n+1) args
@@ -307,9 +308,9 @@
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="++escape' (show e)++"&name="++n) "[edit page]")
+ expandLink = (para $ link (?root++"potion?exp="++escape' (show e)++"&name="++n) "[edit page]")
+++ if exp `elem` stateSidebarPages s then HTML "" else
- (para $ formP "/addToSidebar" (hidden "exp" (show exp)
+ (para $ formP (?root++"addToSidebar") (hidden "exp" (show exp)
+++ button "[add to sidebar]"))
where Just (e,n) = expanded
saveLinks = formP "addpotion" $ (+++hidden "exp" (show exp)) $
@@ -336,7 +337,7 @@
f i (Just (Str s) : xs) = s +++ f i xs
f i (_:xs) = "$" +++ show i +++ f (i+1) xs
f _ [] = toHTML ""
-edit (exp,old,ty,name) s = let ?state = s; ?link = False; ?name=name in
+edit (exp,old,ty,name) s = let ?state = s; ?link = False; ?name=name; ?root = "" in
(para ("Select something to replace '" +++ renderExp' old id ty +++ "' "
+++ "with.") +++ hr
+++ para ("Variables: " +++ cat [linkExp (Var i) (renderVar i)+++" "
@@ -349,7 +350,7 @@
tag "span" [("class", "editPotion")]
makeFun :: Request -> MyState -> (HTML, MyState)
-makeFun msg s = let ?state = s; ?link = False; ?name=lookM msg "name" in
+makeFun msg s = let ?state = s; ?link = False; ?name=lookM msg "name"; ?root="" in
(para ("Save '"+++renderExp' exp id (error "some type")+++"' as the "
+++ "following potion (" +++ code "$(cat)" +++ ", where 'cat' is \
\a category name, marks a hole):")
@@ -363,7 +364,7 @@
editTemplate :: Request -> MyState -> (String, MyState)
editTemplate msg s =
- ("/potion?exp=" ++ escape' (show (subst (-1) new exp))
+ ("potion?exp=" ++ escape' (show (subst (-1) new exp))
++ maybe "" ("&name="++) (lookM msg "name")
, s) where
Just exp = fmap read $ lookM msg "exp"
@@ -379,7 +380,7 @@
f "" = [Just (Str "")]
addPotion :: Request -> MyState -> (String, MyState)
-addPotion msg s = ("/potion/"++name, s { statePotions = newPotions }) where
+addPotion msg s = ("potion/"++name, s { statePotions = newPotions }) where
Just template = lookM msg "template"
Just exp = fmap read $ lookM msg "exp"
name = fromMaybe (getName template) $ lookM msg "name" where
@@ -400,7 +401,7 @@
f "" part = ([reverse part], [])
addToSidebar :: Request -> MyState -> (String, MyState)
-addToSidebar msg s = ("/potion?exp="++escape' (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"
@@ -415,7 +416,7 @@
showTable :: () -> MyState -> (HTML, MyState)
showTable () s = (
- makePage s "List of items in the database" "" $
+ let ?root="" in makePage s "List of items in the database" "" $
(new+++) . (hr+++) . (+++new) .
catFor (Map.toList $ stateItems s) $ \(id, Item fields cats) ->
(+++ para (formP "delItem" (hidden "item" (show id) +++ mdotted
@@ -439,7 +440,7 @@
showItem :: String -> Request -> MyState -> (HTML, MyState)
showItem item req s = let Item fields cats = stateItems s Map.! read item in (
- makePage s "Item editor" "" $
+ let ?root = "../" in makePage s "Item editor" "" $
formP "" . ((returnTo+++buttons+++hr)+++) . (+++hr+++buttons) .
catFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
(h3 (capitalize cat) +++) . para
@@ -490,9 +491,9 @@
para "Welcome to Fendata!" +++ sidebar +++ hr +++
catFor (stateSidebarPages state) (\exp ->
let ?state=state; ?link=False; ?name=Nothing
- in para $ bold $ link ("/potion?exp="++escape' (show exp)) $
+ in para $ bold $ link (?root++"potion?exp="++escape' (show exp)) $
renderExp exp id string) +++ hr +++
- link "/table" "List of items in the database") +++
+ link (?root++"table") "List of items in the database") +++
tag "div" [("class", "content")] body) +++
tag "div" [("class", "footer")]
("Fendata (c) 2007 by Benja Fallenstein and Tuukka Hastrup. " +++
@@ -504,13 +505,13 @@
main = stdHTTP [ debugFilter
, h ["potion"] GET $ ok $ \() -> run $
- \(exp,args,name) s -> potionGet exp args name s
+ \(exp,args,name) s -> let ?root = "" in potionGet exp args name s
, h ["potion"] POST $ ok $ \() -> run $
- \(exp,args,name::Maybe String) s -> potionPost exp args s
+ \(exp,args,name::Maybe String) s -> let ?root = "" in potionPost exp args s
, h (Prefix ["potion"]) GET $ ok $ \(fun:args) -> run $
- \(_::[String],name) s -> potionGet (Call fun (map (Just . Str) args)) args name s
+ \(_::[String],name) s -> let ?root = concat (take (1 + length args) $ repeat "../") in 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
+ \(args,name::Maybe String) s -> let ?root = "../" in potionPost (Call fun (map (Just . Str) args)) args s
, h ["edit"] GET $ ok $ \() -> run edit
, h ["editTemplate"] GET $ seeOther $ \() -> runRedirect editTemplate
, h ["makefun"] GET $ ok $ \() -> run makeFun
@@ -521,7 +522,7 @@
, h ["newItem"] POST $ seeOther $ \() -> runRedirect newItem
, h ["delItem"] POST $ seeOther $ \() -> runRedirect delItem
- , h [""] GET $ seeOther $ \() -> runRedirect $ \() s -> ("/potion?exp=" ++ (escape' $ show $ head $ stateSidebarPages s), s)
+ , h [""] GET $ seeOther $ \() -> runRedirect $ \() s -> ("potion?exp=" ++ (escape' $ show $ head $ stateSidebarPages s), s)
, h ["addField"] GET $ ok $ \() req ->
let Just cat = lookM req "category"
Just item = lookM req "item"
More information about the Fencommits
mailing list