Session.hs

{-# LANGUAGE TypeFamilies #-}

{-|
    'Snap.Extension.Session' exports the 'MonadSession' type class, which allows
    you to keep a session object for each client session of a web application.
    Convenience functions are provided for those cases where the session type
    is a 'Data.Map.Map'.
-}

module Snap.Extension.Session (
    MonadSession(..),
    inSession,
    withSession,
    getFromSession,
    deleteFromSession,
    setInSession
    ) where

import Snap.Types

import Data.Map (Map)
import qualified Data.Map as M

{-|
    This type class captures all Snap-related monads that contain a session.
-}
class MonadSnap m => MonadSession m where
    {-|
        The type of the session object.  In principle, this may be any type
        that you want.  However, implementations or other extensions maybe put
        additional restrictions on the type (for example, the session
        implementation in 'Snap.Extension.Session.Client' requires that the
        session type be an instance of 'Data.Serialize.Serialize'.
    -}
    type Session m
    getSession   :: m (Session m)
    setSession   :: Session m -> m ()
    clearSession :: m ()
    touchSession :: m ()

{-|
    Insert this into your routes to renew sessions on each request.
-}
inSession :: MonadSession m => m a -> m a
inSession handler = touchSession >> handler

withSession :: MonadSession m => (Session m -> m a) -> m a
withSession handler = touchSession >> getSession >>= handler

getFromSession :: (Ord k, MonadSession m, Session m ~ Map k a)
               => k -> m (Maybe a)
getFromSession key = fmap (M.lookup key) getSession

deleteFromSession :: (Ord k, MonadSession m, Session m ~ Map k a)
                  => k -> m ()
deleteFromSession key = withSession $ setSession . M.delete key

setInSession :: (Ord k, MonadSession m, Session m ~ Map k a)
             => k -> a -> m ()
setInSession k v = withSession $ setSession . M.insert k v