{-|
Module: Database.Persist.Monad.SqlQueryRep

Defines the 'SqlQueryRep' data type that contains a constructor corresponding
to a @persistent@ function.

This file is autogenerated, to keep it in sync with
@Database.Persist.Monad.Shim@.
-}

{- THIS FILE IS AUTOGENERATED AND SHOULD NOT BE EDITED MANUALLY -}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Database.Persist.Monad.SqlQueryRep
  ( SqlQueryRep(..)
  , runSqlQueryRep
  ) where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Acquire (Acquire)
import Data.Conduit (ConduitM)
import Data.Int (Int64)
import Data.Map (Map)
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import Data.Typeable (Typeable, eqT, typeRep, (:~:)(..))
import Data.Void (Void)
import Database.Persist.Sql as Persist hiding (pattern Update)
import GHC.Stack (HasCallStack)

{-# ANN module "HLint: ignore" #-}

-- | The data type containing a constructor for each persistent function we'd
-- like to lift into 'Database.Persist.Monad.MonadSqlQuery'.
--
-- The @record@ type parameter contains the 'PersistEntity' types used in a
-- given function.
--
-- We're using a free-monads-like technique here to allow us to introspect
-- persistent functions in 'Database.Persist.Monad.MonadSqlQuery', e.g. to
-- mock out persistent calls in tests.
data SqlQueryRep record a where
  -- | Constructor corresponding to 'Persist.get'
  Get
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> SqlQueryRep record (Maybe record)

  -- | Constructor corresponding to 'Persist.getMany'
  GetMany
    :: (PersistRecordBackend record SqlBackend)
    => [Key record] -> SqlQueryRep record (Map (Key record) record)

  -- | Constructor corresponding to 'Persist.getJust'
  GetJust
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> SqlQueryRep record record

  -- | Constructor corresponding to 'Persist.getJustEntity'
  GetJustEntity
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> SqlQueryRep record (Entity record)

  -- | Constructor corresponding to 'Persist.getEntity'
  GetEntity
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> SqlQueryRep record (Maybe (Entity record))

  -- | Constructor corresponding to 'Persist.belongsTo'
  BelongsTo
    :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend)
    => (record1 -> Maybe (Key record2)) -> record1 -> SqlQueryRep (record1, record2) (Maybe record2)

  -- | Constructor corresponding to 'Persist.belongsToJust'
  BelongsToJust
    :: (PersistEntity record1, PersistRecordBackend record2 SqlBackend)
    => (record1 -> Key record2) -> record1 -> SqlQueryRep (record1, record2) record2

  -- | Constructor corresponding to 'Persist.insert'
  Insert
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Key record)

  -- | Constructor corresponding to 'Persist.insert_'
  Insert_
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.insertMany'
  InsertMany
    :: (PersistRecordBackend record SqlBackend)
    => [record] -> SqlQueryRep record [Key record]

  -- | Constructor corresponding to 'Persist.insertMany_'
  InsertMany_
    :: (PersistRecordBackend record SqlBackend)
    => [record] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.insertEntityMany'
  InsertEntityMany
    :: (PersistRecordBackend record SqlBackend)
    => [Entity record] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.insertKey'
  InsertKey
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.repsert'
  Repsert
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.repsertMany'
  RepsertMany
    :: (PersistRecordBackend record SqlBackend)
    => [(Key record, record)] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.replace'
  Replace
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.delete'
  Delete
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.update'
  Update
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> [Update record] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.updateGet'
  UpdateGet
    :: (PersistRecordBackend record SqlBackend)
    => Key record -> [Update record] -> SqlQueryRep record record

  -- | Constructor corresponding to 'Persist.insertEntity'
  InsertEntity
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Entity record)

  -- | Constructor corresponding to 'Persist.insertRecord'
  InsertRecord
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record record

  -- | Constructor corresponding to 'Persist.getBy'
  GetBy
    :: (PersistRecordBackend record SqlBackend)
    => Unique record -> SqlQueryRep record (Maybe (Entity record))

#if MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.getByValue'
  GetByValue
    :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record)
    => record -> SqlQueryRep record (Maybe (Entity record))
#endif

#if !MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.getByValue'
  GetByValue
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Maybe (Entity record))
#endif

  -- | Constructor corresponding to 'Persist.checkUnique'
  CheckUnique
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Maybe (Unique record))

