[Fencommits] fenserve: use the ?root set in main everywhere, *except* returnTo

[Tuukka Hastrup]

Sun May 27 15:58:02 EEST 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * use the ?root set in main everywhere, *except* returnTo
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-27 16:00:36.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-27 16:00:36.000000000 +0300
@@ -122,14 +122,15 @@
            else toHTML "(Incomplete expression.)"
     rendered = let ?state=s; ?link=True; ?name=name in renderExp exp id string
     env = Map.fromList $ zip [0..length args-1] args
-    saveLinks = formP "addpotion" $ (+++hidden "exp" (show exp)) $
-                (+++link ("makefun?exp="++escape' (show exp)) "[Save as...]") $
+    saveLinks = formP (?root++"addpotion") $ (+++hidden "exp" (show exp)) $
+                (+++link (?root++"makefun?exp="++escape' (show exp)) 
+                         "[Save as...]") $
                 flip (maybe $ HTML "") name $ \name' ->
                     hidden "name" name' +++
                     button ("[Save as "++name'++"]")+++" "+++mdot+++" "
 
 editText exp old olds ty name s = let ?state = s; ?link = False; ?name=name in
-    (formG "editTemplate" $
+    (formG (?root++"editTemplate") $
          para (field $ f 1 olds)
      +++ para (submit "Submit" +++ hidden "exp" (show exp)
            +++ maybe (HTML "") (hidden "name") name
@@ -140,10 +141,11 @@
     field = case old of Block _ -> textarea "template" 20 80
                         Inline _ -> textfield "template"
 
-edit :: (Exp,Exp,Type,Maybe String) -> MyState -> (HTML, MyState)
+edit :: (?root :: String) 
+        => (Exp,Exp,Type,Maybe String) -> MyState -> (HTML, MyState)
 edit (exp,old@(Block olds),ty,name) s = editText exp old olds ty name s
 edit (exp,old@(Inline olds),ty,name) s = editText exp old olds ty name s
-edit (exp,old,ty,name) s = let ?state = s; ?link = False; ?name=name; ?root = "" in
+edit (exp,old,ty,name) s = let ?state = s; ?link = False; ?name=name in
     (para ("Select something to replace '" +++ renderExp' old id ty +++ "' "
        +++ "with.") +++ hr
  +++ para ("Variables: " +++ cat [linkExp (Var i) (renderVar i)+++" " 
@@ -151,16 +153,16 @@
  +++ (catFor (filter ((==ty) . expType) $ getPotions s) $ \repl ->
          para $ li $ linkExp repl $ renderExp repl id (error "some type"))
     , s) where linkExp new = tag "a" [("class", "editLink"),
-                   ("href", "potion?exp=" ++ show (subst (-1) new exp)
+                   ("href", ?root ++ "potion?exp=" ++ show (subst (-1) new exp)
                             ++ maybe "" ("&name="++) name)] .
                              tag "span" [("class", "editPotion")]
 
-makeFun :: Request -> MyState -> (HTML, MyState)
-makeFun msg s = let ?state = s; ?link = False; ?name=lookM msg "name"; ?root="" in
+makeFun :: (?root :: String) => Request -> MyState -> (HTML, MyState)
+makeFun msg s = let ?state = s; ?link = False; ?name=lookM msg "name" in
     (para ("Save '"+++renderExp' exp id (error "some type")+++"' as the "
        +++ "following potion (" +++ code "$(cat)" +++ ", where 'cat' is \
            \a category name, marks a hole):")
- +++ formP "addpotion" (para (textarea "template" 3 80 "")
+ +++ formP (?root++"addpotion") (para (textarea "template" 3 80 "")
                     +++ para (submit "Save") +++ hidden "exp" (show exp)), s)
     where Just exp = fmap read $ lookM msg "exp"
     
@@ -209,13 +211,15 @@
     s' = s { stateSidebarPages = stateSidebarPages s ++ [page] }
     Just page@(fn,args) = fmap read $ lookM msg "page"
 
-showTable :: () -> MyState -> (HTML, MyState)
+showTable :: (?root :: String) => () -> MyState -> (HTML, MyState)
 showTable () s = (
-    let ?root="" in makePage s "List of items in the database" "" $
+    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
-               [ link ("item/"++show id++"?returnTo=table") "[Edit item]"
+        (+++ para (formP (?root++"delItem") (hidden "item" (show id) 
+         +++ mdotted
+               [ link (?root++"item/"++show id++"?returnTo=table") 
+                      "[Edit item]"
                , button "[Delete item]"
                , ital $ "Categorized as " 
                     +++ commaList (map (bold.capitalize) (Set.toList cats))]))
@@ -223,18 +227,22 @@
         . para
         . catFor (Map.toList fields) $ \(f,v) ->
             bold (capitalize f) +++ ": " +++ v +++ br,
-    s) where new = para . formP "newItem" . (+++ hidden "returnTo" "table")
-                   . (+++ " " +++ mdot +++ " " +++ bold (link "addCategory" "[Add category]"))
+    s) where new = para . formP (?root++"newItem") 
+                   . (+++ hidden "returnTo" "table")
+                   . (+++ " " +++ mdot +++ " "
+                      +++ bold (link (?root++"addCategory") "[Add category]"))
                    . mdotted . for (Map.keys $ stateSchema s) $ \cat ->
                        button' "cat" cat $ bold ("[New "+++cat+++"]")
                  
-showItem :: String -> Request -> MyState -> (HTML, MyState)
+showItem :: (?root :: String) => 
+            String -> Request -> MyState -> (HTML, MyState)
 showItem item req s = let Item fields cats = stateItems s Map.! read item 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
-        . (+++ HTML ("<p><a href='../addField?item="++item++"&category="++cat
+        . (+++ HTML ("<p><a href='"++ ?root++"addField?item="++item
+           ++ "&category="++cat
            ++ "&returnTo=item/"++item++html (escape ("?returnTo="++escape uri))
            ++ "'>[Add a field to the "++capitalize cat++" category]</a><br>"))
         . catFor cfs $ \field ->
@@ -246,18 +254,19 @@
              returnTo = flip (maybe $ toHTML "") (lookM req "returnTo") $ \uri -> HTML $
                  "<input type=hidden name=returnTo value='"++html(escape uri)++"'>"
              buttons = HTML $ "<p><button>[Save]</button> "++html mdot++" "++
-                 "<a href='../"++html uri++"'>[Cancel]</a></form>"
+                 "<a href='"++ ?root++html uri++"'>[Cancel]</a></form>"
     
     
-updateItem :: String -> Request -> MyState -> (String, MyState)
-updateItem item_s req s = (returnTo, s') where
-    returnTo = maybe "" ("../"++) (lookM req "returnTo")
+updateItem :: (?root :: String) => 
+              String -> Request -> MyState -> (String, MyState)
+updateItem item_s req s = (maybe "" (?root++) returnTo, s') where
+    returnTo = lookM req "returnTo"
     item = read item_s
     s' = s { stateItems = Map.insert item (Item fields' cats) (stateItems s) }
     Item fields cats = stateItems s Map.! item
     fields' = flip Map.mapWithKey fields $ \k v -> fromMaybe v (lookM req k)
 
-newItem msg s = ("item/"++show id++returnTo, s') where
+newItem msg s = (?root++"item/"++show id++returnTo, s') where
     returnTo = maybe "" (("?returnTo="++) . escape) (lookM msg "returnTo")
     id = nextId $ stateItems s
     s' = s { stateItems = Map.insert id item $ stateItems s }