{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-|
This module provides the generic interface to the various typed
session implementations, including both server-side and client-side
typed sessions.
-}
module Snap.Snaplet.TypedSession (
HasTypedSession(..),
withSession,
getFromSession,
setInSession,
deleteFromSession
) where
import Snap.Snaplet
import Data.Map (Map)
import qualified Data.Map as M
{-|
The generic interface to typed session implementations. Both the
client-side and server-side implementations of sessions implement
the common interface specified here.
-}
class HasTypedSession v t | v -> t where
{-|
Retrieves the session for the current request, always creating
it if necessary.
-}
getSession :: Handler b v t
{-|
Stores a new value for the current session.
-}
setSession :: t -> Handler b v ()
{-|
Completely clears the current session, removing all associated
cookies and server-side storage if applicable.
-}
clearSession :: Handler b v ()
{-|
Marks a session as recently used, resetting the session timeout
counter.
-}
touchSession :: Handler b v ()
{-|
A convenience function for gaining access to the session. The
session is touched and then passed to the nested 'Handler'.
-}
withSession :: HasTypedSession v t => (t -> Handler b v a) -> Handler b v a
withSession handler = touchSession >> getSession >>= handler
{-|
Gets a named value from a session that happens to be a 'Map'.
-}
getFromSession :: (Ord k, HasTypedSession v (Map k a))
=> k -> Handler b v (Maybe a)
getFromSession key = fmap (M.lookup key) getSession
{-|
Sets a named value in a session that happens to be a 'Map'.
-}
setInSession :: (Ord k, HasTypedSession v (Map k a))
=> k -> a -> Handler b v ()
setInSession k v = withSession $ setSession . M.insert k v
{-|
Deletes a named value from a session that happens to be a 'Map'.
-}
deleteFromSession :: (Ord k, HasTypedSession v (Map k a))
=> k -> Handler b v ()
deleteFromSession key = withSession $ setSession . M.delete key