mysnapsession-0.3: src/Snap/Extension/Session.hs

{-# LANGUAGE TypeFamilies #-}

{-|
    'Snap.Extension.Session.Memory' exports the 'MonadSessionMemory' interface
    which allows you to keep an in-memory session object for each client session
    of a web application.
-}

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

import Snap.Types

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

class MonadSnap m => MonadSession m where
    type SessionValue m
    getSession   :: m (SessionValue m)
    setSession   :: SessionValue 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 => (SessionValue m -> m a) -> m a
withSession handler = touchSession >> getSession >>= handler

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

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

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