Tutorial.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import           Data.Maybe
import           Snap
import           Snap.Snaplet.Heist
import           Snap.Snaplet.Session
import           Snap.Snaplet.Session.Backends.CookieSession

data App = App
    { _heist       :: Snaplet (Heist App)
    , _sess        :: Snaplet (SessionManager)
    }

makeLenses [''App]

appInit :: SnapletInit App App
appInit = makeSnaplet "myapp" "My example application" Nothing $ do
    hs <- nestSnaplet "heist" heist $ heistInit "templates"
    ss <- nestSnaplet "session" sess $ initCookieSessionManager "config/session.txt" "_session" (Just 3600)
    addRoutes [ ("/hello", writeText "hello world")
              , ("/session", sessionHandler)
              , ("", heistServe)
              ]
    return $ App hs ss

sessionHandler :: Handler App App ()
sessionHandler = method GET getter <|> method POST setter
  where
    getter = do
        sessionList <- with sess $ sessionToList
        mapM_ (writeText . fst) sessionList
        writeText "\ngetter\n"
    setter = do
        mkey <- getParam "key"
        mvalue <- getParam "value"
        withSession sess . withTop sess $ setInSession (convert mkey) (convert mvalue)
        getter
    convert = T.pack . B.unpack . (fromMaybe "set-error")

instance HasHeist App where heistLens = subSnaplet heist

main :: IO ()
main = serveSnaplet defaultConfig appInit