[Fencommits] fenserve: rename (+++) to (&)
Benja Fallenstein
benja.fallenstein at gmail.com
Thu May 31 00:59:29 EEST 2007
Thu May 31 00:59:16 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* rename (+++) to (&)
diff -rN -u old-fenserve/fendata/HTML.hs new-fenserve/fendata/HTML.hs
--- old-fenserve/fendata/HTML.hs 2007-05-31 00:59:29.000000000 +0300
+++ new-fenserve/fendata/HTML.hs 2007-05-31 00:59:29.000000000 +0300
@@ -14,10 +14,10 @@
html :: ToHTML a => a -> String
html = fromHTML . toHTML
-infixr 0 +++
+infixr 0 &
-(+++) :: (ToHTML a, ToHTML b) => a -> b -> HTML
-x +++ y = HTML (html x ++ html y)
+(&) :: (ToHTML a, ToHTML b) => a -> b -> HTML
+x & y = HTML (html x ++ html y)
cat :: ToHTML a => [a] -> HTML
cat = HTML . concat . map (fromHTML . toHTML)
@@ -35,21 +35,21 @@
toHTML = HTML . concatMap quoteChar
instance (ToHTML a, ToHTML b) => ToHTML (a,b) where
- toHTML (a,b) = a +++ b
+ toHTML (a,b) = a & b
instance (ToHTML a, ToHTML (b,c)) => ToHTML (a,b,c) where
- toHTML (a,b,c) = a +++ (b,c)
+ toHTML (a,b,c) = a & (b,c)
instance (ToHTML a, ToHTML (b,c,d)) => ToHTML (a,b,c,d) where
- toHTML (a,b,c,d) = a +++ (b,c,d)
+ toHTML (a,b,c,d) = a & (b,c,d)
instance (ToHTML a, ToHTML (b,c,d,e)) => ToHTML (a,b,c,d,e) where
- toHTML (a,b,c,d,e) = a +++ (b,c,d,e)
+ toHTML (a,b,c,d,e) = a & (b,c,d,e)
instance (ToHTML a, ToHTML (b,c,d,e,f)) => ToHTML (a,b,c,d,e,f) where
- toHTML (a,b,c,d,e,f) = a +++ (b,c,d,e,f)
+ toHTML (a,b,c,d,e,f) = a & (b,c,d,e,f)
instance (ToHTML a, ToHTML (b,c,d,e,f,g)) => ToHTML (a,b,c,d,e,f,g) where
- toHTML (a,b,c,d,e,f,g) = a +++ (b,c,d,e,f,g)
+ toHTML (a,b,c,d,e,f,g) = a & (b,c,d,e,f,g)
instance (ToHTML a, ToHTML (b,c,d,e,f,g,h)) => ToHTML (a,b,c,d,e,f,g,h) where
- toHTML (a,b,c,d,e,f,g,h) = a +++ (b,c,d,e,f,g,h)
+ toHTML (a,b,c,d,e,f,g,h) = a & (b,c,d,e,f,g,h)
instance (ToHTML a, ToHTML (b,c,d,e,f,g,h,i)) => ToHTML (a,b,c,d,e,f,g,h,i) where
- toHTML (a,b,c,d,e,f,g,h,i) = a +++ (b,c,d,e,f,g,h,i)
+ toHTML (a,b,c,d,e,f,g,h,i) = a & (b,c,d,e,f,g,h,i)
quoteBr = HTML . concatMap (\c -> case c of '\n' -> "<br>"; _ -> quoteChar c)
quoteP = HTML . concatMap (\c -> case c of '\n' -> "<p>"; _ -> quoteChar c)
@@ -58,15 +58,15 @@
'&' -> "&"; _ -> [c]
tag :: ToHTML a => String -> [(String,String)] -> a -> HTML
-tag name attrs content = HTML "<"+++name+++a+++HTML ">"+++content
- +++HTML "</"+++name+++HTML ">"
- where a = catFor attrs $ \(a,v) -> " "+++a+++HTML "='"+++v+++HTML "'"
+tag name attrs content = HTML "<"&name&a&HTML ">"&content
+ &HTML "</"&name&HTML ">"
+ where a = catFor attrs $ \(a,v) -> " "&a&HTML "='"&v&HTML "'"
tag' name = tag name []
etag :: String -> [(String,String)] -> HTML
-etag name attrs = HTML "<"+++name+++a+++HTML ">"
- where a = catFor attrs $ \(a,v) -> " "+++a+++HTML "='"+++v+++HTML "'"
+etag name attrs = HTML "<"&name&a&HTML ">"
+ where a = catFor attrs $ \(a,v) -> " "&a&HTML "='"&v&HTML "'"
style s = tag "span" [("style", s)]
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-05-31 00:59:29.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-05-31 00:59:29.000000000 +0300
@@ -83,7 +83,7 @@
run f x = do
state <- get; let r = f x state
case System.IO.Unsafe.unsafePerformIO $ Control.Exception.catch (Control.Exception.evaluate (length (show r) `seq` Right r)) (\e -> return $ Left e) of
- Right (s, state') -> do put state'; respond $ html (header +++ s)
+ Right (s, state') -> do put state'; respond $ html (header & s)
Left e -> respond $ "Internal server error: " ++ show e
runRedirect f x = do
@@ -101,10 +101,10 @@
else toHTML "(Incomplete expression.)"
Fun _ _ funBody = readFun s fun
expandLink = (para $ qlink "potion" [P "exp" funBody, P "name" fun] "[edit page]")
- +++ maybe (HTML "") (\page ->
+ & maybe (HTML "") (\page ->
(if page `elem` stateSidebarPages s then HTML "" else
para $ formP (?root++"addToSidebar") (hidden "page" (show page)
- +++ button "[add to sidebar]")))
+ & button "[add to sidebar]")))
(case exp of
Call fun args -> fmap (\a -> (fun,a)) $
sequence args >>=
@@ -116,24 +116,24 @@
tag "div" [("style", "border: 1px solid black; \
\margin-bottom: 1em; padding: 1em; \
\padding-bottom: 0; font-weight: bold")]
- (rendered +++ saveLinks) +++ body, s) where
+ (rendered & saveLinks) & body, s) where
body = if (isComplete exp)
then (HTML $ head $ evalStateT (runExp env exp) s)
else toHTML "(Incomplete expression.)"
rendered = let ?state=s; ?link=True; ?name=name in renderExp exp id string
env = Map.fromList $ zip [0..length args-1] args
- saveLinks = formP (?root++"addpotion") $ (+++hidden "exp" (show exp)) $
- (+++ qlink "makefun" [P "exp" exp] "[Save as...]") $
+ saveLinks = formP (?root++"addpotion") $ (&hidden "exp" (show exp)) $
+ (& qlink "makefun" [P "exp" exp] "[Save as...]") $
flip (maybe $ HTML "") name $ \name' ->
- hidden "name" name' +++
- button ("[Save as "++name'++"]")+++" "+++mdot+++" "
+ hidden "name" name' &
+ button ("[Save as "++name'++"]")&" "&mdot&" "
editText exp old olds ty name s = let ?state = s; ?link = False; ?name=name in
(formG (?root++"editTemplate") $
para (field $ f 1 olds)
- +++ para (submit "Submit" +++ hidden "exp" (show exp)
- +++ maybe (HTML "") (hidden "name") name
- +++ hidden "old" (show old)), s) where
+ & 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 _ [] = ""
@@ -145,11 +145,11 @@
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 in
- (para ("Select something to replace '" +++ renderExp' old id ty +++ "' "
- +++ "with.") +++ hr
- +++ para ("Variables: " +++ cat [linkExp (Var i) (renderVar i)+++" "
+ (para ("Select something to replace '" & renderExp' old id ty & "' "
+ & "with.") & hr
+ & para ("Variables: " & cat [linkExp (Var i) (renderVar i)&" "
| i <- [0..25]])
- +++ (catFor (filter ((==ty) . expType) $ getPotions s) $ \repl ->
+ & (catFor (filter ((==ty) . expType) $ getPotions s) $ \repl ->
para $ li $ linkExp repl $ renderExp repl id (error "some type"))
, s) where linkExp new = tag "a" [("class", "editLink"),
("href", ?root ++ "potion?exp=" ++ show (subst (-1) new exp)
@@ -158,11 +158,11 @@
makeFun :: (?root :: String) => Request -> MyState -> (HTML, MyState)
makeFun msg s = let ?state = s; ?link = False; ?name=lookM msg "name" in
- (para ("Save '"+++renderExp' exp id (error "some type")+++"' as the "
- +++ "following potion (" +++ code "$(cat)" +++ ", where 'cat' is \
+ (para ("Save '"&renderExp' exp id (error "some type")&"' as the "
+ & "following potion (" & code "$(cat)" & ", where 'cat' is \
\a category name, marks a hole):")
- +++ formP (?root++"addpotion") (para (textarea "template" 3 80 "")
- +++ para (submit "Save") +++ hidden "exp" (show exp)), s)
+ & formP (?root++"addpotion") (para (textarea "template" 3 80 "")
+ & para (submit "Save") & hidden "exp" (show exp)), s)
where Just exp = fmap read $ lookM msg "exp"
editTemplate :: Request -> MyState -> (String, MyState)
@@ -214,21 +214,21 @@
showTable req s = (
makePage s ("List of "++plural cat++" in the database") "" $
tag "table" [("border","1")] $
- (tag "tr" [] $ catFor cols $ \col -> tag "th" [] $ capitalize col) +++
+ (tag "tr" [] $ catFor cols $ \col -> tag "th" [] $ capitalize col) &
(tag "tr" [] $ tag "td" [("colspan", show $ length cols),
("style", "text-align: center")] $
if not $ null items then new else
- ital ("There are no "++plural cat++" in the database. ") +++
- mdot +++ new) +++
+ ital ("There are no "++plural cat++" in the database. ") &
+ mdot & new) &
(catFor (Map.toList $ stateItems s) $ \(id, Item fields cats) ->
if cat `Set.member` cats then tag "tr" [] $
catFor cols $ \col -> tag "td" [] $
qlink ("item/"++show id) [P "returnTo" "table"] $ fields Map.! col
else HTML ""),
- s) where new = formP (?root++"newItem") $ foldl1 (+++)
+ s) where new = formP (?root++"newItem") $ foldl1 (&)
[ hidden "returnTo" "table"
, hidden "cat" cat
- , button $ bold ("[New "+++cat+++"]") ]
+ , button $ bold ("[New "&cat&"]") ]
cat = fromMaybe (head $ Map.keys $ stateSchema s) (lookM req "cat")
items = flip filter (Map.toList $ stateItems s) $
\(_, Item _ cats) -> cat `Set.member` cats
@@ -239,18 +239,18 @@
String -> Request -> MyState -> (HTML, MyState)
showItem item req s = let Item fields cats = stateItems s Map.! read item in (
makePage s "Item editor" "" $
- formP "" . ((returnTo+++buttons+++hr)+++) . (+++hr+++buttons) .
+ formP "" . ((returnTo&buttons&hr)&) . (&hr&buttons) .
catFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
- (h3 (capitalize cat) +++) . para
- . (+++ HTML ("<p><a href='"++ ?root++"addField?item="++item
+ (h3 (capitalize cat) &) . para
+ . (& HTML ("<p><a href='"++ ?root++"addField?item="++item
++ "&category="++cat
++ "&returnTo=item/"++item++html (escape ("?returnTo="++escape uri))
++ "'>[Add a field to the "++capitalize cat++" category]</a><br>"))
. catFor cfs $ \field ->
- capitalize field +++ ": "
- +++ (if field == "body" then (br +++) . textarea field 5 80
+ capitalize field & ": "
+ & (if field == "body" then (br &) . textarea field 5 80
else textfield field) (fields Map.! field)
- +++ br,
+ & br,
s) where uri = fromMaybe "" (lookM req "returnTo")
returnTo = flip (maybe $ HTML "") (lookM req "returnTo") $ \uri -> HTML $
"<input type=hidden name=returnTo value='"++html(escape uri)++"'>"
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs 2007-05-31 00:59:29.000000000 +0300
+++ new-fenserve/fendata/Potions.hs 2007-05-31 00:59:29.000000000 +0300
@@ -71,11 +71,11 @@
renderMaybeExp (Just exp) cx ty = renderExp exp cx ty
renderMaybeExp Nothing cx ty = editLink cx (Var 0) ty $ bold $
- "[" +++ typeQuestion ty +++ "]"
+ "[" & typeQuestion ty & "]"
renderMaybeExp' (Just exp) cx ty = renderExp' exp cx ty
renderMaybeExp' Nothing cx ty = editLink cx (Var 0) ty $ surroundSpan $ bold $
- "[" +++ typeQuestion ty +++ "]"
+ "[" & typeQuestion ty & "]"
renderExp :: (?state :: MyState, ?link :: Bool, ?name :: Maybe String,
?root :: String) => Exp -> (Exp -> Exp) -> Type -> HTML
@@ -84,22 +84,22 @@
cx' n e = cx $ Call fname $ take n args ++ [Just e] ++ drop (n+1) args
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)
+ editLink cx exp ty x & renderMaybeExp' y (cx' n) t & f ts xs ys (n+1)
f ts xs [] n = f ts xs [Just $ Str "0"] n
-renderExp e0@(Field cat field exp) cx ty = editLink cx e0 ty ("the " +++ field +++ " of ") +++ renderMaybeExp' exp (\e -> cx $ Field cat field $ Just e) (catType cat) where
+renderExp e0@(Field cat field exp) cx ty = editLink cx e0 ty ("the " & field & " of ") & renderMaybeExp' exp (\e -> cx $ Field cat field $ Just e) (catType cat) where
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@(Type cat) =
- editLink cx exp ty (cat +++ " '" +++ renderVar i +++ "'")
+ editLink cx exp ty (cat & " '" & renderVar i & "'")
renderExp Today cx ty = editLink cx Today ty "today's date"
-renderExp e0@(SortByField cat field i exp) cx ty = renderMaybeExp' exp (\e -> cx $ SortByField cat field i $ Just e) (pluralType 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) (pluralType 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 cat i exp body) cx _ = editLink cx e0 string ("For each "+++cat+++" '"+++renderVar i+++"' of ") +++ renderMaybeExp' exp (\e -> cx $ Forall cat i (Just e) body) (pluralType cat)
- +++ editLink cx e0 string (":\n")
- +++ tag' "blockquote" (renderExp body (\e -> cx $ Forall cat i exp e) string)
+renderExp e0@(SortByField cat field i exp) cx ty = renderMaybeExp' exp (\e -> cx $ SortByField cat field i $ Just e) (pluralType 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) (pluralType 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 cat i exp body) cx _ = editLink cx e0 string ("For each "&cat&" '"&renderVar i&"' of ") & renderMaybeExp' exp (\e -> cx $ Forall cat i (Just e) body) (pluralType cat)
+ & editLink cx e0 string (":\n")
+ & tag' "blockquote" (renderExp body (\e -> cx $ Forall cat i exp e) string)
renderExp (Str s) cx _ = tag "small" [] $ quoteP s
-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 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)
@@ -138,8 +138,8 @@
msum [return $ show n | (n, Item _ cs) <- Map.toList (stateItems state), cat `Set.member` cs]
runExp env (NewItemButton cat) = do
return $ html $ formP (?root++"newItem") $
- hidden "returnTo" "" +++
- button' "cat" cat (bold ("[Create a new "+++cat+++"]"))
+ hidden "returnTo" "" &
+ button' "cat" cat (bold ("[Create a new "&cat&"]"))
runExp env (SortByField cat field i (Just exp)) = do
state <- get; let xs = evalStateT (runExp env exp) state
let rs = order $ sortBy (\a b -> compare (f state a) (f state b)) xs
diff -rN -u old-fenserve/fendata/Utils.hs new-fenserve/fendata/Utils.hs
--- old-fenserve/fendata/Utils.hs 2007-05-31 00:59:29.000000000 +0300
+++ new-fenserve/fendata/Utils.hs 2007-05-31 00:59:29.000000000 +0300
@@ -35,7 +35,7 @@
commaList [] = toHTML ""
commaList [x] = toHTML x
commaList xs = cat (intersperse (toHTML ", ") $ map toHTML $ init xs)
- +++ " and " +++ last xs
+ & " and " & last xs
capitalize (c:cs) = toUpper c : cs
capitalize "" = ""
@@ -49,6 +49,6 @@
mdot = style "margin-left: 0.5em; margin-right: 0.5em; font-weight: bold" $
HTML "·"
-mdotted = cat . intersperse (" "+++mdot+++" ")
+mdotted = cat . intersperse (" "&mdot&" ")
More information about the Fencommits
mailing list