[Fencommits] fenserve: small refactorings
Benja Fallenstein
benja.fallenstein at gmail.com
Thu Jun 14 16:08:39 EEST 2007
Thu Jun 14 16:08:08 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* small refactorings
diff -rN -u old-fenserve/fendata/Execution.hs new-fenserve/fendata/Execution.hs
--- old-fenserve/fendata/Execution.hs 2007-06-14 16:08:38.000000000 +0300
+++ new-fenserve/fendata/Execution.hs 2007-06-14 16:08:39.000000000 +0300
@@ -19,11 +19,10 @@
import System.Time
-runExp :: (?db :: DB, ?time :: Int64, ?funs :: Map FunId Fun) =>
- [Values] -> Exp -> Values
+runExp :: (?db :: DB, ?time :: Int64) => [Values] -> Exp -> Values
runExp env (Var i) = env !! i
runExp env (Call fun exps) = runExp (map (runExp env) exps) body where
- Fun _ _ body = ?funs Map.! fun
+ Fun _ _ _ body = dbFunctions ?db Map.! fun
runExp env (Literal val) = val
runExp env (GetField field exp) = do
ItemValue _ item <- runExp env exp; getValue item field
diff -rN -u old-fenserve/fendata/Rendering.hs new-fenserve/fendata/Rendering.hs
--- old-fenserve/fendata/Rendering.hs 2007-06-14 16:08:38.000000000 +0300
+++ new-fenserve/fendata/Rendering.hs 2007-06-14 16:08:39.000000000 +0300
@@ -48,19 +48,19 @@
data Env = Env { envVars :: [(String,Type)], envPath :: [Int], envWhole :: Exp }
-type RenderExp = ReaderT Env (StateT Int (Writer HTML))
+type RenderExp = ReaderT Env :$$: StateT Int :$$: Writer HTML
varType :: (?db :: DB) => Int -> RenderExp ()
varType i = ask >>= tell . toHTML . renderType . snd . (!! i) . envVars
-varName :: (?db :: DB, ?funs :: Map FunId Fun) => Int -> RenderExp ()
+varName :: (?db :: DB) => Int -> RenderExp ()
varName i = asks ((!! i) . envVars) >>= \(name,_) -> ren ("'", ital name, "'")
mintVar :: Type -> (Int -> RenderExp a) -> RenderExp a
mintVar t f = do var <- get; put (var + 1)
local (\e -> e {envVars=("v"++show var,t):envVars e}) (f var)
-focusPath :: Data a => [Int] -> a -> a
+focusPath :: [Int] -> GenericT
focusPath [] = mkT Focus
focusPath (p:ps) = snd . f 0 where
f i = gfoldl k (\x -> (i,x))
@@ -72,7 +72,7 @@
expWithFocus = ask >>= \env -> return $ focusPath (envPath env) (envWhole env)
-class RenderOne a where renderOne :: (?db :: DB, ?funs :: Map FunId Fun) => a -> RenderExp ()
+class RenderOne a where renderOne :: (?db :: DB) => a -> RenderExp ()
data E = E Int Exp
@@ -84,19 +84,19 @@
renderOne (E i e) =
local (\env -> env { envPath = envPath env ++ [i] }) (renderExp' e)
-class Ren a where ren :: (?db :: DB, ?funs :: Map FunId Fun) => a -> RenderExp ()
+class Ren a where ren :: (?db :: DB) => a -> RenderExp ()
instance Ren () where ren () = return ()
instance (RenderOne x, Ren xs, Tuple x xs t) => Ren t where
ren t | (x,xs) <- tsplit1 t = renderOne x >> ren xs
-renderExp' :: (?db :: DB, ?funs :: Map FunId Fun) => Exp -> RenderExp ()
+renderExp' :: (?db :: DB) => Exp -> RenderExp ()
renderExp' (Var i) = ren ( varType i, " ", varName i )
renderExp' (Call fun exps) = f template exps 0 where
f (TCons h x xs) (e:es) n = ren (h, E n e, f xs es (n+1))
f (TNil h) [] _ = ren (I h)
- Fun template _ body = ?funs Map.! fun
+ Fun _ template _ body = dbFunctions ?db Map.! fun
renderExp' (Literal vals) = ren ( I vals )
renderExp' (GetField field exp) = ren
( "the ", fieldName $ getField field, " of ", E 0 exp )
@@ -106,7 +106,7 @@
( E 0 e1, " sorted by ", E 1 e2, ", ", case order of
Ascending -> "ascending"; Descending -> "descending" )
renderExp' (Filter ty e1 e2) = mintVar (Single ty) $ \var -> ren
- ( "those ", Multiple ty, " ", varName var, " of ", E 0 e1
+ ( "those ", Multiple ty, " ", varName var, " of ", E 0 e1
, " such that ", E 1 e2 )
renderExp' (NumOp op e1 e2) = ren ( E 0 e1, " ", f op, " ", E 1 e2 ) where
f Add = "+"; f Subtract = "-"; f Mul = "*"; f Div = "/"
diff -rN -u old-fenserve/fendata/Types.hs new-fenserve/fendata/Types.hs
--- old-fenserve/fendata/Types.hs 2007-06-14 16:08:38.000000000 +0300
+++ new-fenserve/fendata/Types.hs 2007-06-14 16:08:39.000000000 +0300
@@ -60,11 +60,12 @@
data DB = DB { dbCategories :: Map CategoryId Category,
dbFields :: Map FieldId Field,
- dbItems :: Map ItemId Item }
+ dbItems :: Map ItemId Item,
+ dbFunctions :: Map FunId Fun }
deriving (Read, Show, Typeable, Data, Eq, Ord)
instance StartState DB where
- startStateM = return $ DB Map.empty Map.empty Map.empty
+ startStateM = return $ DB Map.empty Map.empty Map.empty Map.empty
@@ -90,9 +91,10 @@
u_itemCategories f (Item a b c) = Item a (f b) c
u_itemValues f (Item a b c) = Item a b (f c)
-u_dbCategories f (DB a b c) = DB (f a) b c
-u_dbFields f (DB a b c) = DB a (f b) c
-u_dbItems f (DB a b c) = DB a b (f c)
+u_dbCategories f (DB a b c d) = DB (f a) b c d
+u_dbFields f (DB a b c d) = DB a (f b) c d
+u_dbItems f (DB a b c d) = DB a b (f c) d
+u_dbFunctions f (DB a b c d) = DB a b c (f d)
u_cat x f = u_dbCategories $ Map.adjust f x
u_field x f = u_dbFields $ Map.adjust f x
@@ -129,13 +131,13 @@
-- Potions
----------------------------------------------------------------------------
-type FunId = String
-type Functions = Map FunId Fun
+type FunId = Id
data Order = Ascending | Descending
deriving (Read, Show, Typeable, Data, Eq, Ord)
-data Fun = Fun (Template Type) Type Exp
+data Fun = Fun { funId :: FunId, funTemplate :: Template Type,
+ funResult :: Type, funBody :: Exp }
deriving (Read, Show, Typeable, Data, Eq, Ord)
data NumOp = Add | Subtract | Mul | Div
diff -rN -u old-fenserve/fendata/Utils.hs new-fenserve/fendata/Utils.hs
--- old-fenserve/fendata/Utils.hs 2007-06-14 16:08:38.000000000 +0300
+++ new-fenserve/fendata/Utils.hs 2007-06-14 16:08:39.000000000 +0300
@@ -14,10 +14,17 @@
import qualified Data.Map as Map
+infixr 0 :$: -- '$' for applying type constructors to types
+infixr 0 :$$: -- '$' for applying transformers to type constructors
+
+type f :$: x = f x
+type (f :: (* -> *) -> (* -> *)) :$$: (x :: * -> *) = f x
+
type Endo a = a -> a
type Op a = a -> a -> a
+
fIf :: (a -> Bool) -> Op (a -> b)
fIf p f g x = if p x then f x else g x
More information about the Fencommits
mailing list