[Fencommits] fenserve: make FieldFun and CatFun expressions instead of functions, so functions are only for user-defined stuff now
Benja Fallenstein
benja.fallenstein at gmail.com
Fri May 25 18:00:59 EEST 2007
Fri May 25 18:00:49 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* make FieldFun and CatFun expressions instead of functions, so functions are only for user-defined stuff now
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-05-25 18:00:59.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-05-25 18:00:59.000000000 +0300
@@ -41,12 +41,12 @@
])
[Call "Blog_post_archive" []]
-potion = Forall (catType "post") 0 (Just $ Call (show $ CatFun "post") []) $ Just $
- Concat (map Just [Str "<h2>", Call (show $ FieldFun "post" "title") v, Str "</h2>",
- Str "\n<p>Author: ", Call (show $ FieldFun "post" "author") v,
- Str "\n<p>", Call (show $ FieldFun "post" "body") v,
+potion = Forall (catType "post") 0 (Just $ AllItems "post") $ Just $
+ Concat (map Just [Str "<h2>", Field "post" "title" v, Str "</h2>",
+ Str "\n<p>Author: ", Field "post" "author" v,
+ Str "\n<p>", Field "post" "body" v,
Str "\n<hr>"])
- where v = [Just $ Var 0]
+ where v = Just $ Var 0
readArgs :: Request -> [Value]
readArgs req = fromMaybe [] $ do
@@ -74,7 +74,6 @@
expand s (Call n args) = case readFun s n of
Fun _ _ body -> Just
(foldr (\i e -> subst' i (case args !! i of Just x -> Just x; Nothing -> Just (Var i)) e) body [0..length args-1], n)
- _ -> Nothing
expand _ _ = Nothing
subst :: Int -> Exp -> Exp -> Exp
diff -rN -u old-fenserve/fendata/PotionTypes.hs new-fenserve/fendata/PotionTypes.hs
--- old-fenserve/fendata/PotionTypes.hs 2007-05-25 18:00:59.000000000 +0300
+++ new-fenserve/fendata/PotionTypes.hs 2007-05-25 18:00:59.000000000 +0300
@@ -10,15 +10,18 @@
import Data.Set (Set)
import qualified Data.Set as Set
+type Category = String
+type Field = String
+
data Type = Type { typeQuestion :: String }
deriving (Read, Show, Typeable, Data, Eq, Ord)
data Fun = Fun [Type] [HTML] Exp
- | FieldFun String String
- | CatFun String
deriving (Read, Show, Typeable, Data, Eq, Ord)
data Exp = Call String [Maybe Exp]
+ | Field Category Field (Maybe Exp)
+ | AllItems Category
| Var Int
| Forall Type Int (Maybe Exp) (Maybe Exp)
| Concat [Maybe Exp]
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs 2007-05-25 18:00:59.000000000 +0300
+++ new-fenserve/fendata/Potions.hs 2007-05-25 18:00:59.000000000 +0300
@@ -18,37 +18,26 @@
string = Type "which text?"
readFun :: MyState -> String -> Fun
-readFun s n | ((r,""):_) <- reads n = r
- | otherwise = statePotions s Map.! n
+readFun s n = statePotions s Map.! n
funType (Fun _ _ exp) = expType exp
-funType (FieldFun _ _) = string
-funType (CatFun cat) = catType cat
funTypes (Fun ts _ _) = ts
-funTypes (FieldFun cat _) = [catType cat]
-funTypes (CatFun _) = []
funParts (Fun _ ps _) = ps
-funParts (FieldFun _ name) = map toHTML ["the "++name++" of ", ""]
-funParts (CatFun cat) = map toHTML ["all the " ++ cat ++ "s in the system"]
-
-for :: [a] -> (a -> b) -> [b]
-for = flip map
-
-concatFor :: [a] -> (a -> [b]) -> [b]
-concatFor = flip concatMap
getPotions :: MyState -> [Exp]
getPotions s = map f (Map.toList $ statePotions s)
++ [Concat []]
++ concatFor (Map.toList $ stateSchema s) (\(cat,fs) ->
- Call (show $ CatFun cat) []
+ AllItems cat
: Forall (catType cat) 0 Nothing Nothing
- : map (\f -> Call (show $ FieldFun cat f) [Nothing]) fs) where
+ : map (\f -> Field cat f Nothing) fs) where
f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
expType (Call fun _) = funType $ readFun ?state fun
+expType (Field _ _ _) = string
+expType (AllItems cat) = catType cat
expType (Var _) = error "no type inference yet"
expType (Forall _ _ _ _) = string
expType (Concat _) = string
@@ -77,6 +66,9 @@
f [] [x] _ n = editLink cx exp ty x
f (t:ts) (x:xs) (y:ys) n =
editLink cx exp ty x +++ renderMaybeExp' y (cx' n) t +++ f ts xs ys (n+1)
+renderExp e0@(Field cat field exp) cx ty = l "the " +++ field +++ l " of " +++ renderMaybeExp' exp (\e -> Field cat field $ Just e) (catType cat) where
+ l s = editLink cx e0 ty s
+renderExp e0@(AllItems cat) cx ty = editLink cx e0 ty ("all the "++cat++"s in the system")
renderExp exp@(Var i) cx ty = editLink cx exp ty (renderVar i)
renderExp e0@(Forall t i exp body) cx _ = editLink cx e0 string "For each of " +++ renderMaybeExp' exp (\e -> cx $ Forall t i (Just e) body) t
+++ editLink cx e0 string (" (call it '" +++ renderVar i +++ "'):\n")
@@ -95,6 +87,8 @@
isComplete :: Exp -> Bool
isComplete (Call _ args) = all (maybe False isComplete) args
+isComplete (Field _ _ exp) = maybe False isComplete exp
+isComplete (AllItems _) = True
isComplete (Forall _ _ exp body) = all (maybe False isComplete) [exp, body]
isComplete (Var _) = True
isComplete (Concat exps) = all (maybe False isComplete) exps
@@ -105,6 +99,13 @@
state <- get; let fn = readFun state fname
vals <- mapM (runExp env . fromJust) args
runFun fn vals
+runExp env (Field cat name (Just exp)) = do
+ state <- get
+ item <- runExp env exp
+ return $ itemFields (stateItems state Map.! read item) Map.! name
+runExp env (AllItems cat) = do
+ state <- get
+ msum [return $ show n | (n, Item _ cs) <- Map.toList (stateItems state), cat `Set.member` cs]
runExp env (Forall _ v (Just exp) (Just body)) = do
state <- get; let xs = evalStateT (runExp env exp) state
rs <- forM xs $ \x -> runExp (Map.insert v x env) body
@@ -117,10 +118,4 @@
runFun (Fun _ _ body) args =
runExp (Map.fromList [(i, args!!i) | i <- [0..length args-1]]) body
-runFun (FieldFun cat name) [item] = do
- state <- get
- return $ itemFields (stateItems state Map.! read item) Map.! name
-runFun (CatFun cat) [] = do
- state <- get
- msum [return $ show n | (n, Item _ cs) <- Map.toList (stateItems state), cat `Set.member` cs]
diff -rN -u old-fenserve/fendata/Utils.hs new-fenserve/fendata/Utils.hs
--- old-fenserve/fendata/Utils.hs 2007-05-25 18:00:59.000000000 +0300
+++ new-fenserve/fendata/Utils.hs 2007-05-25 18:00:59.000000000 +0300
@@ -8,6 +8,13 @@
import Data.List (intersperse)
+for :: [a] -> (a -> b) -> [b]
+for = flip map
+
+concatFor :: [a] -> (a -> [b]) -> [b]
+concatFor = flip concatMap
+
+
escape' = concatMap escapeMore . escape where
escapeMore '[' = "%5b"; escapeMore ']' = "%5d";
escapeMore '&' = "%26"; escapeMore c = [c]
More information about the Fencommits
mailing list