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

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

{-|
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@.
-}
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 qualified Data.Text as Text
import Data.Typeable (Typeable, eqT, typeRep, (:~:) (..))
import Data.Void (Void)
import Database.Persist.Sql as Persist hiding (pattern Update)
import GHC.Stack (HasCallStack)

#if !MIN_VERSION_persistent(2,14,1)
import Database.Persist.Monad.Internal.PersistentShim (SafeToInsert)
#endif

-- | 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, SafeToInsert record) =>
    record ->
    SqlQueryRep (record) (Key record)

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

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

  -- | Constructor corresponding to 'Persist.insertMany_'
  InsertMany_ ::
    (PersistRecordBackend record SqlBackend, SafeToInsert record) =>
    [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, SafeToInsert record) =>
    record ->
    SqlQueryRep (record) (Entity record)

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

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

  -- | Constructor corresponding to 'Persist.getByValue'
  GetByValue ::
    (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record) =>
    record ->
    SqlQueryRep (record) (Maybe (Entity record))

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

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

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

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

  -- | Constructor corresponding to 'Persist.upsert'
  Upsert ::
    (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, SafeToInsert record) =>
    record ->
    [Update record] ->
    SqlQueryRep (record) (Entity record)

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

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

  -- | Constructor corresponding to 'Persist.insertBy'
  InsertBy ::
    (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, SafeToInsert record) =>
    record ->
    SqlQueryRep (record) (Either (Entity record) (Key record))

  -- | Constructor corresponding to 'Persist.insertUniqueEntity'
  InsertUniqueEntity ::
    (PersistRecordBackend record SqlBackend, SafeToInsert record) =>
    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))

  -- | Constructor corresponding to 'Persist.onlyUnique'
  OnlyUnique ::
    (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record) =>
    record ->
    SqlQueryRep (record) (Unique record)

  -- | 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

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

  -- | 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.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) ()

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

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

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

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

  -- | 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) ()

  -- | Constructor corresponding to 'Persist.transactionSaveWithIsolation'
  TransactionSaveWithIsolation ::
    () =>
    IsolationLevel ->
    SqlQueryRep (Void) ()

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

  -- | Constructor corresponding to 'Persist.transactionUndoWithIsolation'
  TransactionUndoWithIsolation ::
    () =>
    IsolationLevel ->
    SqlQueryRep (Void) ()

  -- | Constructor for lifting an arbitrary SqlPersistT action into SqlQueryRep.
  UnsafeLiftSql
    :: Text -> (forall m. MonadIO m => Persist.SqlPersistT m a) -> SqlQueryRep Void a

instance Typeable record => Show (SqlQueryRep record a) where
  show :: SqlQueryRep record a -> String
show = \case
    Get{} -> String
"Get{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetMany{} -> String
"GetMany{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetJust{} -> String
"GetJust{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetJustEntity{} -> String
"GetJustEntity{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetEntity{} -> String
"GetEntity{..}" forall a. [a] -> [a] -> [a]
++ String
record
    BelongsTo{} -> String
"BelongsTo{..}" forall a. [a] -> [a] -> [a]
++ String
record
    BelongsToJust{} -> String
"BelongsToJust{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Insert{} -> String
"Insert{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Insert_{} -> String
"Insert_{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertMany{} -> String
"InsertMany{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertMany_{} -> String
"InsertMany_{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertEntityMany{} -> String
"InsertEntityMany{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertKey{} -> String
"InsertKey{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Repsert{} -> String
"Repsert{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RepsertMany{} -> String
"RepsertMany{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Replace{} -> String
"Replace{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Delete{} -> String
"Delete{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Update{} -> String
"Update{..}" forall a. [a] -> [a] -> [a]
++ String
record
    UpdateGet{} -> String
"UpdateGet{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertEntity{} -> String
"InsertEntity{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertRecord{} -> String
"InsertRecord{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetBy{} -> String
"GetBy{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetByValue{} -> String
"GetByValue{..}" forall a. [a] -> [a] -> [a]
++ String
record
    CheckUnique{} -> String
"CheckUnique{..}" forall a. [a] -> [a] -> [a]
++ String
record
    CheckUniqueUpdateable{} -> String
"CheckUniqueUpdateable{..}" forall a. [a] -> [a] -> [a]
++ String
record
    DeleteBy{} -> String
"DeleteBy{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertUnique{} -> String
"InsertUnique{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Upsert{} -> String
"Upsert{..}" forall a. [a] -> [a] -> [a]
++ String
record
    UpsertBy{} -> String
"UpsertBy{..}" forall a. [a] -> [a] -> [a]
++ String
record
    PutMany{} -> String
"PutMany{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertBy{} -> String
"InsertBy{..}" forall a. [a] -> [a] -> [a]
++ String
record
    InsertUniqueEntity{} -> String
"InsertUniqueEntity{..}" forall a. [a] -> [a] -> [a]
++ String
record
    ReplaceUnique{} -> String
