module Main where import FLM.HAppS import HAppS.Data import HAppS.State import HAppS.State.EventTH import HAppS.StdMain.StartStateTH import FLM.WikiPages import FLM.Types import FLM.Control main :: IO () main = stdMain $ simpleHTTP impl :*: stateFuns impl = [xslt xsltproc "xslt/style.xsl" [ wiki, fileServe ["index.html"] [] "public" ] ] wiki = dir "wiki" [ dir "pageForm" [method GET $ ok . toHTMLForm "newPage" "pages/" "POST" =<< createPage] ,dir "pages" [postNewPage, perEntry,method GET $ ok =<< getList ] ] where postNewPage = withData $ \wikipage -> [method POST $ maybe (forbidden "id already used") (seeOther' . ( \(Id n) -> show n)) =<< addPage wikipage] perEntry = path $ \pid -> [ method GET $ maybe (notFound "Page Not Found") ok =<< mbGetPage (Id pid) ,dir "form" [ method GET $ maybe (notFound "WikiPage Not Found") (ok . toHTMLForm "entryForm" ("../" ++ (show pid)) "POST") =<< mbGetPage (Id pid) ] ,withData $ \wikipage -> [method POST $ ok =<< updatePage (Id pid) wikipage ] ]