module Yesod.Session.Persist.Yesod
  ( -- * Concretely
    makeSessionBackend
  , SessionConfiguration (..)
  ) where

import Internal.Prelude

import Yesod.Core.Types (SessionBackend (..))
import Yesod.Session.Options
import Yesod.Session.Persist.Storage
import Yesod.Session.Storage.Yesod
  ( SessionConfiguration' (..)
  , makeSessionBackend'
  )

data SessionConfiguration persistentBackend persistentRecord = SessionConfiguration
  { forall persistentBackend persistentRecord.
SessionConfiguration persistentBackend persistentRecord
-> SessionPersistence persistentBackend persistentRecord IO
persistence :: SessionPersistence persistentBackend persistentRecord IO
  -- ^ Mapping between 'Yesod.Session.Persist.Session' and your Persistent entity
  , forall persistentBackend persistentRecord.
SessionConfiguration persistentBackend persistentRecord
-> Options (ReaderT persistentBackend IO) IO
options :: Options (ReaderT persistentBackend IO) IO
  -- ^ Various options that have defaults; see 'defaultOptions'
  }

-- | Use this to implement 'Yesod.Core.makeSessionBackend'.
--
-- The @session@ type parameter represents the Persistent entity
-- you're using to store sessions
-- (see the 'SessionPersistence' field of the configuration).
makeSessionBackend
  :: forall persistentBackend persistentRecord
   . SessionConfiguration persistentBackend persistentRecord
  -> IO SessionBackend
makeSessionBackend :: forall persistentBackend persistentRecord.
SessionConfiguration persistentBackend persistentRecord
-> IO SessionBackend
makeSessionBackend SessionConfiguration persistentBackend persistentRecord
configuration =
  let SessionConfiguration {SessionPersistence persistentBackend persistentRecord IO
$sel:persistence:SessionConfiguration :: forall persistentBackend persistentRecord.
SessionConfiguration persistentBackend persistentRecord
-> SessionPersistence persistentBackend persistentRecord IO
persistence :: SessionPersistence persistentBackend persistentRecord IO
persistence, Options (ReaderT persistentBackend IO) IO
$sel:options:SessionConfiguration :: forall persistentBackend persistentRecord.
SessionConfiguration persistentBackend persistentRecord
-> Options (ReaderT persistentBackend IO) IO
options :: Options (ReaderT persistentBackend IO) IO
options} = SessionConfiguration persistentBackend persistentRecord
configuration
  in  case SessionPersistence persistentBackend persistentRecord IO
persistence of
        SessionPersistence {forall a. ReaderT persistentBackend IO a -> IO a
runDB :: forall a. ReaderT persistentBackend IO a -> IO a
$sel:runDB:SessionPersistence :: forall backend record (m :: * -> *).
SessionPersistence backend record m
-> forall a. ReaderT backend IO a -> m a
runDB} ->
          SessionConfiguration' Any -> IO SessionBackend
forall {k} (session :: k).
SessionConfiguration' session -> IO SessionBackend
makeSessionBackend'
            SessionConfiguration'
              { $sel:storage:SessionConfiguration' :: forall a. StorageOperation a -> ReaderT persistentBackend IO a
storage = SessionPersistence persistentBackend persistentRecord IO
-> StorageOperation a -> ReaderT persistentBackend IO a
forall record backend result (m :: * -> *).
(PersistRecordBackend record backend, PersistStoreWrite backend) =>
SessionPersistence backend record m
-> StorageOperation result -> ReaderT backend IO result
persistentStorage SessionPersistence persistentBackend persistentRecord IO
persistence
              , $sel:options:SessionConfiguration' :: Options (ReaderT persistentBackend IO) IO
options = Options (ReaderT persistentBackend IO) IO
options
              , ReaderT persistentBackend IO a -> IO a
forall a. ReaderT persistentBackend IO a -> IO a
runDB :: forall a. ReaderT persistentBackend IO a -> IO a
$sel:runDB:SessionConfiguration' :: forall a. ReaderT persistentBackend IO a -> IO a
runDB
              }