# LANGUAGE ExistentialQuantification #
# LANGUAGE FunctionalDependencies #
{-# LANGUAGE Rank2Types #-}

module Web.Apiary.Session.Internal
    ( Session(..)
    , SessionBackend(..)
    ) where

import Control.Monad.Apiary.Action(ActionT)
import qualified Network.Wai as Wai
import Data.Apiary.Extension
    (Extension(extMiddleware, extMiddleware'), Middleware')

data Session sess m = forall backend. SessionBackend backend sess m => Session
    { sessionBackend :: backend }

instance Extension (Session sess m) where
    extMiddleware  (Session back) = backendMiddleware  back
    extMiddleware' (Session back) = backendMiddleware' back

class Monad m => SessionBackend backend sess m | backend -> sess, backend -> m where
    backendMiddleware :: backend -> Wai.Middleware
    backendMiddleware _ = id
# INLINE backendMiddleware #

    backendMiddleware' :: backend -> Middleware'
    backendMiddleware' _ = id
# INLINE backendMiddleware ' #

    genBackendModify  :: backend
                      -> (Maybe sess -> ActionT exts prms m (Maybe sess, a))
                      -> ActionT exts prms m a

    backendGet :: backend -> ActionT exts prms m (Maybe sess)
    backendGet b = genBackendModify b (\s -> return (s, s))

    backendSet :: backend -> sess -> ActionT exts prms m ()
    backendSet b s = genBackendModify b (\_ -> return (Just s, ()))

    backendDelete :: backend -> ActionT exts prms m ()
    backendDelete b = genBackendModify b (\_ -> return (Nothing, ()))

# LANGUAGE Rank2Types #
# LANGUAGE ExistentialQuantification #
# LANGUAGE FunctionalDependencies #

module Web.Apiary.Session.Internal
    ( Session(..)
    , SessionBackend(..)
    ) where

import Control.Monad.Apiary.Action(ActionT)
import qualified Network.Wai as Wai
import Data.Apiary.Extension
    (Extension(extMiddleware, extMiddleware'), Middleware')

data Session sess m = forall backend. SessionBackend backend sess m => Session
    { sessionBackend :: backend }

instance Extension (Session sess m) where
    extMiddleware  (Session back) = backendMiddleware  back
    extMiddleware' (Session back) = backendMiddleware' back

class Monad m => SessionBackend backend sess m | backend -> sess, backend -> m where
    backendMiddleware :: backend -> Wai.Middleware
    backendMiddleware _ = id
# INLINE backendMiddleware #

    backendMiddleware' :: backend -> Middleware'
    backendMiddleware' _ = id
# INLINE backendMiddleware ' #

    genBackendModify  :: backend
                      -> (Maybe sess -> ActionT exts prms m (Maybe sess, a))
                      -> ActionT exts prms m a

    backendGet :: backend -> ActionT exts prms m (Maybe sess)
    backendGet b = genBackendModify b (\s -> return (s, s))

    backendSet :: backend -> sess -> ActionT exts prms m ()
    backendSet b s = genBackendModify b (\_ -> return (Just s, ()))

    backendDelete :: backend -> ActionT exts prms m ()
    backendDelete b = genBackendModify b (\_ -> return (Nothing, ()))
