[Fencommits] fenserve: implement execution for the new potion type
Benja Fallenstein
benja.fallenstein at gmail.com
Tue Jun 5 17:46:06 EEST 2007
Tue Jun 5 16:14:41 EEST 2007 Benja Fallenstein <benja.fallenstein at gmail.com>
* implement execution for the new potion type
diff -rN -u old-fenserve/fendata/Main.hs new-fenserve/fendata/Main.hs
--- old-fenserve/fendata/Main.hs 2007-06-05 17:46:05.000000000 +0300
+++ new-fenserve/fendata/Main.hs 2007-06-05 17:46:06.000000000 +0300
@@ -1,340 +1,4 @@
-{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
-import HTML
import Potions
-import PotionTypes
-import UI
-import Utils
-
-import HAppS hiding (Body, getPath)
-import Control.Monad.State
-import Data.Generics (Typeable, Data, everywhere, mkT)
-import Data.Binary hiding (get,put)
-import Data.Maybe (fromJust, fromMaybe, isJust)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Int (Int64)
-
-import qualified System.IO.Unsafe
-import qualified Control.Exception
-
-instance Binary MyState where
-
-instance StartState MyState where
- startStateM = return $ flip MyState
- (Map.fromList [("post", ["title", "author", "body", "date"])])
- (Map.fromList [
- (0, Item (Map.fromList [("title", "Hello world!"),
- ("author", "Me"),
- ("body", "Here we come."),
- ("date", "2007-05-15")])
- (Set.fromList ["post"]))
- , (1, Item (Map.fromList [("title", "Hello worlds!"),
- ("author", "Us"),
- ("body", "Here I come."),
- ("date", "2007-05-15")])
- (Set.fromList ["post"]))
- ])
- (Map.fromList [
- ("Blog_post_archive", Fun [] [HTML "Blog post archive"] potion)
- ])
- [("Blog_post_archive", [])]
-
-potion = Block [Just $ Forall "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>"])]
- where v = Just $ Var 0
-
-readArgs :: Request -> [Value]
-readArgs req = fromMaybe [] $ do
- n <- fmap read $ lookM req "count"
- forM [1..n] $ \i -> lookM req ("arg" ++ show i)
-
-
-addFieldGet = runGet
- ( h2 ("Add field to category ", lookE "category")
- , formP ""
- ( "Field: " & textfield "name" ""
- , channel ["category", "item"]
- , hidden "returnTo" $ lookI "returnTo" ("item/"++lookE "item")
- , submit "Submit" ) )
-
-addFieldPost = runPost (lookE "returnTo")
- [ u_schema $ Map.adjust (++ [lookE "name"]) (lookE "category")
- , u_items $ Map.map $ fIf' (`hasCat` (lookE "category")) $
- u_fields $ insertIfNew (lookE "name") "" ]
-
-addCategory = runPost "table"
- [ u_schema $ insertIfNew (uncapitalize $ lookE "name") ["name"] ]
-
-subst :: Int -> Exp -> Exp -> Exp
-subst i repl e = everywhere (mkT f) e where
- f :: Exp -> Exp
- f (Var j) | j == i = repl
- f x = x
-
-
-evaluate x = System.IO.Unsafe.unsafePerformIO $ Control.Exception.catch
- (Control.Exception.evaluate (length (show x) `seq` Right x))
- (\e -> return $ Left e)
-
---run :: (a -> MyState -> (String, MyState)) -> a -> blah
-run f x = do
- state <- get
- case evaluate (f x state) of
- Right (s, state') -> do put state'; respond $ html (header & s)
- Left e -> respond $ "Internal server error: " ++ show e
-
-runRedirect f x = do
- state <- get
- case evaluate (f x state) of
- Right (s, state') -> do put state'; respond (s, html $ link s "link")
- Left e -> respond $ ("", "Internal server error: " ++ show e)
-
-runGet page = ok $ \() () -> respond $ case evaluate (html $ header & page) of
- Right s -> s; Left e -> "Internal server error: " ++ show e
-
-runPost uri fs = seeOther $ \() () ->
- case evaluate (foldl1 (flip (.)) fs ?state, uri) of
- Right (s',u) -> put s' >> respond (u, html $ link u "link")
- Left e -> respond $ ("", "Internal server error: " ++ show e)
-
-potionPage fun args name s = (makePage title expandLink body, s) where
- exp = Call fun (map (Just . Str) $ args)
- title = let ?state=s; ?link=False; ?name=name in renderExp exp id string
- env = Map.fromList $ zip [0..length args-1] args
- body = if (isComplete exp)
- then (HTML $ head $ evalStateT (runExp env exp) s)
- else toHTML "(Incomplete expression.)"
- Fun _ _ funBody = readFun s fun
- expandLink = para (qlink "potion" [P "exp" funBody, P "name" fun]
- "[edit page]")
- & maybe (HTML "") (\page ->
- (if page `elem` stateSidebarPages s then HTML "" else
- para $ formP (?root++"addToSidebar")
- (hidden "page" (show page)
- & button "[add to sidebar]")))
- (case exp of
- Call fun args -> fmap (\a -> (fun,a)) $
- sequence args >>=
- mapM (\a -> case a of Str s -> Just s
- _ -> Nothing)
- _ -> Nothing)
-
-potionGet exp args name s = (makePage "Custom page" "" $
- tag "div" [P "style" "border: 1px solid black; \
- \margin-bottom: 1em; padding: 1em; \
- \padding-bottom: 0; font-weight: bold"]
- (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...]") $
- flip (maybe $ HTML "") name $ \name' ->
- 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
- 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 :: (?root :: String)
- => (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 in
- (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 ->
- para $ li $ linkExp repl $ renderExp repl id (error "some type"))
- , s) where linkExp new = tag "a"
- [ P "class" "editLink"
- , P "href" $ ?root ++ "potion?exp="
- ++ show (subst (-1) new exp)
- ++ maybe "" ("&name="++) name]
- . tag "span" [P "class" "editPotion"]
-
-makeFun = let ?link = False; ?name = lookIM "name" in
- ( para ( "Save '", renderExp' (lookR "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", channel ["exp"] ) ) )
-
-editTemplate :: Request -> MyState -> (String, MyState)
-editTemplate msg s =
- ("potion?exp=" ++ escape' (show (subst (-1) new exp))
- ++ maybe "" ("&name="++) (lookM msg "name")
- , s) where
- Just exp = fmap read $ lookM msg "exp"
- 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 = (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
- where i = read [c] - 1
- f (c:cs) = (Just (Str (c:r)):rs) where (Just (Str r):rs) = f cs
- f "" = [Just (Str "")]
-
-addPotion :: Request -> MyState -> (String, MyState)
-addPotion msg s = ("potion/"++name, s { statePotions = newPotions }) where
- Just template = lookM msg "template"
- Just exp = fmap read $ lookM msg "exp"
- name = fromMaybe (getName template) $ lookM msg "name" where
- getName ('$':'(':cs) = 'X' : getName (drop 1 $ dropWhile (/= ')') cs)
- getName (' ':cs) = '_' : getName cs
- getName (c:cs) = c : getName cs
- getName "" = ""
- potion = case lookM msg "name" of
- Nothing -> let (parts, types) = f template ""
- in Fun types (map toHTML parts) exp
- Just n -> let Fun ts ps _ = statePotions s Map.! n
- in Fun ts ps exp
- newPotions = Map.insert name potion $ statePotions s
- f ('$':'(':cs) part = (reverse part : ps, t : ts)
- where (ps,ts) = f (drop 1 $ dropWhile (/= ')') cs) ""
- t = catType $ takeWhile (/= ')') cs
- f (c:cs) part = f cs (c:part)
- f "" part = ([reverse part], [])
-
-addToSidebar :: Request -> MyState -> (String, MyState)
-addToSidebar msg s = ("potion/"++fn++concat ["/"++a | a <- args], s') where
- s' = s { stateSidebarPages = stateSidebarPages s ++ [page] }
- Just page@(fn,args) = fmap read $ lookM msg "page"
-
-showTable = makePage ("List of "++plural cat++" in the database") ""
- ( tag "table" [P "border" "1"]
- ( tag "tr" [] $ catFor cols $ \col -> tag "th" [] $ capitalize col
- , tag "tr" [] $ tag "td" [P "colspan" $ length cols,
- P "style" "text-align: center"]
- ( hif (null items) $ ital ( "There are no ", plural cat,
- " in the database. " ) & mdot
- , formP (?root++"newItem")
- ( hidden "returnTo" $ "table?cat="++cat
- , hidden "cat" cat
- , button $ bold ("[New ", cat, "]") ) )
-
- , catFor (Map.toList allItems) $ \(id, Item fields cats) ->
- hif (cat `Set.member` cats) $ tag "tr" [] $
- catFor cols $ \col -> tag "td" [] $
- qlink ("item/"++show id) [P "returnTo" $ "table?cat="++cat]
- (fields Map.! col) ) )
-
- where cat = lookI "cat" (head $ Map.keys schema)
- items = flip filter (Map.toList allItems) $
- \(_, Item _ cats) -> cat `Set.member` cats
- cols = lookRD "cols" (take 1 $ schema Map.! cat)
-
-showItem :: (?root :: String, ?state :: MyState, ?req :: Request) =>
- String -> Request -> MyState -> (HTML, MyState)
-showItem item req s = let Item fields cats = stateItems s Map.! read item in (
- makePage "Item editor" "" $ formP ""
- ( channel ["returnTo"]
- , buttons, hr
- , catFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
- ( h3 (capitalize cat)
- , para $ catFor cfs $ \field ->
- ( capitalize field, ": "
- , (if field == "body" then (br &) . textarea field 5 80
- else textfield field) (fields Map.! field)
- , br )
- , para $ qlink "addField"
- [ P "item" item
- , P "category" cat
- , P "returnTo" $ "item/"++item++escape ("?returnTo="++escape uri)
- ]
- ("[Add a field to the ", capitalize cat, " category]") )
- , hr, buttons ),
- s) where uri = fromMaybe "" $ lookM req "returnTo"
- buttons = para ( button "[Save]", " ", mdot, " "
- , link (?root++uri) "[Cancel]" )
-
-
-updateItem :: (?root :: String) =>
- String -> Request -> MyState -> (String, MyState)
-updateItem item_s req s = (maybe "" (?root++) returnTo, s') where
- returnTo = lookM req "returnTo"
- item = read item_s
- s' = s { stateItems = Map.insert item (Item fields' cats) (stateItems s) }
- Item fields cats = stateItems s Map.! item
- fields' = flip Map.mapWithKey fields $ \k v -> fromMaybe v (lookM req k)
-
-newItem msg s = (?root++"item/"++show id++returnTo, s') where
- returnTo = maybe "" (("?returnTo="++) . escape) (lookM msg "returnTo")
- id = nextId $ stateItems s
- s' = s { stateItems = Map.insert id item $ stateItems s }
- item = Item (Map.fromList $ [(f,"") | f <- catFs]) (Set.fromList [cat])
- catFs = stateSchema s Map.! cat
- Just cat = lookM msg "cat"
-
-delItem msg s = ("table", s') where
- s' = s { stateItems = Map.delete id $ stateItems s }
- Just id = fmap read $ lookM msg "item"
-
-main = stdHTTP [ debugFilter
- , h (Prefix ()) () $ \(path::[String]) req ->
- getTime >>= \time -> get >>= \state ->
- let ?time = time; ?state = state; ?req = req
- ?root = concatMap (const "../") $ drop 1 path
- in runServerParts [app] req
- ]
-
-app :: (?root :: String, ?time :: Int64, ?req :: Request, ?state :: MyState)
- => ServerPart (Ev MyState ev) Request IO Result
-app = multi
- [ h ["potion"] GET $ ok $ \() -> run $
- \req s -> potionGet (read $ fromJust $ lookM req "exp")
- (readArgs req) (lookM req "name") s
- , h (Prefix ["potion"]) GET $ ok $ \(fun:args) -> run $
- \req s -> potionPage fun args (lookM req "name") s
- , h ["edit"] GET $ ok $ \() -> run $ \req ->
- edit (read $ fromJust $ lookM req "exp",
- read $ fromJust $ lookM req "old",
- read $ fromJust $ lookM req "type",
- lookM req "name")
- , h ["editTemplate"] GET $ seeOther $ \() -> runRedirect editTemplate
- , h ["makefun"] GET $ runGet makeFun
- , h ["table"] GET $ runGet showTable
- , h (Prefix ["item"]) GET $ ok $ \[item] -> run (showItem item)
- , h (Prefix ["item"]) POST $ seeOther $ \[item] ->
- runRedirect (updateItem item)
- , h ["newItem"] POST $ seeOther $ \() -> runRedirect newItem
- , h ["delItem"] POST $ seeOther $ \() -> runRedirect delItem
-
- , h [""] GET $ seeOther $ \() -> runRedirect $ \() s ->
- ("potion/" ++ (case head $ stateSidebarPages s of
- (fn,args) -> fn ++ concat ["/"++a | a <- args]), s)
- , h ["addField"] GET $ addFieldGet
- , h ["addField"] POST $ addFieldPost
- , h ["addCategory"] GET $ runGet
- ( h2 "Add category"
- , formP "" ( "Name: " & textfield "name" ""
- , submit "Submit" ) )
- , h ["addCategory"] POST $ addCategory
- , h ["addpotion"] POST $ seeOther $ \() -> runRedirect addPotion
- , h ["addToSidebar"] POST $ seeOther $ \() -> runRedirect addToSidebar
- ]
+main = print "Hello world!"
diff -rN -u old-fenserve/fendata/PotionTypes.hs new-fenserve/fendata/PotionTypes.hs
--- old-fenserve/fendata/PotionTypes.hs 2007-06-05 17:46:05.000000000 +0300
+++ new-fenserve/fendata/PotionTypes.hs 1970-01-01 02:00:00.000000000 +0200
@@ -1,70 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
-
-module PotionTypes where
-
-import HTML
-
-import Data.Generics (Typeable, Data)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-type Category = String
-type Field = String
-
-data Type = Type String
- deriving (Read, Show, Typeable, Data, Eq, Ord)
-
-typeQuestion (Type s) = "which " ++ s ++ "?"
-
-data Fun = Fun [Type] [HTML] Exp
- deriving (Read, Show, Typeable, Data, Eq, Ord)
-
-data Exp = Call String [Maybe Exp]
- | Field Category Field (Maybe Exp)
- | AllItems Category
- | NewItemButton Category
- | Var Int
- | SortByField Category Field Int (Maybe Exp)
- | FilterByField Category Field Int (Maybe Exp) Exp -- body should always be an Inline
- | Forall Category Int (Maybe Exp) Exp -- body should always be a Block
- | Block [Maybe Exp] | Inline [Maybe Exp]
- | Str String
- | Today
- deriving (Read, Show, Typeable, Data, Eq, Ord)
-
-
-type Env = Map Int Value
-type Value = String
-
-
-
-type Id = Int
-
-data Item = Item { itemFields :: Map String String, itemCategories :: Set String }
- deriving (Read, Show, Typeable, Data)
-
-hasCat :: Item -> String -> Bool
-hasCat i c = c `Set.member` itemCategories i
-
-u_fields f i = i { itemFields = f (itemFields i) }
-u_categories f i = i { itemCategories = f (itemCategories i) }
-
-nextId :: Map Id a -> Id
-nextId m = if Map.null m then 0 else fst (Map.findMax m) + 1
-
-data MyState = MyState { stateItems :: Map Id Item,
- stateSchema :: Map String [String],
- statePotions :: Map String Fun,
- stateSidebarPages :: [(String, [String])] }
- deriving (Read, Show, Typeable, Data)
-
-u_items f s = s { stateItems = f (stateItems s) }
-u_schema f s = s { stateSchema = f (stateSchema s) }
-u_potions f s = s { statePotions = f (statePotions s) }
-u_sidebarPages f s = s { stateSidebarPages = f (stateSidebarPages s) }
-
-schema = stateSchema ?state
-allItems = stateItems ?state
-allPotions = statePotions ?state
diff -rN -u old-fenserve/fendata/Potions.hs new-fenserve/fendata/Potions.hs
--- old-fenserve/fendata/Potions.hs 2007-06-05 17:46:05.000000000 +0300
+++ new-fenserve/fendata/Potions.hs 2007-06-05 17:46:06.000000000 +0300
@@ -3,204 +3,80 @@
module Potions where
import HTML
-import PotionTypes
+import Types
+import HListUtils
import Utils
-import Control.Monad.State
+import Control.Monad
+import Data.Int (Int64)
+import Data.List (sort)
+import Data.Generics (Typeable, everything, mkQ)
import Data.Map (Map)
import qualified Data.Map as Map
-import Data.Maybe (fromJust, fromMaybe, isJust)
-import Data.List (sortBy, filter)
-import Data.Set (Set)
-import qualified Data.Set as Set
-
-import Data.Int (Int64)
-import Text.Printf (printf)
import System.Time
-catType cat = Type cat
-pluralType cat = Type (plural cat)
-string = Type "text"
-
-readFun :: MyState -> String -> Fun
-readFun s n = statePotions s Map.! n
-
-funType (Fun _ _ exp) = expType exp
-
-funTypes (Fun ts _ _) = ts
-
-funParts (Fun _ ps _) = ps
-
-getPotions :: MyState -> [Exp]
-getPotions s = map f (Map.toList $ statePotions s)
- ++ [Today]
- ++ concatFor (Map.toList $ stateSchema s) (\(cat,fs) ->
- AllItems cat
- : NewItemButton cat
- : Forall 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 (Inline [])
- , FilterByField cat f 0 Nothing (Inline [])
- , FilterByField cat f 1 Nothing (Inline [])
- ])) where
- f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
-
-expType (Call fun _) = funType $ readFun ?state fun
-expType (Field _ _ _) = string
-expType (AllItems cat) = pluralType cat
-expType (NewItemButton cat) = string
-expType (Var _) = error "no type inference yet"
-expType (SortByField cat _ _ _) = pluralType cat
-expType (FilterByField cat _ _ _ _) = pluralType cat
-expType (Forall _ _ _ _) = string
-expType (Block _) = string
-expType (Inline _) = string
-expType (Str _) = string
-expType (Today) = string
-
-editLink :: (?link :: Bool, ?name :: Maybe String, ?root :: String,
- ToHTML a) => (Exp -> Exp) -> Exp -> Type -> a -> HTML
-editLink f old t s | not ?link = toHTML s | otherwise =
- flip (tag "a") s [P "class" "editLink", P "href" $
- ?root++"edit?exp="++(escape' $ show $ f $ Var (-1))
- ++"&old="++(escape' $ show old)++"&type="++show t
- ++maybe "" ("&name="++) ?name]
-
-renderMaybeExp (Just exp) cx ty = renderExp exp cx ty
-renderMaybeExp Nothing cx ty = editLink cx (Var 0) ty $ bold $
- "[" & typeQuestion ty & "]"
-
-renderMaybeExp' (Just exp) cx ty = renderExp' exp cx ty
-renderMaybeExp' Nothing cx ty = editLink cx (Var 0) ty $ surroundSpan $ bold $
- "[" & typeQuestion ty & "]"
-
-renderExp :: (?state :: MyState, ?link :: Bool, ?name :: Maybe String,
- ?root :: String) => Exp -> (Exp -> Exp) -> Type -> HTML
-renderExp exp@(Call fname args) cx ty =
- f (funTypes fun) (funParts fun) args 0 where
- fun = readFun ?state fname
- 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)
- 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)
-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 & "'")
-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 (Str s) cx _ = tag "small" [] $ quoteP s
-renderExp exp@(Block exps) cx _ = para $
- flip catMap (slices exps) (\(xs,x,xs') ->
- renderMaybeExp' x (\e -> cx (Block (xs ++ [Just e] ++ xs'))) string)
- & if ?link then para $ editLink cx exp string "[edit]" else toHTML ""
-renderExp exp@(Inline exps) cx _ = ("\"" &) . (& "\"") $
- flip catMap (slices exps) (\(xs,x,xs') ->
- renderMaybeExp' x (\e -> cx (Inline (xs ++ [Just e] ++ xs'))) string)
- & 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)
-
-surroundSpan s = tag "span" [P "class" $ if ?link then "editPotion"
- else "potion" ] s
-
-slices xs = map (\i -> (take i xs, xs !! i, drop (i+1) xs)) [0..length xs-1]
-
-renderVar i = ital [toEnum (fromEnum 'a' + i) :: Char]
-
-isComplete :: Exp -> Bool
-isComplete (Call _ args) = all (maybe False isComplete) args
-isComplete (Field _ _ exp) = maybe False isComplete exp
-isComplete (AllItems _) = True
-isComplete (NewItemButton _) = True
-isComplete (SortByField _ _ _ exp) = maybe False isComplete exp
-isComplete (FilterByField _ _ _ exp exp0) = maybe False isComplete exp
- && isComplete exp0
-isComplete (Forall _ _ exp body) = maybe False isComplete exp
- && isComplete body
-isComplete (Var _) = True
-isComplete (Block exps) = all (maybe False isComplete) exps
-isComplete (Inline exps) = all (maybe False isComplete) exps
-isComplete (Str _) = True
-isComplete (Today) = True
-
-runExp :: (?root :: String, ?time :: Int64)
- => Env -> Exp -> StateT MyState [] Value
-runExp env (Call fname args) = do
- 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 (NewItemButton cat) = do
- return $ html $ formP (?root++"newItem") $
- 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
- 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) 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
- msum $ map return rs
- where f state x = itemFields (stateItems state Map.! read x) Map.! field
-runExp env (Forall _ v (Just 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 (Var i) = return $ fromMaybe ("0") $
- Map.lookup i env
-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
-runExp _ Today = return $ renderTime ?time
-
-renderTime :: Int64 -> String
-renderTime t0 =
- printf "%04u-%02u-%02u" (ctYear t) (fromEnum (ctMonth t)+1) (ctDay t)
- where t = toUTCTime (TOD (fromIntegral t0) 0)
-runFun (Fun _ _ body) args =
- runExp (Map.fromList [(i, args!!i) | i <- [0..length args-1]]) body
+class Typeable b => MkTemplate l b where mkTemplate :: l -> Template b
+instance (ToHTML h, Typeable a) => MkTemplate (h :*: Nil) a where
+ mkTemplate (h :*: Nil) = TNil (toHTML h)
+instance (ToHTML h, MkTemplate xs x) => MkTemplate (h :*: x :*: xs) x where
+ mkTemplate (h :*: x :*: xs) = TCons (toHTML h) x (mkTemplate xs)
+
+template :: (ToHList a l, MkTemplate l b) => a -> Template b
+template = mkTemplate . toHList
+
+
+renderTemplate :: Typeable a => (a -> HTML) -> Template a -> HTML
+renderTemplate f (TCons h x tl) = h & f x & renderTemplate f tl
+renderTemplate _ (TNil h) = h
+
+templateValues (TCons _ x tl) = x : templateValues tl
+templateValues (TNil _) = []
+
+
+{-
+varCount :: Exp -> Int
+varCount = everything (+) (0 `mkQ` \e -> case e of Forall _ _ _ -> 1
+ otherwise -> 0)
+-}
+
+
+----------------------------------------------------------------------------
+-- Execution
+----------------------------------------------------------------------------
+
+runExp :: (?db :: DB, ?time :: Int64) => [Values] -> Exp -> Values
+runExp env (Var i) = env !! i
+runExp env (Call funId exps) = runExp (map (runExp env) exps) fun where
+ Fun _ _ fun = undefined
+runExp env (Literal val) = val
+runExp env (GetField _ field exp) = do
+ ItemValue _ item <- runExp env exp; getValue item field
+runExp env (AllItems cat) = map (ItemValue cat) $ map itemId $ getItems cat
+runExp env (Sort exp sortKeyExp order) = f sorted where
+ values = runExp env exp
+ sortKeys = map (\v -> runExp ([v]:env) sortKeyExp) values
+ sorted = map snd $ sort $ zip sortKeys values
+ f = case order of Ascending -> id; Descending -> reverse
+runExp env (Filter exp filterExp) = filter f $ runExp env exp where
+ f v = case runExp ([v]:env) filterExp of
+ [BooleanValue True] -> True; [BooleanValue False] -> False
+runExp env (NumOp op e1 e2) = do
+ let f Add = (+); f Subtract = (-); f Mul = (*); f Div = (/)
+ NumberValue a <- runExp env e1; NumberValue b <- runExp env e2
+ return $ NumberValue $ f op a b
+runExp env (CmpOp op e1 e2) = do
+ let f Lt = (<); f Le = (<=); f Eq = (==); f Ge = (>=); f Gt = (>)
+ a <- runExp env e1; b <- runExp env e2
+ return $ BooleanValue $ f op a b
+runExp env (Sum exp) = [NumberValue $ sum $ map numberValue $ runExp env exp]
+runExp env (Product exp) =
+ [NumberValue $ product $ map numberValue $ runExp env exp]
+runExp env (Count exp) = [NumberValue $ fromIntegral $ length $ runExp env exp]
+runExp env (IfThenElse e1 e2 e3) = runExp env $ case runExp env e1 of
+ [BooleanValue True] -> e2; [BooleanValue False] -> e3
+runExp env Today = [DateValue (ctYear t) (fromEnum (ctMonth t)+1) (ctDay t)]
+ where t = toUTCTime (TOD (fromIntegral ?time) 0)
diff -rN -u old-fenserve/fendata/Types.hs new-fenserve/fendata/Types.hs
--- old-fenserve/fendata/Types.hs 2007-06-05 17:46:06.000000000 +0300
+++ new-fenserve/fendata/Types.hs 2007-06-05 17:46:06.000000000 +0300
@@ -32,29 +32,39 @@
data Value = InlineValue String
| BlockValue String
| BooleanValue Bool
- | NumberValue Float
+ | NumberValue { numberValue :: Float }
| EmailValue String
| WebLinkValue String
| DateValue { dYear :: Int, dMonth :: Int, dDay :: Int }
| ItemValue CategoryId ItemId
deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+type Values = [Value]
-data Category = Category { catId :: CategoryId, catName :: String,
- catFields :: [Field] }
+data Category = Category { catId :: CategoryId, catName :: String,
+ catFields :: [FieldId] }
deriving (Read, Show, Typeable, Data, Eq, Ord)
-
-data Field = Field { fieldId :: FieldId, fieldName :: String,
+
+data Field = Field { fieldId :: FieldId, fieldName :: String,
fieldCat :: CategoryId, fieldType :: Type }
deriving (Read, Show, Typeable, Data, Eq, Ord)
-
+
data Item = Item { itemId :: ItemId, itemCategories :: Set CategoryId,
- itemValues :: Map FieldId Value }
+ itemValues :: Map FieldId Values }
deriving (Read, Show, Typeable, Data, Eq, Ord)
data DB = DB { dbCategories :: Map CategoryId Category,
+ dbFields :: Map FieldId Field,
dbItems :: Map ItemId Item, dbNextId :: Int }
deriving (Read, Show, Typeable, Data, Eq, Ord)
-
+
+getValue item field = let Item _ _ vs = getItem item in vs Map.! field
+getItem item = dbItems ?db Map.! item
+getCategory cat = dbCategories ?db Map.! cat
+
+getItems catId = filter (Set.member catId . itemCategories)
+ (Map.elems (dbItems ?db))
+
u_catName f (Category a b c) = Category a (f b) c
u_catFields f (Category a b c) = Category a b (f c)
@@ -65,11 +75,25 @@
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_dbItems f (DB a b c) = DB a (f b) c
-
-u_item x f = u_dbItems $ Map.adjust f x
-u_cat x f = u_dbCategories $ Map.adjust f x
+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_cat x f = u_dbCategories $ Map.adjust f x
+u_field x f = u_dbFields $ Map.adjust f x
+u_item x f = u_dbItems $ Map.adjust f x
+
+new_cat name (DB a b c d) =
+ (d, DB (Map.insert d (Category d name [d+1]) a)
+ (Map.insert (d+1) (Field (d+1) "Name" d (Single InlineType)) b)
+ c (d+2))
+
+new_field name cat ty (DB a b c d) =
+ (d, u_cat cat (u_catFields (++[d]))
+ $ DB a (Map.insert d (Field d name cat ty) b) c (d+1))
+
+new_item cats (DB a b c d) =
+ (d, DB a b (Map.insert d (Item d cats Map.empty) c) (d+1))
@@ -87,6 +111,7 @@
----------------------------------------------------------------------------
type FunId = String
+type Functions = Map FunId Fun
data Order = Ascending | Descending
deriving (Read, Show, Typeable, Data, Eq, Ord)
@@ -94,20 +119,24 @@
data Fun = Fun (Template Type) Type Exp
deriving (Read, Show, Typeable, Data, Eq, Ord)
-data Exp' e = Var Int
- | Call FunId [e]
- | Literal Value
- | GetField CategoryId FieldId (e)
- | AllItems CategoryId
- | Sort e e Order
- | Filter e e
- | Add e e | Subtract e e | Mul e e | Div e e | Sum e | Product e
- | Count e
- | LT e e | LE e e | EQ e e | GE e e | GT e e
- | IfThenElse e e e
- | Today | AddMonths e e | AddDays e e
+data NumOp = Add | Subtract | Mul | Div
+ deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+data CmpOp = Lt | Le | Eq | Ge | Gt
deriving (Read, Show, Typeable, Data, Eq, Ord)
-data Exp = Exp (Exp' Exp) | Hole
+data Exp = Var Int
+ | Call FunId [Exp]
+ | Literal Values
+ | GetField CategoryId FieldId Exp
+ | AllItems CategoryId
+ | Sort Exp Exp Order
+ | Filter Exp Exp
+ | NumOp NumOp Exp Exp | CmpOp CmpOp Exp Exp
+ | Sum Exp | Product Exp | Count Exp
+ | IfThenElse Exp Exp Exp
+ | Today
+
+ | Question Type | Focus Exp
deriving (Read, Show, Typeable, Data, Eq, Ord)
diff -rN -u old-fenserve/fendata/UI.hs new-fenserve/fendata/UI.hs
--- old-fenserve/fendata/UI.hs 2007-06-05 17:46:05.000000000 +0300
+++ new-fenserve/fendata/UI.hs 1970-01-01 02:00:00.000000000 +0200
@@ -1,66 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-
-module UI where
-
-import HTML
-import Potions
-import PotionTypes
-import Utils
-
-import qualified Data.Map as Map
-
-header = HTML "<head><style>a.editLink { text-decoration: none; color: inherit} \
- \button {\
- \ cursor: pointer; background: none; border: none; \
- \ font: inherit; margin: 0; padding: 0 } \
- \.potion, .editPotion {\
- \ border: dashed black 1px; padding: 2px; \
- \ margin: 2px; line-height: 1.8em } \
- \span.editPotion { background: #eee } \
- \span.editPotion span.editPotion { background: #ddd } \
- \span.editPotion span.editPotion span.editPotion { background: #ccc } \
- \span.editPotion span.editPotion span.editPotion span.editPotion { background: #bbb } \
- \span.editPotion span.editPotion span.editPotion span.editPotion span.editPotion { background: #aaa } \
- \.footer { font-size: small; font-style:italic; color: #888; \
- \ padding-top: 2em; clear: both; text-align: justify } \
- \.logo {border: 2px solid #eee; margin: 0.5em; float: left} \
- \.header {border: 1px solid white; margin-bottom: 2em; clear: both} \
- \h1 {border-bottom: 1px solid black} \
- \body {margin-left: 100px; margin-right: 100px} \
- \.content {float: right; width: 80% } \
- \.sidebar {float: left; width: 15%; font-size: small } \
- \h1, h2, h3, h4, h5, h6 { font-family: sans-serif } \
- \form { display: inline } \
- \</style><title>Fenlight demo</title></head>"
-
-makePage title sidebar body = tag "body" [] $
- ( tag "div" [P "class" "header"]
- ( etag "img" [P "src" "http://iki.fi/tuukka/tmp/lantern-photo-75.jpeg",
- P "class" "logo"]
- , h1 ("Fenlight | ", title) )
- , tag "div" [P "class" "main"]
- ( tag "div" [P "class" "sidebar"]
- ( para "Welcome to Fenlight!", sidebar, hr
- , catFor (stateSidebarPages ?state) $ \(fun, args) ->
- let ?link=False; ?name=Nothing
- in let exp = Call fun (map (Just . Str) args)
- uri = ?root++"potion/"++fun++concat ["/"++a | a <- args]
- in para $ bold $ link uri $ renderExp exp id string
- , hr
- , para $ qlink "potion" [P "exp" $ Block []] "New page"
- , catFor (Map.keys schema) $ \cat ->
- para $ qlink "table" [P "cat" cat] ("New ", cat, " view")
- , para $ link (?root++"addCategory") "Add category" )
- , tag "div" [P "class" "content"] body )
- , tag "div" [P "class" "footer"]
- ( "Fenlight (c) 2007 by Benja Fallenstein and Tuukka Hastrup. "
- , link "http://www.flickr.com/photo_zoom.gne?id=244815014&size=sq" "Logo"
- , " (c) 2006 by "
- , link "http://www.flickr.com/photos/44458147@N00/" "The G-tastic 7"
- , ". All content is licensed under the "
- , link "http://creativecommons.org/licenses/by-sa/2.0/"
- "Creative Commons Attribution-ShareAlike 2.0 license"
- , "." )
- )
-
-
diff -rN -u old-fenserve/fendata/old/Main.hs new-fenserve/fendata/old/Main.hs
--- old-fenserve/fendata/old/Main.hs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/fendata/old/Main.hs 2007-06-05 17:46:06.000000000 +0300
@@ -0,0 +1,340 @@
+{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
+
+import HTML
+import Potions
+import PotionTypes
+import UI
+import Utils
+
+import HAppS hiding (Body, getPath)
+import Control.Monad.State
+import Data.Generics (Typeable, Data, everywhere, mkT)
+import Data.Binary hiding (get,put)
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Int (Int64)
+
+import qualified System.IO.Unsafe
+import qualified Control.Exception
+
+instance Binary MyState where
+
+instance StartState MyState where
+ startStateM = return $ flip MyState
+ (Map.fromList [("post", ["title", "author", "body", "date"])])
+ (Map.fromList [
+ (0, Item (Map.fromList [("title", "Hello world!"),
+ ("author", "Me"),
+ ("body", "Here we come."),
+ ("date", "2007-05-15")])
+ (Set.fromList ["post"]))
+ , (1, Item (Map.fromList [("title", "Hello worlds!"),
+ ("author", "Us"),
+ ("body", "Here I come."),
+ ("date", "2007-05-15")])
+ (Set.fromList ["post"]))
+ ])
+ (Map.fromList [
+ ("Blog_post_archive", Fun [] [HTML "Blog post archive"] potion)
+ ])
+ [("Blog_post_archive", [])]
+
+potion = Block [Just $ Forall "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>"])]
+ where v = Just $ Var 0
+
+readArgs :: Request -> [Value]
+readArgs req = fromMaybe [] $ do
+ n <- fmap read $ lookM req "count"
+ forM [1..n] $ \i -> lookM req ("arg" ++ show i)
+
+
+addFieldGet = runGet
+ ( h2 ("Add field to category ", lookE "category")
+ , formP ""
+ ( "Field: " & textfield "name" ""
+ , channel ["category", "item"]
+ , hidden "returnTo" $ lookI "returnTo" ("item/"++lookE "item")
+ , submit "Submit" ) )
+
+addFieldPost = runPost (lookE "returnTo")
+ [ u_schema $ Map.adjust (++ [lookE "name"]) (lookE "category")
+ , u_items $ Map.map $ fIf' (`hasCat` (lookE "category")) $
+ u_fields $ insertIfNew (lookE "name") "" ]
+
+addCategory = runPost "table"
+ [ u_schema $ insertIfNew (uncapitalize $ lookE "name") ["name"] ]
+
+subst :: Int -> Exp -> Exp -> Exp
+subst i repl e = everywhere (mkT f) e where
+ f :: Exp -> Exp
+ f (Var j) | j == i = repl
+ f x = x
+
+
+evaluate x = System.IO.Unsafe.unsafePerformIO $ Control.Exception.catch
+ (Control.Exception.evaluate (length (show x) `seq` Right x))
+ (\e -> return $ Left e)
+
+--run :: (a -> MyState -> (String, MyState)) -> a -> blah
+run f x = do
+ state <- get
+ case evaluate (f x state) of
+ Right (s, state') -> do put state'; respond $ html (header & s)
+ Left e -> respond $ "Internal server error: " ++ show e
+
+runRedirect f x = do
+ state <- get
+ case evaluate (f x state) of
+ Right (s, state') -> do put state'; respond (s, html $ link s "link")
+ Left e -> respond $ ("", "Internal server error: " ++ show e)
+
+runGet page = ok $ \() () -> respond $ case evaluate (html $ header & page) of
+ Right s -> s; Left e -> "Internal server error: " ++ show e
+
+runPost uri fs = seeOther $ \() () ->
+ case evaluate (foldl1 (flip (.)) fs ?state, uri) of
+ Right (s',u) -> put s' >> respond (u, html $ link u "link")
+ Left e -> respond $ ("", "Internal server error: " ++ show e)
+
+potionPage fun args name s = (makePage title expandLink body, s) where
+ exp = Call fun (map (Just . Str) $ args)
+ title = let ?state=s; ?link=False; ?name=name in renderExp exp id string
+ env = Map.fromList $ zip [0..length args-1] args
+ body = if (isComplete exp)
+ then (HTML $ head $ evalStateT (runExp env exp) s)
+ else toHTML "(Incomplete expression.)"
+ Fun _ _ funBody = readFun s fun
+ expandLink = para (qlink "potion" [P "exp" funBody, P "name" fun]
+ "[edit page]")
+ & maybe (HTML "") (\page ->
+ (if page `elem` stateSidebarPages s then HTML "" else
+ para $ formP (?root++"addToSidebar")
+ (hidden "page" (show page)
+ & button "[add to sidebar]")))
+ (case exp of
+ Call fun args -> fmap (\a -> (fun,a)) $
+ sequence args >>=
+ mapM (\a -> case a of Str s -> Just s
+ _ -> Nothing)
+ _ -> Nothing)
+
+potionGet exp args name s = (makePage "Custom page" "" $
+ tag "div" [P "style" "border: 1px solid black; \
+ \margin-bottom: 1em; padding: 1em; \
+ \padding-bottom: 0; font-weight: bold"]
+ (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...]") $
+ flip (maybe $ HTML "") name $ \name' ->
+ 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
+ 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 :: (?root :: String)
+ => (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 in
+ (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 ->
+ para $ li $ linkExp repl $ renderExp repl id (error "some type"))
+ , s) where linkExp new = tag "a"
+ [ P "class" "editLink"
+ , P "href" $ ?root ++ "potion?exp="
+ ++ show (subst (-1) new exp)
+ ++ maybe "" ("&name="++) name]
+ . tag "span" [P "class" "editPotion"]
+
+makeFun = let ?link = False; ?name = lookIM "name" in
+ ( para ( "Save '", renderExp' (lookR "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", channel ["exp"] ) ) )
+
+editTemplate :: Request -> MyState -> (String, MyState)
+editTemplate msg s =
+ ("potion?exp=" ++ escape' (show (subst (-1) new exp))
+ ++ maybe "" ("&name="++) (lookM msg "name")
+ , s) where
+ Just exp = fmap read $ lookM msg "exp"
+ 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 = (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
+ where i = read [c] - 1
+ f (c:cs) = (Just (Str (c:r)):rs) where (Just (Str r):rs) = f cs
+ f "" = [Just (Str "")]
+
+addPotion :: Request -> MyState -> (String, MyState)
+addPotion msg s = ("potion/"++name, s { statePotions = newPotions }) where
+ Just template = lookM msg "template"
+ Just exp = fmap read $ lookM msg "exp"
+ name = fromMaybe (getName template) $ lookM msg "name" where
+ getName ('$':'(':cs) = 'X' : getName (drop 1 $ dropWhile (/= ')') cs)
+ getName (' ':cs) = '_' : getName cs
+ getName (c:cs) = c : getName cs
+ getName "" = ""
+ potion = case lookM msg "name" of
+ Nothing -> let (parts, types) = f template ""
+ in Fun types (map toHTML parts) exp
+ Just n -> let Fun ts ps _ = statePotions s Map.! n
+ in Fun ts ps exp
+ newPotions = Map.insert name potion $ statePotions s
+ f ('$':'(':cs) part = (reverse part : ps, t : ts)
+ where (ps,ts) = f (drop 1 $ dropWhile (/= ')') cs) ""
+ t = catType $ takeWhile (/= ')') cs
+ f (c:cs) part = f cs (c:part)
+ f "" part = ([reverse part], [])
+
+addToSidebar :: Request -> MyState -> (String, MyState)
+addToSidebar msg s = ("potion/"++fn++concat ["/"++a | a <- args], s') where
+ s' = s { stateSidebarPages = stateSidebarPages s ++ [page] }
+ Just page@(fn,args) = fmap read $ lookM msg "page"
+
+showTable = makePage ("List of "++plural cat++" in the database") ""
+ ( tag "table" [P "border" "1"]
+ ( tag "tr" [] $ catFor cols $ \col -> tag "th" [] $ capitalize col
+ , tag "tr" [] $ tag "td" [P "colspan" $ length cols,
+ P "style" "text-align: center"]
+ ( hif (null items) $ ital ( "There are no ", plural cat,
+ " in the database. " ) & mdot
+ , formP (?root++"newItem")
+ ( hidden "returnTo" $ "table?cat="++cat
+ , hidden "cat" cat
+ , button $ bold ("[New ", cat, "]") ) )
+
+ , catFor (Map.toList allItems) $ \(id, Item fields cats) ->
+ hif (cat `Set.member` cats) $ tag "tr" [] $
+ catFor cols $ \col -> tag "td" [] $
+ qlink ("item/"++show id) [P "returnTo" $ "table?cat="++cat]
+ (fields Map.! col) ) )
+
+ where cat = lookI "cat" (head $ Map.keys schema)
+ items = flip filter (Map.toList allItems) $
+ \(_, Item _ cats) -> cat `Set.member` cats
+ cols = lookRD "cols" (take 1 $ schema Map.! cat)
+
+showItem :: (?root :: String, ?state :: MyState, ?req :: Request) =>
+ String -> Request -> MyState -> (HTML, MyState)
+showItem item req s = let Item fields cats = stateItems s Map.! read item in (
+ makePage "Item editor" "" $ formP ""
+ ( channel ["returnTo"]
+ , buttons, hr
+ , catFor (Set.toList cats) $ \cat -> let cfs = stateSchema s Map.! cat in
+ ( h3 (capitalize cat)
+ , para $ catFor cfs $ \field ->
+ ( capitalize field, ": "
+ , (if field == "body" then (br &) . textarea field 5 80
+ else textfield field) (fields Map.! field)
+ , br )
+ , para $ qlink "addField"
+ [ P "item" item
+ , P "category" cat
+ , P "returnTo" $ "item/"++item++escape ("?returnTo="++escape uri)
+ ]
+ ("[Add a field to the ", capitalize cat, " category]") )
+ , hr, buttons ),
+ s) where uri = fromMaybe "" $ lookM req "returnTo"
+ buttons = para ( button "[Save]", " ", mdot, " "
+ , link (?root++uri) "[Cancel]" )
+
+
+updateItem :: (?root :: String) =>
+ String -> Request -> MyState -> (String, MyState)
+updateItem item_s req s = (maybe "" (?root++) returnTo, s') where
+ returnTo = lookM req "returnTo"
+ item = read item_s
+ s' = s { stateItems = Map.insert item (Item fields' cats) (stateItems s) }
+ Item fields cats = stateItems s Map.! item
+ fields' = flip Map.mapWithKey fields $ \k v -> fromMaybe v (lookM req k)
+
+newItem msg s = (?root++"item/"++show id++returnTo, s') where
+ returnTo = maybe "" (("?returnTo="++) . escape) (lookM msg "returnTo")
+ id = nextId $ stateItems s
+ s' = s { stateItems = Map.insert id item $ stateItems s }
+ item = Item (Map.fromList $ [(f,"") | f <- catFs]) (Set.fromList [cat])
+ catFs = stateSchema s Map.! cat
+ Just cat = lookM msg "cat"
+
+delItem msg s = ("table", s') where
+ s' = s { stateItems = Map.delete id $ stateItems s }
+ Just id = fmap read $ lookM msg "item"
+
+main = stdHTTP [ debugFilter
+ , h (Prefix ()) () $ \(path::[String]) req ->
+ getTime >>= \time -> get >>= \state ->
+ let ?time = time; ?state = state; ?req = req
+ ?root = concatMap (const "../") $ drop 1 path
+ in runServerParts [app] req
+ ]
+
+app :: (?root :: String, ?time :: Int64, ?req :: Request, ?state :: MyState)
+ => ServerPart (Ev MyState ev) Request IO Result
+app = multi
+ [ h ["potion"] GET $ ok $ \() -> run $
+ \req s -> potionGet (read $ fromJust $ lookM req "exp")
+ (readArgs req) (lookM req "name") s
+ , h (Prefix ["potion"]) GET $ ok $ \(fun:args) -> run $
+ \req s -> potionPage fun args (lookM req "name") s
+ , h ["edit"] GET $ ok $ \() -> run $ \req ->
+ edit (read $ fromJust $ lookM req "exp",
+ read $ fromJust $ lookM req "old",
+ read $ fromJust $ lookM req "type",
+ lookM req "name")
+ , h ["editTemplate"] GET $ seeOther $ \() -> runRedirect editTemplate
+ , h ["makefun"] GET $ runGet makeFun
+ , h ["table"] GET $ runGet showTable
+ , h (Prefix ["item"]) GET $ ok $ \[item] -> run (showItem item)
+ , h (Prefix ["item"]) POST $ seeOther $ \[item] ->
+ runRedirect (updateItem item)
+ , h ["newItem"] POST $ seeOther $ \() -> runRedirect newItem
+ , h ["delItem"] POST $ seeOther $ \() -> runRedirect delItem
+
+ , h [""] GET $ seeOther $ \() -> runRedirect $ \() s ->
+ ("potion/" ++ (case head $ stateSidebarPages s of
+ (fn,args) -> fn ++ concat ["/"++a | a <- args]), s)
+ , h ["addField"] GET $ addFieldGet
+ , h ["addField"] POST $ addFieldPost
+ , h ["addCategory"] GET $ runGet
+ ( h2 "Add category"
+ , formP "" ( "Name: " & textfield "name" ""
+ , submit "Submit" ) )
+ , h ["addCategory"] POST $ addCategory
+ , h ["addpotion"] POST $ seeOther $ \() -> runRedirect addPotion
+ , h ["addToSidebar"] POST $ seeOther $ \() -> runRedirect addToSidebar
+ ]
+
diff -rN -u old-fenserve/fendata/old/PotionTypes.hs new-fenserve/fendata/old/PotionTypes.hs
--- old-fenserve/fendata/old/PotionTypes.hs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/fendata/old/PotionTypes.hs 2007-06-05 17:46:06.000000000 +0300
@@ -0,0 +1,70 @@
+{-# OPTIONS_GHC -fglasgow-exts -fno-monomorphism-restriction #-}
+
+module PotionTypes where
+
+import HTML
+
+import Data.Generics (Typeable, Data)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+type Category = String
+type Field = String
+
+data Type = Type String
+ deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+typeQuestion (Type s) = "which " ++ s ++ "?"
+
+data Fun = Fun [Type] [HTML] Exp
+ deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+data Exp = Call String [Maybe Exp]
+ | Field Category Field (Maybe Exp)
+ | AllItems Category
+ | NewItemButton Category
+ | Var Int
+ | SortByField Category Field Int (Maybe Exp)
+ | FilterByField Category Field Int (Maybe Exp) Exp -- body should always be an Inline
+ | Forall Category Int (Maybe Exp) Exp -- body should always be a Block
+ | Block [Maybe Exp] | Inline [Maybe Exp]
+ | Str String
+ | Today
+ deriving (Read, Show, Typeable, Data, Eq, Ord)
+
+
+type Env = Map Int Value
+type Value = String
+
+
+
+type Id = Int
+
+data Item = Item { itemFields :: Map String String, itemCategories :: Set String }
+ deriving (Read, Show, Typeable, Data)
+
+hasCat :: Item -> String -> Bool
+hasCat i c = c `Set.member` itemCategories i
+
+u_fields f i = i { itemFields = f (itemFields i) }
+u_categories f i = i { itemCategories = f (itemCategories i) }
+
+nextId :: Map Id a -> Id
+nextId m = if Map.null m then 0 else fst (Map.findMax m) + 1
+
+data MyState = MyState { stateItems :: Map Id Item,
+ stateSchema :: Map String [String],
+ statePotions :: Map String Fun,
+ stateSidebarPages :: [(String, [String])] }
+ deriving (Read, Show, Typeable, Data)
+
+u_items f s = s { stateItems = f (stateItems s) }
+u_schema f s = s { stateSchema = f (stateSchema s) }
+u_potions f s = s { statePotions = f (statePotions s) }
+u_sidebarPages f s = s { stateSidebarPages = f (stateSidebarPages s) }
+
+schema = stateSchema ?state
+allItems = stateItems ?state
+allPotions = statePotions ?state
diff -rN -u old-fenserve/fendata/old/Potions.hs new-fenserve/fendata/old/Potions.hs
--- old-fenserve/fendata/old/Potions.hs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/fendata/old/Potions.hs 2007-06-05 17:46:06.000000000 +0300
@@ -0,0 +1,206 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module Potions where
+
+import HTML
+import PotionTypes
+import Utils
+
+import Control.Monad.State
+
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromJust, fromMaybe, isJust)
+import Data.List (sortBy, filter)
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+import Data.Int (Int64)
+
+import Text.Printf (printf)
+import System.Time
+
+catType cat = Type cat
+pluralType cat = Type (plural cat)
+string = Type "text"
+
+readFun :: MyState -> String -> Fun
+readFun s n = statePotions s Map.! n
+
+funType (Fun _ _ exp) = expType exp
+
+funTypes (Fun ts _ _) = ts
+
+funParts (Fun _ ps _) = ps
+
+getPotions :: MyState -> [Exp]
+getPotions s = map f (Map.toList $ statePotions s)
+ ++ [Today]
+ ++ concatFor (Map.toList $ stateSchema s) (\(cat,fs) ->
+ AllItems cat
+ : NewItemButton cat
+ : Forall 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 (Inline [])
+ , FilterByField cat f 0 Nothing (Inline [])
+ , FilterByField cat f 1 Nothing (Inline [])
+ ])) where
+ f (n, Fun ts _ _) = Call n (replicate (length ts) Nothing)
+
+expType (Call fun _) = funType $ readFun ?state fun
+expType (Field _ _ _) = string
+expType (AllItems cat) = pluralType cat
+expType (NewItemButton cat) = string
+expType (Var _) = error "no type inference yet"
+expType (SortByField cat _ _ _) = pluralType cat
+expType (FilterByField cat _ _ _ _) = pluralType cat
+expType (Forall _ _ _ _) = string
+expType (Block _) = string
+expType (Inline _) = string
+expType (Str _) = string
+expType (Today) = string
+
+editLink :: (?link :: Bool, ?name :: Maybe String, ?root :: String,
+ ToHTML a) => (Exp -> Exp) -> Exp -> Type -> a -> HTML
+editLink f old t s | not ?link = toHTML s | otherwise =
+ flip (tag "a") s [P "class" "editLink", P "href" $
+ ?root++"edit?exp="++(escape' $ show $ f $ Var (-1))
+ ++"&old="++(escape' $ show old)++"&type="++show t
+ ++maybe "" ("&name="++) ?name]
+
+renderMaybeExp (Just exp) cx ty = renderExp exp cx ty
+renderMaybeExp Nothing cx ty = editLink cx (Var 0) ty $ bold $
+ "[" & typeQuestion ty & "]"
+
+renderMaybeExp' (Just exp) cx ty = renderExp' exp cx ty
+renderMaybeExp' Nothing cx ty = editLink cx (Var 0) ty $ surroundSpan $ bold $
+ "[" & typeQuestion ty & "]"
+
+renderExp :: (?state :: MyState, ?link :: Bool, ?name :: Maybe String,
+ ?root :: String) => Exp -> (Exp -> Exp) -> Type -> HTML
+renderExp exp@(Call fname args) cx ty =
+ f (funTypes fun) (funParts fun) args 0 where
+ fun = readFun ?state fname
+ 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)
+ 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)
+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 & "'")
+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 (Str s) cx _ = tag "small" [] $ quoteP s
+renderExp exp@(Block exps) cx _ = para $
+ flip catMap (slices exps) (\(xs,x,xs') ->
+ renderMaybeExp' x (\e -> cx (Block (xs ++ [Just e] ++ xs'))) string)
+ & if ?link then para $ editLink cx exp string "[edit]" else toHTML ""
+renderExp exp@(Inline exps) cx _ = ("\"" &) . (& "\"") $
+ flip catMap (slices exps) (\(xs,x,xs') ->
+ renderMaybeExp' x (\e -> cx (Inline (xs ++ [Just e] ++ xs'))) string)
+ & 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)
+
+surroundSpan s = tag "span" [P "class" $ if ?link then "editPotion"
+ else "potion" ] s
+
+slices xs = map (\i -> (take i xs, xs !! i, drop (i+1) xs)) [0..length xs-1]
+
+renderVar i = ital [toEnum (fromEnum 'a' + i) :: Char]
+
+isComplete :: Exp -> Bool
+isComplete (Call _ args) = all (maybe False isComplete) args
+isComplete (Field _ _ exp) = maybe False isComplete exp
+isComplete (AllItems _) = True
+isComplete (NewItemButton _) = True
+isComplete (SortByField _ _ _ exp) = maybe False isComplete exp
+isComplete (FilterByField _ _ _ exp exp0) = maybe False isComplete exp
+ && isComplete exp0
+isComplete (Forall _ _ exp body) = maybe False isComplete exp
+ && isComplete body
+isComplete (Var _) = True
+isComplete (Block exps) = all (maybe False isComplete) exps
+isComplete (Inline exps) = all (maybe False isComplete) exps
+isComplete (Str _) = True
+isComplete (Today) = True
+
+runExp :: (?root :: String, ?time :: Int64)
+ => Env -> Exp -> StateT MyState [] Value
+runExp env (Call fname args) = do
+ 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 (NewItemButton cat) = do
+ return $ html $ formP (?root++"newItem") $
+ 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
+ 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) 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
+ msum $ map return rs
+ where f state x = itemFields (stateItems state Map.! read x) Map.! field
+runExp env (Forall _ v (Just 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 (Var i) = return $ fromMaybe ("0") $
+ Map.lookup i env
+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
+runExp _ Today = return $ renderTime ?time
+
+renderTime :: Int64 -> String
+renderTime t0 =
+ printf "%04u-%02u-%02u" (ctYear t) (fromEnum (ctMonth t)+1) (ctDay t)
+ where t = toUTCTime (TOD (fromIntegral t0) 0)
+
+runFun (Fun _ _ body) args =
+ runExp (Map.fromList [(i, args!!i) | i <- [0..length args-1]]) body
+
diff -rN -u old-fenserve/fendata/old/UI.hs new-fenserve/fendata/old/UI.hs
--- old-fenserve/fendata/old/UI.hs 1970-01-01 02:00:00.000000000 +0200
+++ new-fenserve/fendata/old/UI.hs 2007-06-05 17:46:06.000000000 +0300
@@ -0,0 +1,66 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+module UI where
+
+import HTML
+import Potions
+import PotionTypes
+import Utils
+
+import qualified Data.Map as Map
+
+header = HTML "<head><style>a.editLink { text-decoration: none; color: inherit} \
+ \button {\
+ \ cursor: pointer; background: none; border: none; \
+ \ font: inherit; margin: 0; padding: 0 } \
+ \.potion, .editPotion {\
+ \ border: dashed black 1px; padding: 2px; \
+ \ margin: 2px; line-height: 1.8em } \
+ \span.editPotion { background: #eee } \
+ \span.editPotion span.editPotion { background: #ddd } \
+ \span.editPotion span.editPotion span.editPotion { background: #ccc } \
+ \span.editPotion span.editPotion span.editPotion span.editPotion { background: #bbb } \
+ \span.editPotion span.editPotion span.editPotion span.editPotion span.editPotion { background: #aaa } \
+ \.footer { font-size: small; font-style:italic; color: #888; \
+ \ padding-top: 2em; clear: both; text-align: justify } \
+ \.logo {border: 2px solid #eee; margin: 0.5em; float: left} \
+ \.header {border: 1px solid white; margin-bottom: 2em; clear: both} \
+ \h1 {border-bottom: 1px solid black} \
+ \body {margin-left: 100px; margin-right: 100px} \
+ \.content {float: right; width: 80% } \
+ \.sidebar {float: left; width: 15%; font-size: small } \
+ \h1, h2, h3, h4, h5, h6 { font-family: sans-serif } \
+ \form { display: inline } \
+ \</style><title>Fenlight demo</title></head>"
+
+makePage title sidebar body = tag "body" [] $
+ ( tag "div" [P "class" "header"]
+ ( etag "img" [P "src" "http://iki.fi/tuukka/tmp/lantern-photo-75.jpeg",
+ P "class" "logo"]
+ , h1 ("Fenlight | ", title) )
+ , tag "div" [P "class" "main"]
+ ( tag "div" [P "class" "sidebar"]
+ ( para "Welcome to Fenlight!", sidebar, hr
+ , catFor (stateSidebarPages ?state) $ \(fun, args) ->
+ let ?link=False; ?name=Nothing
+ in let exp = Call fun (map (Just . Str) args)
+ uri = ?root++"potion/"++fun++concat ["/"++a | a <- args]
+ in para $ bold $ link uri $ renderExp exp id string
+ , hr
+ , para $ qlink "potion" [P "exp" $ Block []] "New page"
+ , catFor (Map.keys schema) $ \cat ->
+ para $ qlink "table" [P "cat" cat] ("New ", cat, " view")
+ , para $ link (?root++"addCategory") "Add category" )
+ , tag "div" [P "class" "content"] body )
+ , tag "div" [P "class" "footer"]
+ ( "Fenlight (c) 2007 by Benja Fallenstein and Tuukka Hastrup. "
+ , link "http://www.flickr.com/photo_zoom.gne?id=244815014&size=sq" "Logo"
+ , " (c) 2006 by "
+ , link "http://www.flickr.com/photos/44458147@N00/" "The G-tastic 7"
+ , ". All content is licensed under the "
+ , link "http://creativecommons.org/licenses/by-sa/2.0/"
+ "Creative Commons Attribution-ShareAlike 2.0 license"
+ , "." )
+ )
+
+
More information about the Fencommits
mailing list