#if MIN_VERSION_persistent(2,11,0)
  -- | Constructor corresponding to 'Persist.checkUniqueUpdateable'
  CheckUniqueUpdateable
    :: (PersistRecordBackend record SqlBackend)
    => Entity record -> SqlQueryRep record (Maybe (Unique record))
#endif

  -- | Constructor corresponding to 'Persist.deleteBy'
  DeleteBy
    :: (PersistRecordBackend record SqlBackend)
    => Unique record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.insertUnique'
  InsertUnique
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Maybe (Key record))

#if MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.upsert'
  Upsert
    :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record)
    => record -> [Update record] -> SqlQueryRep record (Entity record)
#endif

#if !MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.upsert'
  Upsert
    :: (PersistRecordBackend record SqlBackend)
    => record -> [Update record] -> SqlQueryRep record (Entity record)
#endif

  -- | Constructor corresponding to 'Persist.upsertBy'
  UpsertBy
    :: (PersistRecordBackend record SqlBackend)
    => Unique record -> record -> [Update record] -> SqlQueryRep record (Entity record)

  -- | Constructor corresponding to 'Persist.putMany'
  PutMany
    :: (PersistRecordBackend record SqlBackend)
    => [record] -> SqlQueryRep record ()

#if MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.insertBy'
  InsertBy
    :: (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record)
    => record -> SqlQueryRep record (Either (Entity record) (Key record))
#endif

#if !MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.insertBy'
  InsertBy
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Either (Entity record) (Key record))
#endif

  -- | Constructor corresponding to 'Persist.insertUniqueEntity'
  InsertUniqueEntity
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Maybe (Entity record))

  -- | Constructor corresponding to 'Persist.replaceUnique'
  ReplaceUnique
    :: (PersistRecordBackend record SqlBackend, Eq (Unique record), Eq record)
    => Key record -> record -> SqlQueryRep record (Maybe (Unique record))

#if MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.onlyUnique'
  OnlyUnique
    :: (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record)
    => record -> SqlQueryRep record (Unique record)
#endif

#if !MIN_VERSION_persistent(2,10,0)
  -- | Constructor corresponding to 'Persist.onlyUnique'
  OnlyUnique
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record (Unique record)
#endif

  -- | Constructor corresponding to 'Persist.selectSourceRes'
  SelectSourceRes
    :: (MonadIO m2, PersistRecordBackend record SqlBackend)
    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record (Acquire (ConduitM () (Entity record) m2 ()))

  -- | Constructor corresponding to 'Persist.selectFirst'
  SelectFirst
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record (Maybe (Entity record))

  -- | Constructor corresponding to 'Persist.selectKeysRes'
  SelectKeysRes
    :: (MonadIO m2, PersistRecordBackend record SqlBackend)
    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record (Acquire (ConduitM () (Key record) m2 ()))

  -- | Constructor corresponding to 'Persist.count'
  Count
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> SqlQueryRep record Int

#if MIN_VERSION_persistent(2,11,0)
  -- | Constructor corresponding to 'Persist.exists'
  Exists
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> SqlQueryRep record Bool
#endif

  -- | Constructor corresponding to 'Persist.selectList'
  SelectList
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record [Entity record]

  -- | Constructor corresponding to 'Persist.selectKeysList'
  SelectKeysList
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> [SelectOpt record] -> SqlQueryRep record [Key record]

  -- | Constructor corresponding to 'Persist.updateWhere'
  UpdateWhere
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> [Update record] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.deleteWhere'
  DeleteWhere
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.deleteWhereCount'
  DeleteWhereCount
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> SqlQueryRep record Int64

  -- | Constructor corresponding to 'Persist.updateWhereCount'
  UpdateWhereCount
    :: (PersistRecordBackend record SqlBackend)
    => [Filter record] -> [Update record] -> SqlQueryRep record Int64

  -- | Constructor corresponding to 'Persist.deleteCascade'
  DeleteCascade
    :: (DeleteCascade record SqlBackend)
    => Key record -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.deleteCascadeWhere'
  DeleteCascadeWhere
    :: (DeleteCascade record SqlBackend)
    => [Filter record] -> SqlQueryRep record ()

  -- | Constructor corresponding to 'Persist.parseMigration'
  ParseMigration
    :: (HasCallStack)
    => Migration -> SqlQueryRep Void (Either [Text] CautiousMigration)

  -- | Constructor corresponding to 'Persist.parseMigration''
  ParseMigration'
    :: (HasCallStack)
    => Migration -> SqlQueryRep Void CautiousMigration

  -- | Constructor corresponding to 'Persist.printMigration'
  PrintMigration
    :: (HasCallStack)
    => Migration -> SqlQueryRep Void ()

  -- | Constructor corresponding to 'Persist.showMigration'
  ShowMigration
    :: (HasCallStack)
    => Migration -> SqlQueryRep Void [Text]

  -- | Constructor corresponding to 'Persist.getMigration'
  GetMigration
    :: (HasCallStack)
    => Migration -> SqlQueryRep Void [Sql]

  -- | Constructor corresponding to 'Persist.runMigration'
  RunMigration
    :: ()
    => Migration -> SqlQueryRep Void ()

