[Fencommits] fenserve: fix: allow larger HTTP bodies, fix code for /table

[Benja Fallenstein]

Fri Jun 29 11:44:03 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * fix: allow larger HTTP bodies, fix code for /table
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-06-29 11:45:14.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-06-29 11:45:14.000000000 +0300
@@ -21,7 +21,9 @@
 
 import qualified System.IO.Unsafe
 
-main = stdHTTP [ debugFilter
+main = stdMain $ (\conf -> simpleHTTP handlers $ conf {bodyLimit=1024*1024}) 
+             :*: End where
+    handlers = [ debugFilter
                , h (Prefix ()) () $ \(_:path::[String]) req -> do
                    getTime -> time; get -> state :: DB
                    let imp = Imp { impTime = time, impDB = state
@@ -114,8 +116,10 @@
           ( h3 ("Category: ", name)
           , renderValues $ runExp [] $ Exp "tableView"
               ( Exp "allItems" (I cat)
-              , for fs $ \f -> ( fieldName $ getField f
-                               , Exp "getField" ( f, Exp "var" $ I (0::Int) )))))
+              , for fs $ \f -> 
+                  ( fieldName $ getField f
+                  , Exp "getField" ( f, Exp "var" ( Single (ItemType cat)
+                                                  , 0::Int) )))))
                                
   , h (Prefix ["potion"]) GET $ ok $ \[s] () -> respond $ either id id $ 
       evaluate $ html $ header & let exp = readExp $ unEscapeString s in
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs	2007-06-29 11:45:14.000000000 +0300
+++ new-fenserve/fendata/Potions.hs	2007-06-29 11:45:14.000000000 +0300
@@ -34,17 +34,20 @@
     
 mint f = I $ mintVar $ \var -> ren (f var)
 
+fromJust' n (Just x) = x
+fromJust' n _ = error ("Parameter type mismatch in potion " ++ n)
+
 runExp :: (?imp :: Imp) => [Values] -> Exp -> Values
 runExp env (Focus e) = runExp env e
 runExp env (Exp name arg) = f (getPotion name) where
-    f (Potion _ g) = case g $ fromJust $ cast arg of (_,_,_,r) -> r env
+    f (Potion _ g) = case g $ fromJust' name $ cast arg of (_,_,_,r) -> r env
     
 
 expType :: (?imp :: Imp) => Exp -> Type
 expType (Question ty) = ty
 expType (Focus e) = expType e
 expType (Exp n a) = f (getPotion n) where
-    f (Potion _ g) = case g (fromJust $ cast a) of (t,_,_,_) -> t
+    f (Potion _ g) = case g (fromJust' n $ cast a) of (t,_,_,_) -> t
     
     
 expressionsOfType :: (?imp :: Imp) => Type -> [Exp]