[Fencommits] fenserve: make 'for each' kinda sorta insertable

[Benja Fallenstein]

Fri May 25 15:43:42 EEST 2007  Benja Fallenstein <benja.fallenstein at gmail.com>
  * make 'for each' kinda sorta insertable
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs	2007-05-25 15:43:51.000000000 +0300
+++ new-fenserve/fendata/Main.hs	2007-05-25 15:43:51.000000000 +0300
@@ -74,7 +74,7 @@
 
 funParts (Fun _ ps _) = ps
 funParts (FieldFun _ name) = map toHTML ["the "++name++" of ", ""]
-funParts (CatFun cat) = map toHTML ["the " ++ cat ++ "s in the system"]
+funParts (CatFun cat) = map toHTML ["all the " ++ cat ++ "s in the system"]
 funParts (AddItemFun cat fs) = map toHTML $
                                ["Add a new "++cat++" with "] ++
                                [" as the "++f++", and " | f <- init fs] ++
@@ -91,19 +91,20 @@
             ++ [Concat []]
             ++ concatFor (Map.toList $ stateSchema s) (\(cat,fs) ->
                    Call (show $ CatFun cat) []
+                 : Forall (catType cat) 0 Nothing Nothing
                  : map (\f -> Call (show $ FieldFun cat f) [Nothing]) fs) where
     f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
 
 data Exp = Call String [Maybe Exp]
          | Var Int
-         | Forall Int Exp Exp
+         | Forall Type Int (Maybe Exp) (Maybe Exp)
          | Concat [Maybe Exp]
          | Str String
     deriving (Read, Show, Typeable, Data, Eq, Ord)
 
 expType (Call fun _) = funType $ readFun ?state fun
 expType (Var _) = error "no type inference yet"
-expType (Forall _ _ _) = string
+expType (Forall _ _ _ _) = string
 expType (Concat _) = string
 expType (Str _) = string
 
@@ -115,7 +116,7 @@
     ++maybe "" ("&name="++) ?name)]
                   
 renderMaybeExp (Just exp) cx ty = renderExp' exp cx ty
-renderMaybeExp Nothing cx ty = editLink cx (Var 0) ty $ surround $ bold $
+renderMaybeExp Nothing cx ty = editLink cx (Var 0) ty $ surroundSpan $ bold $
                                "[" +++ typeQuestion ty +++ "]"
 
 renderExp :: (?state :: MyState, ?link :: Bool, ?name :: Maybe String, 
@@ -127,16 +128,17 @@
     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 exp@(Var i) cx ty = editLink cx exp ty (renderVar i)
-renderExp (Forall i exp body) cx _ = "For each of " +++ renderExp' exp (\e -> cx $ Forall i e body) (expType exp)
-                            +++ " (call it '" +++ renderVar i +++ "'):\n"
-                            +++ tag' "blockquote" (renderExp body (\e -> cx $ Forall i exp e) string)
+renderExp e0@(Forall t i exp body) cx _ = surroundSpan (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"))
+                            +++ tag' "blockquote" (renderMaybeExp body (\e -> cx $ Forall t i exp (Just e)) string)
 renderExp (Str s) cx _ = tag "small" [] $ quoteP s
 renderExp exp@(Concat exps) cx _ = para $ catMap (\(xs,x,xs') -> renderMaybeExp x (\e -> cx (Concat (xs ++ [Just e] ++ xs'))) string) (slices exps) +++ if ?link then para $ editLink cx exp string "[edit]" else toHTML ""
 
 renderExp' e@(Str _) cx ty = renderExp e cx ty
-renderExp' e cx ty = surround (renderExp e cx ty)
+renderExp' e cx ty = surroundSpan (renderExp e cx ty)
 
-surround s = tag "span" [("class", if ?link then "editPotion" else "potion")] s
+surroundSpan s = tag "span" [("class", if ?link then "editPotion" else "potion")] s
+surroundDiv s = tag "div" [("class", "potion")] s
 
 slices xs = map (\i -> (take i xs, xs !! i, drop (i+1) xs)) [0..length xs-1]
 
@@ -144,7 +146,7 @@
 
 isComplete :: Exp -> Bool
 isComplete (Call _ args)  = all (maybe False isComplete) args
-isComplete (Forall _ exp body) = isComplete exp && isComplete body
+isComplete (Forall _ _ exp body) = all (maybe False isComplete) [exp, body]
 isComplete (Var _)        = True
 isComplete (Concat exps)    = all (maybe False isComplete) exps
 isComplete (Str _)        = True
@@ -157,11 +159,10 @@
     state <- get; let fn = readFun state fname
     vals <- mapM (runExp env . fromJust) args
     runFun fn vals
-runExp env (Forall v exp body) = do state <- get
-                                    let xs = evalStateT (runExp env exp) state
-                                    rs <- forM xs $ \x ->
-                                        runExp (Map.insert v x env) body
-                                    return $ concat rs
+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
+    return $ concat rs
 runExp env (Var i) = return $ fromMaybe ("0") $
                          Map.lookup i env
 runExp env (Concat exps) = do rs <- mapM (\(Just e) -> runExp env e) exps
@@ -215,7 +216,7 @@
         ])
         [Call "Blog_post_archive" []]
 
-potion = Forall 0 (Call (show $ CatFun "post") []) $
+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,