[Fencommits] fenserve: fix inline rendering of text parameters, remove Concat from list of potions
Benja Fallenstein
benja.fallenstein at gmail.com
Sat May 26 13:09:28 EEST 2007
Sat May 26 13:09:14 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* fix inline rendering of text parameters, remove Concat from list of potions
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-05-26 13:09:27.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-05-26 13:09:27.000000000 +0300
@@ -41,8 +41,8 @@
])
[("Blog_post_archive", [])]
-potion = Concat [Just $ Forall (catType "post") 0 (Just $ AllItems "post") $
- Concat (map Just [Str "<h2>", Field "post" "title" v, Str "</h2>",
+potion = Block [Just $ Forall (catType "post") 0 (Just $ AllItems "post") $
+ Block (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>"])]
@@ -127,16 +127,21 @@
hidden "name" name' +++
button ("[Save as "++name'++"]")+++" "+++mdot+++" "
-edit :: (Exp,Exp,Type,Maybe String) -> MyState -> (HTML, MyState)
-edit (exp,old@(Concat olds),ty,name) s = let ?state = s; ?link = False; ?name=name in
+editText exp old olds ty name s = let ?state = s; ?link = False; ?name=name in
(formG "editTemplate" $
- para (textarea "template" 20 80 $ f 1 olds)
+ para (field $ f 1 olds)
+++ para (submit "Submit" +++ hidden "exp" (show exp)
+++ maybe (HTML "") (hidden "name") name
+++ hidden "old" (show old)), s) where
- f i (Just (Str s) : xs) = s +++ f i xs
- f i (_:xs) = "$" +++ show i +++ f (i+1) xs
- f _ [] = toHTML ""
+ f i (Just (Str s) : xs) = s ++ f i xs
+ f i (_:xs) = "$" ++ show i ++ f (i+1) xs
+ f _ [] = ""
+ field = case old of Block _ -> textarea "template" 20 80
+ Inline _ -> textfield "template"
+
+edit :: (Exp,Exp,Type,Maybe String) -> MyState -> (HTML, MyState)
+edit (exp,old@(Block olds),ty,name) s = editText exp old olds ty name s
+edit (exp,old@(Inline olds),ty,name) s = editText exp old olds ty name s
edit (exp,old,ty,name) s = let ?state = s; ?link = False; ?name=name; ?root = "" in
(para ("Select something to replace '" +++ renderExp' old id ty +++ "' "
+++ "with.") +++ hr
@@ -164,10 +169,12 @@
++ maybe "" ("&name="++) (lookM msg "name")
, s) where
Just exp = fmap read $ lookM msg "exp"
- Just (Concat olds) = fmap read $ lookM msg "old"
+ Just (olds, isBlock) = flip fmap (lookM msg "old") $ \x -> case read x of
+ Inline olds -> (olds, False)
+ Block olds -> (olds, True)
Just tmp = lookM msg "template"
exps = filter (\e -> case e of Just (Str _) -> False; _ -> True) olds
- new = Concat $ f tmp
+ new = (if isBlock then Block else Inline) $ f tmp
f ('$':c:cs)
| i < length exps = Just (Str "") : (exps !! i) : f cs
| otherwise = Just (Str "") : Nothing : f cs
diff -rN -u old-fenserve/fendata/PotionTypes.hs new-fenserve/fendata/PotionTypes.hs
--- old-fenserve/fendata/PotionTypes.hs 2007-05-26 13:09:27.000000000 +0300
+++ new-fenserve/fendata/PotionTypes.hs 2007-05-26 13:09:27.000000000 +0300
@@ -27,9 +27,9 @@
| NewItemButton Category
| Var Int
| SortByField Category Field Int (Maybe Exp)
- | FilterByField Category Field Int (Maybe Exp) (Maybe Exp)
- | Forall Type Int (Maybe Exp) Exp -- body should always be a Concat
- | Concat [Maybe Exp]
+ | FilterByField Category Field Int (Maybe Exp) Exp -- body should always be an Inline
+ | Forall Type Int (Maybe Exp) Exp -- body should always be a Block
+ | Block [Maybe Exp] | Inline [Maybe Exp]
| Str String
deriving (Read, Show, Typeable, Data, Eq, Ord)
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs 2007-05-26 13:09:27.000000000 +0300
+++ new-fenserve/fendata/Potions.hs 2007-05-26 13:09:27.000000000 +0300
@@ -32,14 +32,13 @@
++ concatFor (Map.toList $ stateSchema s) (\(cat,fs) ->
AllItems cat
: NewItemButton cat
- : Concat []
- : Forall (catType cat) 0 Nothing (Concat [])
+ : Forall (catType cat) 0 Nothing (Block [])
: concatFor fs (\f -> [ Field cat f Nothing
, SortByField cat f 1 Nothing
, SortByField cat f (-1) Nothing
- , FilterByField cat f (-1) Nothing Nothing
- , FilterByField cat f 0 Nothing Nothing
- , FilterByField cat f 1 Nothing Nothing
+ , FilterByField cat f (-1) Nothing (Inline [])
+ , FilterByField cat f 0 Nothing (Inline [])
+ , FilterByField cat f 1 Nothing (Inline [])
])) where
f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
@@ -51,7 +50,8 @@
expType (SortByField cat _ _ _) = catType cat
expType (FilterByField cat _ _ _ _) = catType cat
expType (Forall _ _ _ _) = string
-expType (Concat _) = string
+expType (Block _) = string
+expType (Inline _) = string
expType (Str _) = string
editLink :: (?link :: Bool, ?name :: Maybe String, ?root :: String,
@@ -82,13 +82,14 @@
renderExp e0@(AllItems cat) cx ty = editLink cx e0 ty ("all the "++cat++"s in the system")
renderExp e0@(NewItemButton cat) cx ty = editLink cx e0 ty ("a link for creating a new "++cat)
renderExp exp@(Var i) cx ty = editLink cx exp ty (renderVar i)
-renderExp e0@(SortByField cat field i exp) cx ty = renderMaybeExp' exp (\e -> cx $ SortByField cat field i $ Just e) (catType cat) +++ editLink cx e0 ty (" sorted by "++field++if i<0 then ", descending" else ", ascending")
-renderExp e0@(FilterByField cat field i exp exp0) cx ty = renderMaybeExp' exp (\e -> cx $ FilterByField cat field i (Just e) exp0) (catType cat) +++ editLink cx e0 ty (" whose "++field++if i<0 then " comes before " else if i>0 then " comes after " else " is ") +++ renderMaybeExp' exp0 (\e -> cx $ FilterByField cat field i exp (Just e)) string
+renderExp e0@(SortByField cat field i exp) cx ty = renderMaybeExp' exp (\e -> cx $ SortByField cat field i $ Just e) (catType cat) +++ editLink cx e0 ty (", sorted by "++field++if i<0 then ", descending" else ", ascending")
+renderExp e0@(FilterByField cat field i exp exp0) cx ty = editLink cx e0 ty "those of " +++ renderMaybeExp' exp (\e -> cx $ FilterByField cat field i (Just e) exp0) (catType cat) +++ editLink cx e0 ty (" whose "++field++if i<0 then " comes before " else if i>0 then " comes after " else " is ") +++ renderExp exp0 (\e -> cx $ FilterByField cat field i exp e) string
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")
+++ tag' "blockquote" (renderExp body (\e -> cx $ Forall t i exp 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 exp@(Block exps) cx _ = para $ catMap (\(xs,x,xs') -> renderMaybeExp' x (\e -> cx (Block (xs ++ [Just e] ++ xs'))) string) (slices exps) +++ if ?link then para $ editLink cx exp string "[edit]" else toHTML ""
+renderExp exp@(Inline exps) cx _ = "\"" +++ catMap (\(xs,x,xs') -> renderMaybeExp' x (\e -> cx (Inline (xs ++ [Just e] ++ xs'))) string) (slices exps) +++ "\"" +++ if ?link then " " +++ editLink cx exp string "[edit]" else toHTML ""
renderExp' e@(Str _) cx ty = renderExp e cx ty
renderExp' e cx ty = surroundSpan (renderExp e cx ty)
@@ -105,10 +106,11 @@
isComplete (AllItems _) = True
isComplete (NewItemButton _) = True
isComplete (SortByField _ _ _ exp) = maybe False isComplete exp
-isComplete (FilterByField _ _ _ exp exp0) = all (maybe False isComplete) [exp,exp0]
+isComplete (FilterByField _ _ _ exp exp0) = maybe False isComplete exp && isComplete exp0
isComplete (Forall _ _ exp body) = maybe False isComplete exp && isComplete body
isComplete (Var _) = True
-isComplete (Concat exps) = all (maybe False isComplete) exps
+isComplete (Block exps) = all (maybe False isComplete) exps
+isComplete (Inline exps) = all (maybe False isComplete) exps
isComplete (Str _) = True
runExp :: (?root :: String) => Env -> Exp -> StateT MyState [] Value
@@ -133,7 +135,7 @@
msum $ map return rs
where f state x = itemFields (stateItems state Map.! read x) Map.! field
order = if i<0 then reverse else id
-runExp env (FilterByField cat field i (Just exp) (Just exp0)) = do
+runExp env (FilterByField cat field i (Just exp) exp0) = do
state <- get; let xs = evalStateT (runExp env exp) state
x0 <- runExp env exp0
let rs = filter (\a -> compare (f state a) x0 == compare i 0) xs
@@ -145,7 +147,9 @@
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
+runExp env (Block exps) = do rs <- mapM (\(Just e) -> runExp env e) exps
+ return $ concat rs
+runExp env (Inline exps) = do rs <- mapM (\(Just e) -> runExp env e) exps
return $ concat rs
runExp _ (Str s) = return s
diff -rN -u old-fenserve/fendata/UI.hs new-fenserve/fendata/UI.hs
--- old-fenserve/fendata/UI.hs 2007-05-26 13:09:27.000000000 +0300
+++ new-fenserve/fendata/UI.hs 2007-05-26 13:09:27.000000000 +0300
@@ -46,7 +46,7 @@
uri = ?root++"potion/"++fun++concat ["/"++a | a <- args]
in para $ bold $ link uri $ renderExp exp id string) +++
hr +++
- para (link (?root++"potion?exp="++(escape' $ show $ Concat [])) "New page") +++
+ para (link (?root++"potion?exp="++(escape' $ show $ Block [])) "New page") +++
para (link (?root++"table") "List of items in the database")) +++
tag "div" [("class", "content")] body) +++
tag "div" [("class", "footer")]
More information about the Fencommits
mailing list