{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators #-}
module Database.Persist.Sql.Types.Internal
( HasPersistBackend (..)
, IsPersistBackend (..)
, SqlReadBackend (..)
, SqlWriteBackend (..)
, readToUnknown
, readToWrite
, writeToUnknown
, LogFunc
, InsertSqlResult (..)
, Statement (..)
, IsolationLevel (..)
, makeIsolationLevelStatement
, SqlBackend (..)
, SqlBackendCanRead
, SqlBackendCanWrite
, SqlReadT
, SqlWriteT
, IsSqlBackend
, SqlBackendHooks (..)
) where
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Database.Persist.Class
( BackendCompatible(..)
, HasPersistBackend(..)
, PersistQueryRead
, PersistQueryWrite
, PersistStoreRead
, PersistStoreWrite
, PersistUniqueRead
, PersistUniqueWrite
)
import Database.Persist.Class.PersistStore (IsPersistBackend(..))
import Database.Persist.SqlBackend.Internal
import Database.Persist.SqlBackend.Internal.InsertSqlResult
import Database.Persist.SqlBackend.Internal.IsolationLevel
import Database.Persist.SqlBackend.Internal.MkSqlBackend
import Database.Persist.SqlBackend.Internal.Statement
newtype SqlReadBackend = SqlReadBackend { SqlReadBackend -> SqlBackend
unSqlReadBackend :: SqlBackend }
instance HasPersistBackend SqlReadBackend where
type BaseBackend SqlReadBackend = SqlBackend
persistBackend :: SqlReadBackend -> BaseBackend SqlReadBackend
persistBackend = SqlReadBackend -> BaseBackend SqlReadBackend
SqlReadBackend -> SqlBackend
unSqlReadBackend
instance IsPersistBackend SqlReadBackend where
mkPersistBackend :: BaseBackend SqlReadBackend -> SqlReadBackend
mkPersistBackend = BaseBackend SqlReadBackend -> SqlReadBackend
SqlBackend -> SqlReadBackend
SqlReadBackend
newtype SqlWriteBackend = SqlWriteBackend { SqlWriteBackend -> SqlBackend
unSqlWriteBackend :: SqlBackend }
instance HasPersistBackend SqlWriteBackend where
type BaseBackend SqlWriteBackend = SqlBackend
persistBackend :: SqlWriteBackend -> BaseBackend SqlWriteBackend
persistBackend = SqlWriteBackend -> BaseBackend SqlWriteBackend
SqlWriteBackend -> SqlBackend
unSqlWriteBackend
instance IsPersistBackend SqlWriteBackend where
mkPersistBackend :: BaseBackend SqlWriteBackend -> SqlWriteBackend
mkPersistBackend = BaseBackend SqlWriteBackend -> SqlWriteBackend
SqlBackend -> SqlWriteBackend
SqlWriteBackend
writeToUnknown :: Monad m => ReaderT SqlWriteBackend m a -> ReaderT SqlBackend m a
writeToUnknown :: forall (m :: * -> *) a.
Monad m =>
ReaderT SqlWriteBackend m a -> ReaderT SqlBackend m a
writeToUnknown ReaderT SqlWriteBackend m a
ma = do
unknown <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
lift . runReaderT ma $ SqlWriteBackend unknown
readToWrite :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlWriteBackend m a
readToWrite :: forall (m :: * -> *) a.
Monad m =>
ReaderT SqlReadBackend m a -> ReaderT SqlWriteBackend m a
readToWrite ReaderT SqlReadBackend m a
ma = do
write <- ReaderT SqlWriteBackend m SqlWriteBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
lift . runReaderT ma . SqlReadBackend $ unSqlWriteBackend write
readToUnknown :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlBackend m a
readToUnknown :: forall (m :: * -> *) a.
Monad m =>
ReaderT SqlReadBackend m a -> ReaderT SqlBackend m a
readToUnknown ReaderT SqlReadBackend m a
ma = do
unknown <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
lift . runReaderT ma $ SqlReadBackend unknown
type SqlBackendCanRead backend =
( BackendCompatible SqlBackend backend
, PersistQueryRead backend, PersistStoreRead backend, PersistUniqueRead backend
)
type SqlBackendCanWrite backend =
( SqlBackendCanRead backend
, PersistQueryWrite backend, PersistStoreWrite backend, PersistUniqueWrite backend
)
type SqlReadT m a = forall backend. (SqlBackendCanRead backend) => ReaderT backend m a
type SqlWriteT m a = forall backend. (SqlBackendCanWrite backend) => ReaderT backend m a
type IsSqlBackend backend =
( IsPersistBackend backend
, BaseBackend backend ~ SqlBackend
)