#if MIN_VERSION_persistent(2,10,2)
  -- | Constructor corresponding to 'Persist.runMigrationQuiet'
  RunMigrationQuiet
    :: ()
    => Migration -> SqlQueryRep Void [Text]
#endif

  -- | Constructor corresponding to 'Persist.runMigrationSilent'
  RunMigrationSilent
    :: ()
    => Migration -> SqlQueryRep Void [Text]

  -- | Constructor corresponding to 'Persist.runMigrationUnsafe'
  RunMigrationUnsafe
    :: ()
    => Migration -> SqlQueryRep Void ()

#if MIN_VERSION_persistent(2,10,2)
  -- | Constructor corresponding to 'Persist.runMigrationUnsafeQuiet'
  RunMigrationUnsafeQuiet
    :: (HasCallStack)
    => Migration -> SqlQueryRep Void [Text]
#endif

  -- | Constructor corresponding to 'Persist.getFieldName'
  GetFieldName
    :: (PersistRecordBackend record SqlBackend)
    => EntityField record typ -> SqlQueryRep record Text

  -- | Constructor corresponding to 'Persist.getTableName'
  GetTableName
    :: (PersistRecordBackend record SqlBackend)
    => record -> SqlQueryRep record Text

  -- | Constructor corresponding to 'Persist.withRawQuery'
  WithRawQuery
    :: ()
    => Text -> [PersistValue] -> ConduitM [PersistValue] Void IO a -> SqlQueryRep Void a

  -- | Constructor corresponding to 'Persist.rawQueryRes'
  RawQueryRes
    :: (MonadIO m2)
    => Text -> [PersistValue] -> SqlQueryRep Void (Acquire (ConduitM () [PersistValue] m2 ()))

  -- | Constructor corresponding to 'Persist.rawExecute'
  RawExecute
    :: ()
    => Text -> [PersistValue] -> SqlQueryRep Void ()

  -- | Constructor corresponding to 'Persist.rawExecuteCount'
  RawExecuteCount
    :: ()
    => Text -> [PersistValue] -> SqlQueryRep Void Int64

  -- | Constructor corresponding to 'Persist.rawSql'
  RawSql
    :: (RawSql a)
    => Text -> [PersistValue] -> SqlQueryRep Void [a]

  -- | Constructor corresponding to 'Persist.transactionSave'
  TransactionSave
    :: ()
    => SqlQueryRep Void ()

#if MIN_VERSION_persistent(2,9,0)
  -- | Constructor corresponding to 'Persist.transactionSaveWithIsolation'
  TransactionSaveWithIsolation
    :: ()
    => IsolationLevel -> SqlQueryRep Void ()
#endif

  -- | Constructor corresponding to 'Persist.transactionUndo'
  TransactionUndo
    :: ()
    => SqlQueryRep Void ()

#if MIN_VERSION_persistent(2,9,0)
  -- | Constructor corresponding to 'Persist.transactionUndoWithIsolation'
  TransactionUndoWithIsolation
    :: ()
    => IsolationLevel -> SqlQueryRep Void ()
#endif

instance Typeable record => Show (SqlQueryRep record a) where
  show :: SqlQueryRep record a -> String
show = \case
    Get{} -> String
