happs-tutorial-0.1: src/Controller.hs

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<br>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 ]
       ]