[Fencommits] fenserve: make ?root and ?time available in all parts of the app

[Tuukka Hastrup]

Sun May 27 15:38:07 EEST 2007  Tuukka Hastrup <Tuukka.Hastrup at iki.fi>
  * make ?root and ?time available in all parts of the app
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-27 15:39:30.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-27 15:39:30.000000000 +0300
@@ -230,7 +230,7 @@
                  
 showItem :: String -> Request -> MyState -> (HTML, MyState)
 showItem item req s = let Item fields cats = stateItems s Map.! read item in (
-    let ?root = "../" in makePage s "Item editor" "" $
+    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
@@ -270,12 +270,19 @@
     Just id = fmap read $ lookM msg "item"
     
 main = stdHTTP [ debugFilter
-               , h ["potion"] GET $ ok $ \() req -> (getTime >>=) $ run $ 
-                   \time s -> let ?root = ""; ?time = time in potionGet (read $ fromJust $ lookM req "exp") (readArgs req) (lookM req "name") s
-               , h (Prefix ["potion"]) GET $ ok $ \(fun:args) req -> do 
-                   time <- getTime
-                   let { ?time = time } in flip run req $ 
-                       \req s -> let ?root = concat (take (1 + length args) $ repeat "../") in potionPage fun args (lookM req "name") s
+               , h (Prefix ()) () $ \(path::[String]) req ->
+                   getTime >>= \time ->
+                   let ?time = time
+                       ?root = concatMap (const "../") $ drop 1 path
+                   in runServerParts [app] req
+               ]
+
+app :: (?root :: String, ?time :: Int64)
+       => ServerPart (Ev MyState ev) Request IO Result
+app = multi    [ h ["potion"] GET $ ok $ \() -> run $
+                   \req s -> potionGet (read $ fromJust $ lookM req "exp") (readArgs req) (lookM req "name") s
+               , h (Prefix ["potion"]) GET $ ok $ \(fun:args) -> run $
+                   \req s -> potionPage fun args (lookM req "name") s
                , h ["edit"] GET $ ok $ \() -> run $ \req ->
                      edit (read $ fromJust $ lookM req "exp",
                            read $ fromJust $ lookM req "old",