mysnapsession-example-0.3: animalgame/src/Application.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeSynonymInstances  #-}

{-

This module defines our application's monad and any application-specific
information it requires.

-}

module Application (
    App,
    appInitializer,
    AppSession(..)
    ) where

import Paths_mysnapsession_example

import Control.Monad.Trans
import Snap.Extension
import Snap.Extension.Heist.Impl
import Snap.Extension.Session.Memory
import Snap.Dialogues

type App = SnapExtend AppState

data AppState = AppState {
    templateState :: HeistState App,
    sessionMgr    :: MemorySessionManager AppSession
    }

instance HasHeistState App AppState where
    getHeistState     = templateState
    setHeistState s a = a { templateState = s }

instance HasMemorySessionManager AppState where
    type MemorySessionValue AppState = AppSession
    memorySessionMgr = sessionMgr

data AppSession = AppSession {
    dlgManager :: DlgManager App
    }

instance HasDlgManager App AppSession where
    getDlgManager = dlgManager

appInitializer :: Initializer AppState
appInitializer = do
    hPath    <- liftIO $ getDataFileName "animalgame/resources/templates"
    heist    <- heistInitializer hPath
    sessions <- memorySessionInitializer 1800 newSession
    return $ AppState heist sessions
  where
    newSession = fmap AppSession makeDlgManager