module Controller where import Control.Monad import Control.Monad.Trans import HAppS.Server import Text.StringTemplate import Misc import Session import View import Model import ControllerBasic import ControllerUsingTemplates -----controller -- Web server functions -- SPs: ServerParts controller :: [ServerPartT IO Response] controller = debugFilter $ tutorial ++ loginHandlers ++ simpleHandlers ++ usingTemplatesHandlers ++ staticfiles loginHandlers = [ dir "login" loginSPs , dir "newuser" [methodSP POST $ withData newUserPage] , dir "view" [withDataFn (liftM Just (readCookieValue "sid") `mplus` return Nothing) viewPage] , dir "list" userListPage ] loginSPs = [methodSP GET $ ( ioMsgToSp . withBaseTemplateW [] ) "login" , methodSP POST $ withData loginPage ] -- serve arbitrary io actions: read files, fetch from database helloworldio = [ ioMsgToSp iovalue ] where iovalue :: IO HtmlString iovalue = (return . HtmlString ) "hello
world" staticfiles = [ fileservedir "src" , fileservedir "static" ] fileservedir d = dir d [ fileServe [] d ] templateservedir d = dir d [ templateserve ] templateserve = ServerPartT $ \rq -> case rqPaths rq of [tmpl] -> ( ioMsgToWeb . withBaseTemplateW [] ) tmpl _ -> noHandle tutorial = [ exactdir "/" [ ioMsgToSp $ withBaseTemplateW [] "home" ] , dir "tutorial" [ templateserve ] ]