"Get{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetMany{} -> String
"GetMany{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetJust{} -> String
"GetJust{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetJustEntity{} -> String
"GetJustEntity{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetEntity{} -> String
"GetEntity{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    BelongsTo{} -> String
"BelongsTo{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    BelongsToJust{} -> String
"BelongsToJust{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Insert{} -> String
"Insert{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Insert_{} -> String
"Insert_{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertMany{} -> String
"InsertMany{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertMany_{} -> String
"InsertMany_{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertEntityMany{} -> String
"InsertEntityMany{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertKey{} -> String
"InsertKey{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Repsert{} -> String
"Repsert{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RepsertMany{} -> String
"RepsertMany{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Replace{} -> String
"Replace{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Delete{} -> String
"Delete{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Update{} -> String
"Update{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    UpdateGet{} -> String
"UpdateGet{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertEntity{} -> String
"InsertEntity{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertRecord{} -> String
"InsertRecord{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetBy{} -> String
"GetBy{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,10,0)
    GetByValue{} -> String
"GetByValue{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
#if !MIN_VERSION_persistent(2,10,0)
    GetByValue{} -> "GetByValue{..}" ++ record
#endif
    CheckUnique{} -> String
"CheckUnique{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,11,0)
    CheckUniqueUpdateable{} -> String
"CheckUniqueUpdateable{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
    DeleteBy{} -> String
"DeleteBy{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    InsertUnique{} -> String
"InsertUnique{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,10,0)
    Upsert{} -> String
"Upsert{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
#if !MIN_VERSION_persistent(2,10,0)
    Upsert{} -> "Upsert{..}" ++ record
#endif
    UpsertBy{} -> String
"UpsertBy{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    PutMany{} -> String
"PutMany{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,10,0)
    InsertBy{} -> String
"InsertBy{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
#if !MIN_VERSION_persistent(2,10,0)
    InsertBy{} -> "InsertBy{..}" ++ record
#endif
    InsertUniqueEntity{} -> String
"InsertUniqueEntity{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    ReplaceUnique{} -> String
"ReplaceUnique{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,10,0)
    OnlyUnique{} -> String
"OnlyUnique{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
#if !MIN_VERSION_persistent(2,10,0)
    OnlyUnique{} -> "OnlyUnique{..}" ++ record
#endif
    SelectSourceRes{} -> String
"SelectSourceRes{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    SelectFirst{} -> String
"SelectFirst{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    SelectKeysRes{} -> String
"SelectKeysRes{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    Count{} -> String
"Count{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,11,0)
    Exists{} -> String
"Exists{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
    SelectList{} -> String
"SelectList{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    SelectKeysList{} -> String
"SelectKeysList{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    UpdateWhere{} -> String
"UpdateWhere{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    DeleteWhere{} -> String
"DeleteWhere{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    DeleteWhereCount{} -> String
"DeleteWhereCount{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    UpdateWhereCount{} -> String
"UpdateWhereCount{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    DeleteCascade{} -> String
"DeleteCascade{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    DeleteCascadeWhere{} -> String
"DeleteCascadeWhere{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    ParseMigration{} -> String
"ParseMigration{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    ParseMigration'{} -> String
"ParseMigration'{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    PrintMigration{} -> String
"PrintMigration{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    ShowMigration{} -> String
"ShowMigration{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetMigration{} -> String
"GetMigration{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RunMigration{} -> String
"RunMigration{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,10,2)
    RunMigrationQuiet{} -> String
"RunMigrationQuiet{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
    RunMigrationSilent{} -> String
"RunMigrationSilent{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RunMigrationUnsafe{} -> String
"RunMigrationUnsafe{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,10,2)
    RunMigrationUnsafeQuiet{} -> String
"RunMigrationUnsafeQuiet{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
    GetFieldName{} -> String
"GetFieldName{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    GetTableName{} -> String
"GetTableName{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    WithRawQuery{} -> String
"WithRawQuery{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RawQueryRes{} -> String
"RawQueryRes{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RawExecute{} -> String
"RawExecute{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RawExecuteCount{} -> String
"RawExecuteCount{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    RawSql{} -> String
"RawSql{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
    TransactionSave{} -> String
"TransactionSave{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,9,0)
    TransactionSaveWithIsolation{} -> String
"TransactionSaveWithIsolation{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
    TransactionUndo{} -> String