"ReplaceUnique{..}" forall a. [a] -> [a] -> [a]
++ String
record
    OnlyUnique{} -> String
"OnlyUnique{..}" forall a. [a] -> [a] -> [a]
++ String
record
    SelectSourceRes{} -> String
"SelectSourceRes{..}" forall a. [a] -> [a] -> [a]
++ String
record
    SelectFirst{} -> String
"SelectFirst{..}" forall a. [a] -> [a] -> [a]
++ String
record
    SelectKeysRes{} -> String
"SelectKeysRes{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Count{} -> String
"Count{..}" forall a. [a] -> [a] -> [a]
++ String
record
    Exists{} -> String
"Exists{..}" forall a. [a] -> [a] -> [a]
++ String
record
    SelectList{} -> String
"SelectList{..}" forall a. [a] -> [a] -> [a]
++ String
record
    SelectKeysList{} -> String
"SelectKeysList{..}" forall a. [a] -> [a] -> [a]
++ String
record
    UpdateWhere{} -> String
"UpdateWhere{..}" forall a. [a] -> [a] -> [a]
++ String
record
    DeleteWhere{} -> String
"DeleteWhere{..}" forall a. [a] -> [a] -> [a]
++ String
record
    DeleteWhereCount{} -> String
"DeleteWhereCount{..}" forall a. [a] -> [a] -> [a]
++ String
record
    UpdateWhereCount{} -> String
"UpdateWhereCount{..}" forall a. [a] -> [a] -> [a]
++ String
record
    ParseMigration{} -> String
"ParseMigration{..}" forall a. [a] -> [a] -> [a]
++ String
record
    ParseMigration'{} -> String
"ParseMigration'{..}" forall a. [a] -> [a] -> [a]
++ String
record
    PrintMigration{} -> String
"PrintMigration{..}" forall a. [a] -> [a] -> [a]
++ String
record
    ShowMigration{} -> String
"ShowMigration{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetMigration{} -> String
"GetMigration{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RunMigration{} -> String
"RunMigration{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RunMigrationQuiet{} -> String
"RunMigrationQuiet{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RunMigrationSilent{} -> String
"RunMigrationSilent{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RunMigrationUnsafe{} -> String
"RunMigrationUnsafe{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RunMigrationUnsafeQuiet{} -> String
"RunMigrationUnsafeQuiet{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetFieldName{} -> String
"GetFieldName{..}" forall a. [a] -> [a] -> [a]
++ String
record
    GetTableName{} -> String
"GetTableName{..}" forall a. [a] -> [a] -> [a]
++ String
record
    WithRawQuery{} -> String
"WithRawQuery{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RawQueryRes{} -> String
"RawQueryRes{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RawExecute{} -> String
"RawExecute{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RawExecuteCount{} -> String
"RawExecuteCount{..}" forall a. [a] -> [a] -> [a]
++ String
record
    RawSql{} -> String
"RawSql{..}" forall a. [a] -> [a] -> [a]
++ String
record
    TransactionSave{} -> String
"TransactionSave{..}" forall a. [a] -> [a] -> [a]
++ String
record
    TransactionSaveWithIsolation{} -> String
"TransactionSaveWithIsolation{..}" forall a. [a] -> [a] -> [a]
++ String
record
    TransactionUndo{} -> String
"TransactionUndo{..}" forall a. [a] -> [a] -> [a]
++ String
record
    TransactionUndoWithIsolation{} -> String
"TransactionUndoWithIsolation{..}" forall a. [a] -> [a] -> [a]
++ String
record
    UnsafeLiftSql Text
label forall (m :: * -> *). MonadIO m => SqlPersistT m a
_ -> String
"UnsafeLiftSql{" forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
label forall a. [a] -> [a] -> [a]
++ String
"}"
    where
      record :: String
record = case Maybe TypeRep
recordTypeRep of
        Just TypeRep
recordType -> String
"<" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TypeRep
recordType forall a. [a] -> [a] -> [a]
++ String
">"
        Maybe TypeRep
Nothing -> String
""
      recordTypeRep :: Maybe TypeRep
recordTypeRep = case forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT @record @Void of
        Just record :~: Void
Refl -> forall a. Maybe a
Nothing
        Maybe (record :~: Void)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) record a.
MonadUnliftIO m =>
SqlQueryRep record a -> SqlPersistT m a
runSqlQueryRep = \case
  Get Key record
a1 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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 -> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
Persist.insert record
a1
  Insert_ record
a1 -> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
Persist.insert_ record
a1
  InsertMany [record]
a1 -> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m [Key record]
Persist.insertMany [record]
a1
  InsertMany_ [record]
a1 -> forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
Persist.insertMany_ [record]
a1
  InsertEntityMany [Entity record]
