{-# 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