[Fencommits] fenserve: parametrize Exp over the type of subexpressions

[Benja Fallenstein]

Sat Jun  9 16:44:55 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * parametrize Exp over the type of subexpressions
diff -rN -u old-fenserve-1/fendata/Main.hs new-fenserve-1/fendata/Main.hs
--- old-fenserve-1/fendata/Main.hs	2007-06-09 16:45:12.000000000 +0300
+++ new-fenserve-1/fendata/Main.hs	2007-06-09 16:45:12.000000000 +0300
@@ -90,6 +90,6 @@
       ( h2 "Table of all data in the database (if any)"
       , catFor (Map.elems $ dbCategories ?db) $ \(Category cat name fs) ->
           ( h3 ("Category ", name)
-          , renderValues $ runExp [] $ TableView (AllItems cat) $
-                map (\f -> (fieldName $ getField f, GetField f (Var 0))) fs))
+          , renderValues $ runExp [] $ Exp $ TableView (Exp $ AllItems cat) $
+                map (\f -> (fieldName $ getField f, Exp $ GetField f (Exp $ Var 0))) fs))
   ]
diff -rN -u old-fenserve-1/fendata/Potions.hs new-fenserve-1/fendata/Potions.hs
--- old-fenserve-1/fendata/Potions.hs	2007-06-09 16:45:12.000000000 +0300
+++ new-fenserve-1/fendata/Potions.hs	2007-06-09 16:45:12.000000000 +0300
@@ -123,38 +123,40 @@
 
 runExp :: (?db :: DB, ?time :: Int64, ?funs :: Map FunId Fun) => 
           [Values] -> Exp -> Values
-runExp env (Var i) = env !! i
-runExp env (Call fun exps) = runExp (map (runExp env) exps) body where
+runExp env = runExp' env . unExp
+          
+runExp' env (Var i) = env !! i
+runExp' env (Call fun exps) = runExp (map (runExp env) exps) body where
     Fun _ _ body = ?funs Map.! fun
-runExp env (Literal val) = val
-runExp env (GetField field exp) = do
+runExp' env (Literal val) = val
+runExp' env (GetField field exp) = do
     ItemValue _ item <- runExp env exp;  getValue item field
-runExp env (AllItems cat) = map (ItemValue cat) $ map itemId $ getItems cat    
-runExp env (Sort exp sortKeyExp order) = f sorted where
+runExp' env (AllItems cat) = map (ItemValue cat) $ map itemId $ getItems cat    
+runExp' env (Sort exp sortKeyExp order) = f sorted where
     values = runExp env exp
     sortKeys = map (\v -> runExp ([v]:env) sortKeyExp) values
     sorted = map snd $ sort $ zip sortKeys values
     f = case order of Ascending -> id; Descending -> reverse
-runExp env (Filter exp filterExp) = filter f $ runExp env exp where
+runExp' env (Filter exp filterExp) = filter f $ runExp env exp where
     f v = case runExp ([v]:env) filterExp of 
               [BooleanValue True] -> True; [BooleanValue False] -> False
-runExp env (NumOp op e1 e2) = do
+runExp' env (NumOp op e1 e2) = do
     let f Add = (+); f Subtract = (-); f Mul = (*); f Div = (/)
     NumberValue a <- runExp env e1; NumberValue b <- runExp env e2
     return $ NumberValue $ f op a b
-runExp env (CmpOp op e1 e2) = do
+runExp' env (CmpOp op e1 e2) = do
     let f Lt = (<); f Le = (<=); f Eq = (==); f Ge = (>=); f Gt = (>)
     a <- runExp env e1; b <- runExp env e2
     return $ BooleanValue $ f op a b
-runExp env (Sum exp) = [NumberValue $ sum $ map numberValue $ runExp env exp]
-runExp env (Product exp) = 
+runExp' env (Sum exp) = [NumberValue $ sum $ map numberValue $ runExp env exp]
+runExp' env (Product exp) = 
     [NumberValue $ product $ map numberValue $ runExp env exp]
-runExp env (Count exp) = [NumberValue $ fromIntegral $ length $ runExp env exp]
-runExp env (IfThenElse e1 e2 e3) = runExp env $ case runExp env e1 of
+runExp' env (Count exp) = [NumberValue $ fromIntegral $ length $ runExp env exp]
+runExp' env (IfThenElse e1 e2 e3) = runExp env $ case runExp env e1 of
     [BooleanValue True] -> e2; [BooleanValue False] -> e3
-runExp env Today = [DateValue (ctYear t) (fromEnum (ctMonth t)+1) (ctDay t)]
+runExp' env Today = [DateValue (ctYear t) (fromEnum (ctMonth t)+1) (ctDay t)]
   where t = toUTCTime (TOD (fromIntegral ?time) 0)
-runExp env (TableView exp columns) = return $ BlockValue $
+runExp' env (TableView exp columns) = return $ BlockValue $
     tag "table" [P "border" "1"]
       ( tag "tr" [] $ catFor columns $ tag "th" [] . fst
       , catFor (runExp env exp) $ \item -> tag "tr" [] $
diff -rN -u old-fenserve-1/fendata/Types.hs new-fenserve-1/fendata/Types.hs
--- old-fenserve-1/fendata/Types.hs	2007-06-09 16:45:12.000000000 +0300
+++ new-fenserve-1/fendata/Types.hs	2007-06-09 16:45:12.000000000 +0300
@@ -143,20 +143,21 @@
 data CmpOp = Lt | Le | Eq | Ge | Gt
     deriving (Read, Show, Typeable, Data, Eq, Ord)
     
-data Exp = Var Int
-         | Call FunId [Exp]
-         | Literal Values
-         | GetField FieldId Exp
-         | AllItems CategoryId
-         | Sort Exp Exp Order
-         | Filter Exp Exp
-         | NumOp NumOp Exp Exp | CmpOp CmpOp Exp Exp
-         | Sum Exp | Product Exp | Count Exp
-         | IfThenElse Exp Exp Exp
-         | Today
+data Exp' e = Var Int
+            | Call FunId [e]
+            | Literal Values
+            | GetField FieldId e
+            | AllItems CategoryId
+            | Sort e e Order
+            | Filter e e
+            | NumOp NumOp e e | CmpOp CmpOp e e
+            | Sum e | Product e | Count e
+            | IfThenElse e e e
+            | Today
+            | TableView e [(String, e)]
          
-         | TableView Exp [(String, Exp)]
-         
-         | Question Type | Focus Exp
+            | Question Type | Focus e
+    deriving (Read, Show, Typeable, Data, Eq, Ord)
+    
+newtype Exp = Exp { unExp :: Exp' Exp }
     deriving (Read, Show, Typeable, Data, Eq, Ord)
-