"TransactionUndo{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#if MIN_VERSION_persistent(2,9,0)
    TransactionUndoWithIsolation{} -> String
"TransactionUndoWithIsolation{..}" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
record
#endif
    where
      record :: String
record = case Maybe TypeRep
recordTypeRep of
        Just TypeRep
recordType -> String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show TypeRep
recordType String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"
        Maybe TypeRep
Nothing -> String
""
      recordTypeRep :: Maybe TypeRep
recordTypeRep = case (Typeable record, Typeable Void) => Maybe (record :~: Void)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @record @Void of
        Just record :~: Void
Refl -> Maybe TypeRep
forall a. Maybe a
Nothing
        Maybe (record :~: Void)
Nothing -> TypeRep -> Maybe TypeRep
forall a. a -> Maybe a
Just (TypeRep -> Maybe TypeRep) -> TypeRep -> Maybe TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy record -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy record -> TypeRep) -> Proxy record -> TypeRep
forall a b. (a -> b) -> a -> b
$ Proxy record
forall k (t :: k). Proxy t
Proxy @record

-- | A helper to execute the actual @persistent@ function corresponding to
-- each 'SqlQueryRep' data constructor.
runSqlQueryRep :: MonadUnliftIO m => SqlQueryRep record a -> Persist.SqlPersistT m a
runSqlQueryRep :: SqlQueryRep record a -> SqlPersistT m a
runSqlQueryRep = \case
  Get Key record
a1 -> Key record -> ReaderT SqlBackend m (Maybe record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
Persist.get Key record
a1
  GetMany [Key record]
a1 -> [Key record] -> ReaderT SqlBackend m (Map (Key record) record)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Key record] -> ReaderT backend m (Map (Key record) record)
Persist.getMany [Key record]
a1
  GetJust Key record
a1 -> Key record -> ReaderT SqlBackend m record
forall record backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend record backend,
 MonadIO m) =>
Key record -> ReaderT backend m record
Persist.getJust Key record
a1
  GetJustEntity Key record
a1 -> Key record -> ReaderT SqlBackend m (Entity record)
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend, MonadIO m,
 PersistEntity record, PersistStoreRead backend) =>
Key record -> ReaderT backend m (Entity record)
Persist.getJustEntity Key record
a1
  GetEntity Key record
a1 -> Key record -> ReaderT SqlBackend m (Maybe (Entity record))
forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
Persist.getEntity Key record
a1
  BelongsTo record1 -> Maybe (Key record2)
a1 record1
a2 -> (record1 -> Maybe (Key record2))
-> record1 -> ReaderT SqlBackend m (Maybe record2)
forall ent1 ent2 backend (m :: * -> *).
(PersistStoreRead backend, PersistEntity ent1,
 PersistRecordBackend ent2 backend, MonadIO m) =>
(ent1 -> Maybe (Key ent2))
-> ent1 -> ReaderT backend m (Maybe ent2)
Persist.belongsTo record1 -> Maybe (Key record2)
a1 record1
a2
  BelongsToJust record1 -> Key a
a1 record1
a2 -> (record1 -> Key a) -> record1 -> SqlPersistT m a
forall ent1 ent2 backend (m :: * -> *).
(PersistStoreRead backend, PersistEntity ent1,
 PersistRecordBackend ent2 backend, MonadIO m) =>
(ent1 -> Key ent2) -> ent1 -> ReaderT backend m ent2
Persist.belongsToJust record1 -> Key a
a1 record1
a2
  Insert record
a1 -> record -> ReaderT SqlBackend m (Key record)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
Persist.insert record
a1
  Insert_ record
a1 -> record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
Persist.insert_ record
a1
  InsertMany [record]
a1 -> [record] -> ReaderT SqlBackend m [Key record]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
Persist.insertMany [record]
a1
  InsertMany_ [record]
a1 -> [record] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
Persist.insertMany_ [record]
a1
  InsertEntityMany [Entity record]
a1 -> [Entity record] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Entity record] -> ReaderT backend m ()
Persist.insertEntityMany [Entity record]
a1
  InsertKey Key record
a1 record
a2 -> Key record -> record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
Persist.insertKey Key record
a1 record
a2
  Repsert Key record
a1 record
a2 -> Key record -> record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
Persist.repsert Key record
a1 record
a2
  RepsertMany [(Key record, record)]
