1{-# LANGUAGE ConstraintKinds #-} 2{-# LANGUAGE DeriveDataTypeable #-} 3{-# LANGUAGE RankNTypes #-} 4module Database.Persist.Sql.Types.Internal 5 ( HasPersistBackend (..) 6 , IsPersistBackend (..) 7 , SqlReadBackend (..) 8 , SqlWriteBackend (..) 9 , readToUnknown 10 , readToWrite 11 , writeToUnknown 12 , LogFunc 13 , InsertSqlResult (..) 14 , Statement (..) 15 , IsolationLevel (..) 16 , makeIsolationLevelStatement 17 , SqlBackend (..) 18 , SqlBackendCanRead 19 , SqlBackendCanWrite 20 , SqlReadT 21 , SqlWriteT 22 , IsSqlBackend 23 ) where 24 25import Data.List.NonEmpty (NonEmpty(..)) 26import Control.Monad.IO.Class (MonadIO (..)) 27import Control.Monad.Logger (LogSource, LogLevel) 28import Control.Monad.Trans.Class (lift) 29import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask) 30import Data.Acquire (Acquire) 31import Data.Conduit (ConduitM) 32import Data.Int (Int64) 33import Data.IORef (IORef) 34import Data.Map (Map) 35import Data.Monoid ((<>)) 36import Data.String (IsString) 37import Data.Text (Text) 38import Data.Typeable (Typeable) 39import Language.Haskell.TH.Syntax (Loc) 40import System.Log.FastLogger (LogStr) 41 42import Database.Persist.Class 43 ( HasPersistBackend (..) 44 , PersistQueryRead, PersistQueryWrite 45 , PersistStoreRead, PersistStoreWrite 46 , PersistUniqueRead, PersistUniqueWrite 47 , BackendCompatible(..) 48 ) 49import Database.Persist.Class.PersistStore (IsPersistBackend (..)) 50import Database.Persist.Types 51 52type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () 53 54data InsertSqlResult = ISRSingle Text 55 | ISRInsertGet Text Text 56 | ISRManyKeys Text [PersistValue] 57 58data Statement = Statement 59 { stmtFinalize :: IO () 60 , stmtReset :: IO () 61 , stmtExecute :: [PersistValue] -> IO Int64 62 , stmtQuery :: forall m. MonadIO m 63 => [PersistValue] 64 -> Acquire (ConduitM () [PersistValue] m ()) 65 } 66 67-- | Please refer to the documentation for the database in question for a full 68-- overview of the semantics of the varying isloation levels 69data IsolationLevel = ReadUncommitted 70 | ReadCommitted 71 | RepeatableRead 72 | Serializable 73 deriving (Show, Eq, Enum, Ord, Bounded) 74 75makeIsolationLevelStatement :: (Monoid s, IsString s) => IsolationLevel -> s 76makeIsolationLevelStatement l = "SET TRANSACTION ISOLATION LEVEL " <> case l of 77 ReadUncommitted -> "READ UNCOMMITTED" 78 ReadCommitted -> "READ COMMITTED" 79 RepeatableRead -> "REPEATABLE READ" 80 Serializable -> "SERIALIZABLE" 81 82data SqlBackend = SqlBackend 83 { connPrepare :: Text -> IO Statement 84 -- | table name, column names, id name, either 1 or 2 statements to run 85 , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult 86 , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult) 87 -- ^ SQL for inserting many rows and returning their primary keys, for 88 -- backends that support this functioanlity. If 'Nothing', rows will be 89 -- inserted one-at-a-time using 'connInsertSql'. 90 , connUpsertSql :: Maybe (EntityDef -> NonEmpty UniqueDef -> Text -> Text) 91 -- ^ Some databases support performing UPSERT _and_ RETURN entity 92 -- in a single call. 93 -- 94 -- This field when set will be used to generate the UPSERT+RETURN sql given 95 -- * an entity definition 96 -- * updates to be run on unique key(s) collision 97 -- 98 -- When left as 'Nothing', we find the unique key from entity def before 99 -- * trying to fetch an entity by said key 100 -- * perform an update when result found, else issue an insert 101 -- * return new entity from db 102 -- 103 -- @since 2.6 104 , connPutManySql :: Maybe (EntityDef -> Int -> Text) 105 -- ^ Some databases support performing bulk UPSERT, specifically 106 -- "insert or replace many records" in a single call. 107 -- 108 -- This field when set, given 109 -- * an entity definition 110 -- * number of records to be inserted 111 -- should produce a PUT MANY sql with placeholders for records 112 -- 113 -- When left as 'Nothing', we default to using 'defaultPutMany'. 114 -- 115 -- @since 2.8.1 116 , connStmtMap :: IORef (Map Text Statement) 117 , connClose :: IO () 118 , connMigrateSql 119 :: [EntityDef] 120 -> (Text -> IO Statement) 121 -> EntityDef 122 -> IO (Either [Text] [(Bool, Text)]) 123 , connBegin :: (Text -> IO Statement) -> Maybe IsolationLevel -> IO () 124 , connCommit :: (Text -> IO Statement) -> IO () 125 , connRollback :: (Text -> IO Statement) -> IO () 126 , connEscapeName :: DBName -> Text 127 , connNoLimit :: Text 128 , connRDBMS :: Text 129 , connLimitOffset :: (Int,Int) -> Bool -> Text -> Text 130 , connLogFunc :: LogFunc 131 , connMaxParams :: Maybe Int 132 -- ^ Some databases (probably only Sqlite) have a limit on how 133 -- many question-mark parameters may be used in a statement 134 -- 135 -- @since 2.6.1 136 , connRepsertManySql :: Maybe (EntityDef -> Int -> Text) 137 -- ^ Some databases support performing bulk an atomic+bulk INSERT where 138 -- constraint conflicting entities can replace existing entities. 139 -- 140 -- This field when set, given 141 -- * an entity definition 142 -- * number of records to be inserted 143 -- should produce a INSERT sql with placeholders for primary+record fields 144 -- 145 -- When left as 'Nothing', we default to using 'defaultRepsertMany'. 146 -- 147 -- @since 2.9.0 148 } 149 deriving Typeable 150instance HasPersistBackend SqlBackend where 151 type BaseBackend SqlBackend = SqlBackend 152 persistBackend = id 153instance IsPersistBackend SqlBackend where 154 mkPersistBackend = id 155 156-- | An SQL backend which can only handle read queries 157-- 158-- The constructor was exposed in 2.10.0. 159newtype SqlReadBackend = SqlReadBackend { unSqlReadBackend :: SqlBackend } deriving Typeable 160instance HasPersistBackend SqlReadBackend where 161 type BaseBackend SqlReadBackend = SqlBackend 162 persistBackend = unSqlReadBackend 163instance IsPersistBackend SqlReadBackend where 164 mkPersistBackend = SqlReadBackend 165 166-- | An SQL backend which can handle read or write queries 167-- 168-- The constructor was exposed in 2.10.0 169newtype SqlWriteBackend = SqlWriteBackend { unSqlWriteBackend :: SqlBackend } deriving Typeable 170instance HasPersistBackend SqlWriteBackend where 171 type BaseBackend SqlWriteBackend = SqlBackend 172 persistBackend = unSqlWriteBackend 173instance IsPersistBackend SqlWriteBackend where 174 mkPersistBackend = SqlWriteBackend 175 176-- | Useful for running a write query against an untagged backend with unknown capabilities. 177writeToUnknown :: Monad m => ReaderT SqlWriteBackend m a -> ReaderT SqlBackend m a 178writeToUnknown ma = do 179 unknown <- ask 180 lift . runReaderT ma $ SqlWriteBackend unknown 181 182-- | Useful for running a read query against a backend with read and write capabilities. 183readToWrite :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlWriteBackend m a 184readToWrite ma = do 185 write <- ask 186 lift . runReaderT ma . SqlReadBackend $ unSqlWriteBackend write 187 188-- | Useful for running a read query against a backend with unknown capabilities. 189readToUnknown :: Monad m => ReaderT SqlReadBackend m a -> ReaderT SqlBackend m a 190readToUnknown ma = do 191 unknown <- ask 192 lift . runReaderT ma $ SqlReadBackend unknown 193 194-- | A constraint synonym which witnesses that a backend is SQL and can run read queries. 195type SqlBackendCanRead backend = 196 ( BackendCompatible SqlBackend backend 197 , PersistQueryRead backend, PersistStoreRead backend, PersistUniqueRead backend 198 ) 199-- | A constraint synonym which witnesses that a backend is SQL and can run read and write queries. 200type SqlBackendCanWrite backend = 201 ( SqlBackendCanRead backend 202 , PersistQueryWrite backend, PersistStoreWrite backend, PersistUniqueWrite backend 203 ) 204-- | Like @SqlPersistT@ but compatible with any SQL backend which can handle read queries. 205type SqlReadT m a = forall backend. (SqlBackendCanRead backend) => ReaderT backend m a 206-- | Like @SqlPersistT@ but compatible with any SQL backend which can handle read and write queries. 207type SqlWriteT m a = forall backend. (SqlBackendCanWrite backend) => ReaderT backend m a 208-- | A backend which is a wrapper around @SqlBackend@. 209type IsSqlBackend backend = (IsPersistBackend backend, BaseBackend backend ~ SqlBackend) 210