{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
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
SqlBackend
unknown <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
m a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT SqlBackend m a)
-> (SqlWriteBackend -> m a)
-> SqlWriteBackend
-> ReaderT SqlBackend m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlWriteBackend m a -> SqlWriteBackend -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT SqlWriteBackend m a
ma (SqlWriteBackend -> ReaderT SqlBackend m a)
-> SqlWriteBackend -> ReaderT SqlBackend m a
forall a b. (a -> b) -> a -> b
$ SqlBackend -> SqlWriteBackend
SqlWriteBackend SqlBackend
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
SqlWriteBackend
write <- ReaderT SqlWriteBackend m SqlWriteBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
m a -> ReaderT SqlWriteBackend m a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT SqlWriteBackend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT SqlWriteBackend m a)
-> (SqlBackend -> m a) -> SqlBackend -> ReaderT SqlWriteBackend m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlReadBackend m a -> SqlReadBackend -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT SqlReadBackend m a
ma (SqlReadBackend -> m a)
-> (SqlBackend -> SqlReadBackend) -> SqlBackend -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqlBackend -> SqlReadBackend
SqlReadBackend (SqlBackend -> ReaderT SqlWriteBackend m a)
-> SqlBackend -> ReaderT SqlWriteBackend m a
forall a b. (a -> b) -> a -> b
$ SqlWriteBackend -> SqlBackend
unSqlWriteBackend SqlWriteBackend
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
SqlBackend
unknown <- ReaderT SqlBackend m SqlBackend
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
m a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT SqlBackend m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT SqlBackend m a)
-> (SqlReadBackend -> m a)
-> SqlReadBackend
-> ReaderT SqlBackend m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT SqlReadBackend m a -> SqlReadBackend -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT SqlReadBackend m a
ma (SqlReadBackend -> ReaderT SqlBackend m a)
-> SqlReadBackend -> ReaderT SqlBackend m a
forall a b. (a -> b) -> a -> b
$ SqlBackend -> SqlReadBackend
SqlReadBackend SqlBackend
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
)