a1 -> [(Key record, record)] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[(Key record, record)] -> ReaderT backend m ()
Persist.repsertMany [(Key record, record)]
a1
  Replace Key record
a1 record
a2 -> Key record -> record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
Persist.replace Key record
a1 record
a2
  Delete Key record
a1 -> Key record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
Persist.delete Key record
a1
  Update Key record
a1 [Update record]
a2 -> Key record -> [Update record] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
Persist.update Key record
a1 [Update record]
a2
  UpdateGet Key record
a1 [Update record]
a2 -> Key record -> [Update record] -> ReaderT SqlBackend m record
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m record
Persist.updateGet Key record
a1 [Update record]
a2
  InsertEntity record
a1 -> record -> ReaderT SqlBackend m (Entity record)
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
Persist.insertEntity record
a1
  InsertRecord record
a1 -> record -> ReaderT SqlBackend m record
forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistEntity record, MonadIO m, PersistStoreWrite backend) =>
record -> ReaderT backend m record
Persist.insertRecord record
a1
  GetBy Unique record
a1 -> Unique record -> ReaderT SqlBackend m (Maybe (Entity record))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
Persist.getBy Unique record
a1
#if MIN_VERSION_persistent(2,10,0)
  GetByValue record
a1 -> record -> ReaderT SqlBackend m (Maybe (Entity record))
forall record (m :: * -> *) backend.
(MonadIO m, PersistUniqueRead backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
record -> ReaderT backend m (Maybe (Entity record))
Persist.getByValue record
a1
#endif
#if !MIN_VERSION_persistent(2,10,0)
  GetByValue a1 -> Persist.getByValue a1
#endif
  CheckUnique record
a1 -> record -> ReaderT SqlBackend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
Persist.checkUnique record
a1
#if MIN_VERSION_persistent(2,11,0)
  CheckUniqueUpdateable Entity record
a1 -> Entity record -> ReaderT SqlBackend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
Entity record -> ReaderT backend m (Maybe (Unique record))
Persist.checkUniqueUpdateable Entity record
a1
#endif
  DeleteBy Unique record
a1 -> Unique record -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m ()
Persist.deleteBy Unique record
a1
  InsertUnique record
a1 -> record -> ReaderT SqlBackend m (Maybe (Key record))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
Persist.insertUnique record
a1
#if MIN_VERSION_persistent(2,10,0)
  Upsert record
a1 [Update record]
a2 -> record -> [Update record] -> ReaderT SqlBackend m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
Persist.upsert record
a1 [Update record]
a2
#endif
#if !MIN_VERSION_persistent(2,10,0)
  Upsert a1 a2 -> Persist.upsert a1 a2
#endif
  UpsertBy Unique record
a1 record
a2 [Update record]
a3 -> Unique record
-> record
-> [Update record]
-> ReaderT SqlBackend m (Entity record)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
Persist.upsertBy Unique record
a1 record
a2 [Update record]
a3
  PutMany [record]
a1 -> [record] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
Persist.putMany [record]
a1
#if MIN_VERSION_persistent(2,10,0)
  InsertBy record
a1 -> record
-> ReaderT SqlBackend m (Either (Entity record) (Key record))
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
record -> ReaderT backend m (Either (Entity record) (Key record))
Persist.insertBy record
a1
#endif
#if !MIN_VERSION_persistent(2,10,0)
  InsertBy a1 -> Persist.insertBy a1
#endif
  InsertUniqueEntity record
a1 -> record -> ReaderT SqlBackend m (Maybe (Entity record))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueWrite backend) =>
record -> ReaderT backend m (Maybe (Entity record))
Persist.insertUniqueEntity record
a1
  ReplaceUnique Key record
a1 record
a2 -> Key record
-> record -> ReaderT SqlBackend m (Maybe (Unique record))
forall record backend (m :: * -> *).
(MonadIO m, Eq (Unique record),
 PersistRecordBackend record backend, PersistUniqueWrite backend) =>
Key record -> record -> ReaderT backend m (Maybe (Unique record))
Persist.replaceUnique Key record
a1 record
a2
#if MIN_VERSION_persistent(2,10,0)
  OnlyUnique record