a1 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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 -> forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 SafeToInsert e, MonadIO m, HasCallStack) =>
e -> ReaderT backend m (Entity e)
Persist.insertEntity record
a1
  InsertRecord record
a1 -> forall record backend (m :: * -> *).
(PersistEntityBackend record ~ BaseBackend backend,
 PersistEntity record, MonadIO m, PersistStoreWrite backend,
 SafeToInsert record, HasCallStack) =>
record -> ReaderT backend m record
Persist.insertRecord record
a1
  GetBy Unique record
a1 -> forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
Persist.getBy Unique record
a1
  GetByValue record
a1 -> forall record (m :: * -> *) backend.
(MonadIO m, PersistUniqueRead backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record) =>
record -> ReaderT backend m (Maybe (Entity record))
Persist.getByValue record
a1
  CheckUnique record
a1 -> forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
Persist.checkUnique record
a1
  CheckUniqueUpdateable Entity record
a1 -> forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
Entity record -> ReaderT backend m (Maybe (Unique record))
Persist.checkUniqueUpdateable Entity record
a1
  DeleteBy Unique record
a1 -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m ()
Persist.deleteBy Unique record
a1
  InsertUnique record
a1 -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Maybe (Key record))
Persist.insertUnique record
a1
  Upsert record
a1 [Update record]
a2 -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
Persist.upsert record
a1 [Update record]
a2
  UpsertBy Unique record
a1 record
a2 [Update record]
a3 -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
Persist.upsertBy Unique record
a1 record
a2 [Update record]
a3
  PutMany [record]
a1 -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
Persist.putMany [record]
a1
  InsertBy record
a1 -> forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, AtLeastOneUniqueKey record,
 SafeToInsert record) =>
record -> ReaderT backend m (Either (Entity record) (Key record))
Persist.insertBy record
a1
  InsertUniqueEntity record
a1 -> forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueWrite backend, SafeToInsert record) =>
record -> ReaderT backend m (Maybe (Entity record))
Persist.insertUniqueEntity record
a1
  ReplaceUnique Key record
a1 record
a2 -> 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
  OnlyUnique record
a1 -> forall record backend (m :: * -> *).
(MonadIO m, PersistUniqueWrite backend,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> ReaderT backend m (Unique record)
Persist.onlyUnique record
a1
  SelectSourceRes [Filter record]
a1 [SelectOpt record]
a2 -> 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 -> 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 -> 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 -> forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
Persist.count [Filter record]
a1
  Exists [Filter record]
a1 -> forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Bool
Persist.exists [Filter record]
a1
  SelectList [Filter record]
a1 [SelectOpt record]
a2 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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
  ParseMigration Migration
a1 -> forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m (Either [Text] CautiousMigration)
Persist.parseMigration Migration
a1
  ParseMigration' Migration
a1 -> forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m CautiousMigration
Persist.parseMigration' Migration
a1
  PrintMigration Migration
a1 -> forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m ()
Persist.printMigration Migration
a1
  ShowMigration Migration
a1 -> forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Text]
Persist.showMigration Migration
a1
  GetMigration Migration
a1 -> forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
Persist.getMigration Migration
a1
  RunMigration Migration
a1 -> forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
Persist.runMigration Migration
a1
  RunMigrationQuiet Migration
a1 -> forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m [Text]
Persist.runMigrationQuiet Migration
a1
  RunMigrationSilent Migration
a1 -> forall (m :: * -> *).
MonadUnliftIO m =>
Migration -> ReaderT SqlBackend m [Text]
Persist.runMigrationSilent Migration
a1
  RunMigrationUnsafe Migration
a1 -> forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
Persist.runMigrationUnsafe Migration
a1
  RunMigrationUnsafeQuiet Migration
a1 -> forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Migration -> ReaderT SqlBackend m [Text]
Persist.runMigrationUnsafeQuiet Migration
a1
  GetFieldName EntityField record typ
a1 -> 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 -> 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 -> 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 -> 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 -> forall (m :: * -> *) backend.
(MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m ()
Persist.rawExecute Text
a1 [PersistValue]
a2
  RawExecuteCount Text
a1 [PersistValue]
a2 -> 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 -> 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 -> forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
Persist.transactionSave
  TransactionSaveWithIsolation IsolationLevel
a1 -> forall (m :: * -> *).
MonadIO m =>
IsolationLevel -> ReaderT SqlBackend m ()
Persist.transactionSaveWithIsolation IsolationLevel
a1
  SqlQueryRep record a
TransactionUndo -> forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
Persist.transactionUndo
  TransactionUndoWithIsolation IsolationLevel
a1 -> forall (m :: * -> *).
MonadIO m =>
IsolationLevel -> ReaderT SqlBackend m ()
Persist.transactionUndoWithIsolation IsolationLevel
a1
  UnsafeLiftSql Text
_ forall (m :: * -> *). MonadIO m => SqlPersistT m a
action -> forall (m :: * -> *). MonadIO m => SqlPersistT m a
action