a1 -> record -> ReaderT SqlBackend m (Unique record)
forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> ReaderT backend m (Unique record)
Persist.onlyUnique record
a1
#endif
#if !MIN_VERSION_persistent(2,10,0)
  OnlyUnique a1 -> Persist.onlyUnique a1
#endif
  SelectSourceRes [Filter record]
a1 [SelectOpt record]
a2 -> [Filter record]
-> [SelectOpt record]
-> ReaderT
     SqlBackend m (Acquire (ConduitM () (Entity record) m2 ()))
forall backend record (m1 :: * -> *) (m2 :: * -> *).
(PersistQueryRead backend, PersistRecordBackend record backend,
 MonadIO m1, MonadIO m2) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Entity record) m2 ()))
Persist.selectSourceRes [Filter record]
a1 [SelectOpt record]
a2
  SelectFirst [Filter record]
a1 [SelectOpt record]
a2 -> [Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m (Maybe (Entity record))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
Persist.selectFirst [Filter record]
a1 [SelectOpt record]
a2
  SelectKeysRes [Filter record]
a1 [SelectOpt record]
a2 -> [Filter record]
-> [SelectOpt record]
-> ReaderT SqlBackend m (Acquire (ConduitM () (Key record) m2 ()))
forall backend (m1 :: * -> *) (m2 :: * -> *) record.
(PersistQueryRead backend, MonadIO m1, MonadIO m2,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record]
-> ReaderT backend m1 (Acquire (ConduitM () (Key record) m2 ()))
Persist.selectKeysRes [Filter record]
a1 [SelectOpt record]
a2
  Count [Filter record]
a1 -> [Filter record] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
Persist.count [Filter record]
a1
#if MIN_VERSION_persistent(2,11,0)
  Exists [Filter record]
a1 -> [Filter record] -> ReaderT SqlBackend m Bool
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
Persist.exists [Filter record]
a1
#endif
  SelectList [Filter record]
a1 [SelectOpt record]
a2 -> [Filter record]
-> [SelectOpt record] -> ReaderT SqlBackend m [Entity record]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
Persist.selectList [Filter record]
a1 [SelectOpt record]
a2
  SelectKeysList [Filter record]
a1 [SelectOpt record]
a2 -> [Filter record]
-> [SelectOpt record] -> ReaderT SqlBackend m [Key record]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Key record]
Persist.selectKeysList [Filter record]
a1 [SelectOpt record]
a2
  UpdateWhere [Filter record]
a1 [Update record]
a2 -> [Filter record] -> [Update record] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> [Update record] -> ReaderT backend m ()
Persist.updateWhere [Filter record]
a1 [Update record]
a2
  DeleteWhere [Filter record]
a1 -> [Filter record] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
Persist.deleteWhere [Filter record]
a1
  DeleteWhereCount [Filter record]
a1 -> [Filter record] -> ReaderT SqlBackend m Int64
forall val (m :: * -> *) backend.
(PersistEntity val, MonadIO m,
 PersistEntityBackend val ~ SqlBackend,
 BackendCompatible SqlBackend backend) =>
[Filter val] -> ReaderT backend m Int64
Persist.deleteWhereCount [Filter record]
a1
  UpdateWhereCount [Filter record]
a1 [Update record]
a2 -> [Filter record] -> [Update record] -> ReaderT SqlBackend m Int64
forall val (m :: * -> *) backend.
(PersistEntity val, MonadIO m,
 SqlBackend ~ PersistEntityBackend val,
 BackendCompatible SqlBackend backend) =>
[Filter val] -> [Update val] -> ReaderT backend m Int64
Persist.updateWhereCount [Filter record]
a1 [Update record]
a2
  DeleteCascade Key record
a1 -> Key record -> ReaderT SqlBackend m ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
Persist.deleteCascade Key record
a1
  DeleteCascadeWhere [Filter record]
a1 -> [Filter record] -> ReaderT SqlBackend m ()
forall record backend (m :: * -> *).
(MonadIO m, DeleteCascade record backend,
 PersistQueryWrite backend) =>
[Filter record] -> ReaderT backend m ()
Persist.deleteCascadeWhere [Filter record]
a1
  ParseMigration Migration
a1 -> Migration -> ReaderT SqlBackend m (Either [Text] CautiousMigration)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m (Either [Text] CautiousMigration)
Persist.parseMigration Migration
a1
  ParseMigration' Migration
a1 -> Migration -> ReaderT SqlBackend m CautiousMigration
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m CautiousMigration
Persist.parseMigration' Migration
a1
  PrintMigration Migration
a1 -> Migration -> ReaderT SqlBackend m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m ()
Persist.printMigration Migration
a1
  ShowMigration Migration
a1 -> Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Text]
Persist.showMigration Migration
a1
  GetMigration Migration
a1 -> Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
Persist.getMigration Migration
a1
  RunMigration Migration
a1 -> Migration -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
Persist.runMigration Migration
a1
#if MIN_VERSION_persistent(2,10,2)
  RunMigrationQuiet Migration
a1 -> Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m [Text]
Persist.runMigrationQuiet Migration
a1
#endif
  RunMigrationSilent Migration
a1 -> Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
MonadUnliftIO m =>
Migration -> ReaderT SqlBackend m [Text]
Persist.runMigrationSilent Migration
a1
  RunMigrationUnsafe Migration
a1 -> Migration -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
Persist.runMigrationUnsafe Migration
a1
#if MIN_VERSION_persistent(2,10,2)
  RunMigrationUnsafeQuiet Migration
a1 -> Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Text]
Persist.runMigrationUnsafeQuiet Migration
a1
#endif
  GetFieldName EntityField record typ
a1 -> EntityField record typ -> ReaderT SqlBackend m Text
forall record typ (m :: * -> *) backend.
(PersistEntity record, PersistEntityBackend record ~ SqlBackend,
 BackendCompatible SqlBackend backend, Monad m) =>
EntityField record typ -> ReaderT backend m Text
Persist.getFieldName EntityField record typ
a1
  GetTableName record
a1 -> record -> ReaderT SqlBackend m Text
forall record (m :: * -> *) backend.
(PersistEntity record, BackendCompatible SqlBackend backend,
 Monad m) =>
record -> ReaderT backend m Text
Persist.getTableName record
a1
  WithRawQuery Text
a1 [PersistValue]
a2 ConduitM [PersistValue] Void IO a
a3 -> Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> SqlPersistT m a
forall (m :: * -> *) a.
MonadIO m =>
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> ReaderT SqlBackend m a
Persist.withRawQuery Text
a1 [PersistValue]
a2 ConduitM [PersistValue] Void IO a
a3
  RawQueryRes Text
a1 [PersistValue]
a2 -> Text
-> [PersistValue]
-> ReaderT
     SqlBackend m (Acquire (ConduitM () [PersistValue] m2 ()))
forall (m1 :: * -> *) (m2 :: * -> *) env.
(MonadIO m1, MonadIO m2, BackendCompatible SqlBackend env) =>
Text
-> [PersistValue]
-> ReaderT env m1 (Acquire (ConduitM () [PersistValue] m2 ()))
Persist.rawQueryRes Text
a1 [PersistValue]
a2
  RawExecute Text
a1 [PersistValue]
a2 -> Text -> [PersistValue] -> ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
Persist.rawExecute Text
a1 [PersistValue]
a2
  RawExecuteCount Text
a1 [PersistValue]
a2 -> Text -> [PersistValue] -> ReaderT SqlBackend m Int64
forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m Int64
Persist.rawExecuteCount Text
a1 [PersistValue]
a2
  RawSql Text
a1 [PersistValue]
a2 -> Text -> [PersistValue] -> ReaderT SqlBackend m [a]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
Persist.rawSql Text
a1 [PersistValue]
a2
  SqlQueryRep record a
TransactionSave -> SqlPersistT m a
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
Persist.transactionSave
#if MIN_VERSION_persistent(2,9,0)
  TransactionSaveWithIsolation IsolationLevel
a1 -> IsolationLevel -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
IsolationLevel -> ReaderT SqlBackend m ()
Persist.transactionSaveWithIsolation IsolationLevel
a1
#endif
  SqlQueryRep record a
TransactionUndo -> SqlPersistT m a
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
Persist.transactionUndo
#if MIN_VERSION_persistent(2,9,0)
  TransactionUndoWithIsolation IsolationLevel
a1 -> IsolationLevel -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
IsolationLevel -> ReaderT SqlBackend m ()
Persist.transactionUndoWithIsolation IsolationLevel
a1
#endif