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

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}

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

Defines all the @persistent@ functions lifted into 'MonadSqlQuery'.

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

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (MonadResource)
import Data.Acquire (Acquire, allocateAcquire)
import Data.Conduit (ConduitM)
import Data.Int (Int64)
import Data.Map (Map)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Data.Void (Void)
import Database.Persist.Sql hiding (pattern Update)
import GHC.Stack (HasCallStack)

import Database.Persist.Monad.Class (MonadSqlQuery (..))
import Database.Persist.Monad.SqlQueryRep (SqlQueryRep (..))

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

-- | The lifted version of 'Database.Persist.Sql.get'
get ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  m (Maybe record)
get :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> m (Maybe record)
get Key record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> SqlQueryRep record (Maybe record)
Get Key record
a1

-- | The lifted version of 'Database.Persist.Sql.getMany'
getMany ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Key record] ->
  m (Map (Key record) record)
getMany :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Key record] -> m (Map (Key record) record)
getMany [Key record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Key record] -> SqlQueryRep record (Map (Key record) record)
GetMany [Key record]
a1

-- | The lifted version of 'Database.Persist.Sql.getJust'
getJust ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  m record
getJust :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> m record
getJust Key record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> SqlQueryRep record record
GetJust Key record
a1

-- | The lifted version of 'Database.Persist.Sql.getJustEntity'
getJustEntity ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  m (Entity record)
getJustEntity :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> m (Entity record)
getJustEntity Key record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> SqlQueryRep record (Entity record)
GetJustEntity Key record
a1

-- | The lifted version of 'Database.Persist.Sql.getEntity'
getEntity ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  m (Maybe (Entity record))
getEntity :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> m (Maybe (Entity record))
getEntity Key record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> SqlQueryRep record (Maybe (Entity record))
GetEntity Key record
a1

-- | The lifted version of 'Database.Persist.Sql.belongsTo'
belongsTo ::
  (PersistEntity record1, PersistRecordBackend record2 SqlBackend, Typeable record1, Typeable record2, MonadSqlQuery m) =>
  (record1 -> Maybe (Key record2)) ->
  record1 ->
  m (Maybe record2)
belongsTo :: forall record1 record2 (m :: * -> *).
(PersistEntity record1, PersistRecordBackend record2 SqlBackend,
 Typeable record1, Typeable record2, MonadSqlQuery m) =>
(record1 -> Maybe (Key record2)) -> record1 -> m (Maybe record2)
belongsTo record1 -> Maybe (Key record2)
a1 record1
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall a record2.
(PersistEntity a, PersistRecordBackend record2 SqlBackend) =>
(a -> Maybe (Key record2))
-> a -> SqlQueryRep (a, record2) (Maybe record2)
BelongsTo record1 -> Maybe (Key record2)
a1 record1
a2

-- | The lifted version of 'Database.Persist.Sql.belongsToJust'
belongsToJust ::
  (PersistEntity record1, PersistRecordBackend record2 SqlBackend, Typeable record1, Typeable record2, MonadSqlQuery m) =>
  (record1 -> Key record2) ->
  record1 ->
  m record2
belongsToJust :: forall record1 record2 (m :: * -> *).
(PersistEntity record1, PersistRecordBackend record2 SqlBackend,
 Typeable record1, Typeable record2, MonadSqlQuery m) =>
(record1 -> Key record2) -> record1 -> m record2
belongsToJust record1 -> Key record2
a1 record1
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall a record2.
(PersistEntity a, PersistRecordBackend record2 SqlBackend) =>
(a -> Key record2) -> a -> SqlQueryRep (a, record2) record2
BelongsToJust record1 -> Key record2
a1 record1
a2

-- | The lifted version of 'Database.Persist.Sql.insert'
insert ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Key record)
insert :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
record -> m (Key record)
insert record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
record -> SqlQueryRep record (Key record)
Insert record
a1

-- | The lifted version of 'Database.Persist.Sql.insert_'
insert_ ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m ()
insert_ :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
record -> m ()
insert_ record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
record -> SqlQueryRep record ()
Insert_ record
a1

-- | The lifted version of 'Database.Persist.Sql.insertMany'
insertMany ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  [record] ->
  m [Key record]
insertMany :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
[record] -> m [Key record]
insertMany [record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
[record] -> SqlQueryRep record [Key record]
InsertMany [record]
a1

-- | The lifted version of 'Database.Persist.Sql.insertMany_'
insertMany_ ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  [record] ->
  m ()
insertMany_ :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
[record] -> m ()
insertMany_ [record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
[record] -> SqlQueryRep record ()
InsertMany_ [record]
a1

-- | The lifted version of 'Database.Persist.Sql.insertEntityMany'
insertEntityMany ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Entity record] ->
  m ()
insertEntityMany :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Entity record] -> m ()
insertEntityMany [Entity record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Entity record] -> SqlQueryRep record ()
InsertEntityMany [Entity record]
a1

-- | The lifted version of 'Database.Persist.Sql.insertKey'
insertKey ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  record ->
  m ()
insertKey :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> record -> m ()
insertKey Key record
a1 record
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> record -> SqlQueryRep record ()
InsertKey Key record
a1 record
a2

-- | The lifted version of 'Database.Persist.Sql.repsert'
repsert ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  record ->
  m ()
repsert :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> record -> m ()
repsert Key record
a1 record
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> record -> SqlQueryRep record ()
Repsert Key record
a1 record
a2

-- | The lifted version of 'Database.Persist.Sql.repsertMany'
repsertMany ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [(Key record, record)] ->
  m ()
repsertMany :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[(Key record, record)] -> m ()
repsertMany [(Key record, record)]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[(Key record, record)] -> SqlQueryRep record ()
RepsertMany [(Key record, record)]
a1

-- | The lifted version of 'Database.Persist.Sql.replace'
replace ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  record ->
  m ()
replace :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> record -> m ()
replace Key record
a1 record
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> record -> SqlQueryRep record ()
Replace Key record
a1 record
a2

-- | The lifted version of 'Database.Persist.Sql.delete'
delete ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  m ()
delete :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> m ()
delete Key record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> SqlQueryRep record ()
Delete Key record
a1

-- | The lifted version of 'Database.Persist.Sql.update'
update ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  [Update record] ->
  m ()
update :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> [Update record] -> m ()
update Key record
a1 [Update record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> [Update record] -> SqlQueryRep record ()
Update Key record
a1 [Update record]
a2

-- | The lifted version of 'Database.Persist.Sql.updateGet'
updateGet ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Key record ->
  [Update record] ->
  m record
updateGet :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Key record -> [Update record] -> m record
updateGet Key record
a1 [Update record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Key record -> [Update record] -> SqlQueryRep record record
UpdateGet Key record
a1 [Update record]
a2

-- | The lifted version of 'Database.Persist.Sql.insertEntity'
insertEntity ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Entity record)
insertEntity :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
record -> m (Entity record)
insertEntity record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
record -> SqlQueryRep record (Entity record)
InsertEntity record
a1

-- | The lifted version of 'Database.Persist.Sql.insertRecord'
insertRecord ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m record
insertRecord :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
record -> m record
insertRecord record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
record -> SqlQueryRep record record
InsertRecord record
a1

-- | The lifted version of 'Database.Persist.Sql.getBy'
getBy ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Unique record ->
  m (Maybe (Entity record))
getBy :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Unique record -> m (Maybe (Entity record))
getBy Unique record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Unique record -> SqlQueryRep record (Maybe (Entity record))
GetBy Unique record
a1

-- | The lifted version of 'Database.Persist.Sql.getByValue'
getByValue ::
  (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Maybe (Entity record))
getByValue :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend,
 AtLeastOneUniqueKey record, Typeable record, MonadSqlQuery m) =>
record -> m (Maybe (Entity record))
getByValue record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend,
 AtLeastOneUniqueKey record) =>
record -> SqlQueryRep record (Maybe (Entity record))
GetByValue record
a1

-- | The lifted version of 'Database.Persist.Sql.checkUnique'
checkUnique ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Maybe (Unique record))
checkUnique :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
record -> m (Maybe (Unique record))
checkUnique record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
record -> SqlQueryRep record (Maybe (Unique record))
CheckUnique record
a1

-- | The lifted version of 'Database.Persist.Sql.checkUniqueUpdateable'
checkUniqueUpdateable ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Entity record ->
  m (Maybe (Unique record))
checkUniqueUpdateable :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Entity record -> m (Maybe (Unique record))
checkUniqueUpdateable Entity record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Entity record -> SqlQueryRep record (Maybe (Unique record))
CheckUniqueUpdateable Entity record
a1

-- | The lifted version of 'Database.Persist.Sql.deleteBy'
deleteBy ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  Unique record ->
  m ()
deleteBy :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
Unique record -> m ()
deleteBy Unique record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
Unique record -> SqlQueryRep record ()
DeleteBy Unique record
a1

-- | The lifted version of 'Database.Persist.Sql.insertUnique'
insertUnique ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Maybe (Key record))
insertUnique :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
record -> m (Maybe (Key record))
insertUnique record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
record -> SqlQueryRep record (Maybe (Key record))
InsertUnique record
a1

-- | The lifted version of 'Database.Persist.Sql.upsert'
upsert ::
  (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  [Update record] ->
  m (Entity record)
upsert :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record,
 SafeToInsert record, Typeable record, MonadSqlQuery m) =>
record -> [Update record] -> m (Entity record)
upsert record
a1 [Update record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> SqlQueryRep record (Entity record)
Upsert record
a1 [Update record]
a2

-- | The lifted version of 'Database.Persist.Sql.upsertBy'
upsertBy ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  Unique record ->
  record ->
  [Update record] ->
  m (Entity record)
upsertBy :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
Unique record -> record -> [Update record] -> m (Entity record)
upsertBy Unique record
a1 record
a2 [Update record]
a3 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
Unique record
-> record -> [Update record] -> SqlQueryRep record (Entity record)
UpsertBy Unique record
a1 record
a2 [Update record]
a3

-- | The lifted version of 'Database.Persist.Sql.putMany'
putMany ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  [record] ->
  m ()
putMany :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
[record] -> m ()
putMany [record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
[record] -> SqlQueryRep record ()
PutMany [record]
a1

-- | The lifted version of 'Database.Persist.Sql.insertBy'
insertBy ::
  (PersistRecordBackend record SqlBackend, AtLeastOneUniqueKey record, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Either (Entity record) (Key record))
insertBy :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend,
 AtLeastOneUniqueKey record, SafeToInsert record, Typeable record,
 MonadSqlQuery m) =>
record -> m (Either (Entity record) (Key record))
insertBy record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend,
 AtLeastOneUniqueKey record, SafeToInsert record) =>
record -> SqlQueryRep record (Either (Entity record) (Key record))
InsertBy record
a1

-- | The lifted version of 'Database.Persist.Sql.insertUniqueEntity'
insertUniqueEntity ::
  (PersistRecordBackend record SqlBackend, SafeToInsert record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Maybe (Entity record))
insertUniqueEntity :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, SafeToInsert record,
 Typeable record, MonadSqlQuery m) =>
record -> m (Maybe (Entity record))
insertUniqueEntity record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, SafeToInsert record) =>
record -> SqlQueryRep record (Maybe (Entity record))
InsertUniqueEntity record
a1

-- | The lifted version of 'Database.Persist.Sql.replaceUnique'
replaceUnique ::
  (PersistRecordBackend record SqlBackend, Eq (Unique record), Eq record, Typeable record, MonadSqlQuery m) =>
  Key record ->
  record ->
  m (Maybe (Unique record))
replaceUnique :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Eq (Unique record),
 Eq record, Typeable record, MonadSqlQuery m) =>
Key record -> record -> m (Maybe (Unique record))
replaceUnique Key record
a1 record
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend, Eq (Unique record),
 Eq record) =>
Key record -> record -> SqlQueryRep record (Maybe (Unique record))
ReplaceUnique Key record
a1 record
a2

-- | The lifted version of 'Database.Persist.Sql.onlyUnique'
onlyUnique ::
  (PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record, Typeable record, MonadSqlQuery m) =>
  record ->
  m (Unique record)
onlyUnique :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, OnlyOneUniqueKey record,
 Typeable record, MonadSqlQuery m) =>
record -> m (Unique record)
onlyUnique record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
(PersistRecordBackend record SqlBackend,
 OnlyOneUniqueKey record) =>
record -> SqlQueryRep record (Unique record)
OnlyUnique record
a1

-- | The lifted version of 'Database.Persist.Sql.selectSourceRes'
selectSourceRes ::
  (MonadIO m2, PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  m (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes :: forall (m2 :: * -> *) record (m :: * -> *).
(MonadIO m2, PersistRecordBackend record SqlBackend,
 Typeable record, MonadSqlQuery m) =>
[Filter record]
-> [SelectOpt record]
-> m (Acquire (ConduitM () (Entity record) m2 ()))
selectSourceRes [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) record.
(MonadIO a, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> SqlQueryRep record (Acquire (ConduitM () (Entity record) a ()))
SelectSourceRes [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.selectFirst'
selectFirst ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  m (Maybe (Entity record))
selectFirst :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> [SelectOpt record] -> m (Maybe (Entity record))
selectFirst [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record]
-> [SelectOpt record] -> SqlQueryRep record (Maybe (Entity record))
SelectFirst [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.selectKeysRes'
selectKeysRes ::
  (MonadIO m2, PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  m (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes :: forall (m2 :: * -> *) record (m :: * -> *).
(MonadIO m2, PersistRecordBackend record SqlBackend,
 Typeable record, MonadSqlQuery m) =>
[Filter record]
-> [SelectOpt record]
-> m (Acquire (ConduitM () (Key record) m2 ()))
selectKeysRes [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) record.
(MonadIO a, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> SqlQueryRep record (Acquire (ConduitM () (Key record) a ()))
SelectKeysRes [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.count'
count ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  m Int
count :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> m Int
count [Filter record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record] -> SqlQueryRep record Int
Count [Filter record]
a1

-- | The lifted version of 'Database.Persist.Sql.exists'
exists ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  m Bool
exists :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> m Bool
exists [Filter record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record] -> SqlQueryRep record Bool
Exists [Filter record]
a1

-- | The lifted version of 'Database.Persist.Sql.selectSource'
selectSource ::
  (PersistRecordBackend record SqlBackend, MonadResource m, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  ConduitM () (Entity record) m ()
selectSource :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, MonadResource m,
 Typeable record, MonadSqlQuery m) =>
[Filter record]
-> [SelectOpt record] -> ConduitM () (Entity record) m ()
selectSource [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) i o a.
MonadResource m =>
m (Acquire (ConduitM i o m a)) -> ConduitM i o m a
fromAcquire forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) record.
(MonadIO a, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> SqlQueryRep record (Acquire (ConduitM () (Entity record) a ()))
SelectSourceRes [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.selectKeys'
selectKeys ::
  (PersistRecordBackend record SqlBackend, MonadResource m, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  ConduitM () (Key record) m ()
selectKeys :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, MonadResource m,
 Typeable record, MonadSqlQuery m) =>
[Filter record]
-> [SelectOpt record] -> ConduitM () (Key record) m ()
selectKeys [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) i o a.
MonadResource m =>
m (Acquire (ConduitM i o m a)) -> ConduitM i o m a
fromAcquire forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) record.
(MonadIO a, PersistRecordBackend record SqlBackend) =>
[Filter record]
-> [SelectOpt record]
-> SqlQueryRep record (Acquire (ConduitM () (Key record) a ()))
SelectKeysRes [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.selectList'
selectList ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  m [Entity record]
selectList :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> [SelectOpt record] -> m [Entity record]
selectList [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record]
-> [SelectOpt record] -> SqlQueryRep record [Entity record]
SelectList [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.selectKeysList'
selectKeysList ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [SelectOpt record] ->
  m [Key record]
selectKeysList :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> [SelectOpt record] -> m [Key record]
selectKeysList [Filter record]
a1 [SelectOpt record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record]
-> [SelectOpt record] -> SqlQueryRep record [Key record]
SelectKeysList [Filter record]
a1 [SelectOpt record]
a2

-- | The lifted version of 'Database.Persist.Sql.updateWhere'
updateWhere ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [Update record] ->
  m ()
updateWhere :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> [Update record] -> m ()
updateWhere [Filter record]
a1 [Update record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record] -> [Update record] -> SqlQueryRep record ()
UpdateWhere [Filter record]
a1 [Update record]
a2

-- | The lifted version of 'Database.Persist.Sql.deleteWhere'
deleteWhere ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  m ()
deleteWhere :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> m ()
deleteWhere [Filter record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record] -> SqlQueryRep record ()
DeleteWhere [Filter record]
a1

-- | The lifted version of 'Database.Persist.Sql.deleteWhereCount'
deleteWhereCount ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  m Int64
deleteWhereCount :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> m Int64
deleteWhereCount [Filter record]
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record] -> SqlQueryRep record Int64
DeleteWhereCount [Filter record]
a1

-- | The lifted version of 'Database.Persist.Sql.updateWhereCount'
updateWhereCount ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  [Filter record] ->
  [Update record] ->
  m Int64
updateWhereCount :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
[Filter record] -> [Update record] -> m Int64
updateWhereCount [Filter record]
a1 [Update record]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
[Filter record] -> [Update record] -> SqlQueryRep record Int64
UpdateWhereCount [Filter record]
a1 [Update record]
a2

-- | The lifted version of 'Database.Persist.Sql.parseMigration'
parseMigration ::
  (HasCallStack, MonadSqlQuery m) =>
  Migration ->
  m (Either [Text] CautiousMigration)
parseMigration :: forall (m :: * -> *).
(HasCallStack, MonadSqlQuery m) =>
Migration -> m (Either [Text] CautiousMigration)
parseMigration Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ HasCallStack =>
Migration -> SqlQueryRep Void (Either [Text] CautiousMigration)
ParseMigration Migration
a1

-- | The lifted version of 'Database.Persist.Sql.parseMigration''
parseMigration' ::
  (HasCallStack, MonadSqlQuery m) =>
  Migration ->
  m CautiousMigration
parseMigration' :: forall (m :: * -> *).
(HasCallStack, MonadSqlQuery m) =>
Migration -> m CautiousMigration
parseMigration' Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ HasCallStack => Migration -> SqlQueryRep Void CautiousMigration
ParseMigration' Migration
a1

-- | The lifted version of 'Database.Persist.Sql.printMigration'
printMigration ::
  (HasCallStack, MonadSqlQuery m) =>
  Migration ->
  m ()
printMigration :: forall (m :: * -> *).
(HasCallStack, MonadSqlQuery m) =>
Migration -> m ()
printMigration Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ HasCallStack => Migration -> SqlQueryRep Void ()
PrintMigration Migration
a1

-- | The lifted version of 'Database.Persist.Sql.showMigration'
showMigration ::
  (HasCallStack, MonadSqlQuery m) =>
  Migration ->
  m [Text]
showMigration :: forall (m :: * -> *).
(HasCallStack, MonadSqlQuery m) =>
Migration -> m [Text]
showMigration Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ HasCallStack => Migration -> SqlQueryRep Void [Text]
ShowMigration Migration
a1

-- | The lifted version of 'Database.Persist.Sql.getMigration'
getMigration ::
  (HasCallStack, MonadSqlQuery m) =>
  Migration ->
  m [Sql]
getMigration :: forall (m :: * -> *).
(HasCallStack, MonadSqlQuery m) =>
Migration -> m [Text]
getMigration Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ HasCallStack => Migration -> SqlQueryRep Void [Text]
GetMigration Migration
a1

-- | The lifted version of 'Database.Persist.Sql.runMigration'
runMigration ::
  (MonadSqlQuery m) =>
  Migration ->
  m ()
runMigration :: forall (m :: * -> *). MonadSqlQuery m => Migration -> m ()
runMigration Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ Migration -> SqlQueryRep Void ()
RunMigration Migration
a1

-- | The lifted version of 'Database.Persist.Sql.runMigrationQuiet'
runMigrationQuiet ::
  (MonadSqlQuery m) =>
  Migration ->
  m [Text]
runMigrationQuiet :: forall (m :: * -> *). MonadSqlQuery m => Migration -> m [Text]
runMigrationQuiet Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ Migration -> SqlQueryRep Void [Text]
RunMigrationQuiet Migration
a1

-- | The lifted version of 'Database.Persist.Sql.runMigrationSilent'
runMigrationSilent ::
  (MonadSqlQuery m) =>
  Migration ->
  m [Text]
runMigrationSilent :: forall (m :: * -> *). MonadSqlQuery m => Migration -> m [Text]
runMigrationSilent Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ Migration -> SqlQueryRep Void [Text]
RunMigrationSilent Migration
a1

-- | The lifted version of 'Database.Persist.Sql.runMigrationUnsafe'
runMigrationUnsafe ::
  (MonadSqlQuery m) =>
  Migration ->
  m ()
runMigrationUnsafe :: forall (m :: * -> *). MonadSqlQuery m => Migration -> m ()
runMigrationUnsafe Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ Migration -> SqlQueryRep Void ()
RunMigrationUnsafe Migration
a1

-- | The lifted version of 'Database.Persist.Sql.runMigrationUnsafeQuiet'
runMigrationUnsafeQuiet ::
  (HasCallStack, MonadSqlQuery m) =>
  Migration ->
  m [Text]
runMigrationUnsafeQuiet :: forall (m :: * -> *).
(HasCallStack, MonadSqlQuery m) =>
Migration -> m [Text]
runMigrationUnsafeQuiet Migration
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ HasCallStack => Migration -> SqlQueryRep Void [Text]
RunMigrationUnsafeQuiet Migration
a1

-- | The lifted version of 'Database.Persist.Sql.getFieldName'
getFieldName ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  EntityField record typ ->
  m Text
getFieldName :: forall record (m :: * -> *) typ.
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
EntityField record typ -> m Text
getFieldName EntityField record typ
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record a.
PersistRecordBackend record SqlBackend =>
EntityField record a -> SqlQueryRep record Text
GetFieldName EntityField record typ
a1

-- | The lifted version of 'Database.Persist.Sql.getTableName'
getTableName ::
  (PersistRecordBackend record SqlBackend, Typeable record, MonadSqlQuery m) =>
  record ->
  m Text
getTableName :: forall record (m :: * -> *).
(PersistRecordBackend record SqlBackend, Typeable record,
 MonadSqlQuery m) =>
record -> m Text
getTableName record
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall record.
PersistRecordBackend record SqlBackend =>
record -> SqlQueryRep record Text
GetTableName record
a1

-- | The lifted version of 'Database.Persist.Sql.withRawQuery'
withRawQuery ::
  (MonadSqlQuery m) =>
  Text ->
  [PersistValue] ->
  ConduitM [PersistValue] Void IO a ->
  m a
withRawQuery :: forall (m :: * -> *) a.
MonadSqlQuery m =>
Text -> [PersistValue] -> ConduitM [PersistValue] Void IO a -> m a
withRawQuery Text
a1 [PersistValue]
a2 ConduitM [PersistValue] Void IO a
a3 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall a.
Text
-> [PersistValue]
-> ConduitM [PersistValue] Void IO a
-> SqlQueryRep Void a
WithRawQuery Text
a1 [PersistValue]
a2 ConduitM [PersistValue] Void IO a
a3

-- | The lifted version of 'Database.Persist.Sql.rawQueryRes'
rawQueryRes ::
  (MonadIO m2, MonadSqlQuery m) =>
  Text ->
  [PersistValue] ->
  m (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes :: forall (m2 :: * -> *) (m :: * -> *).
(MonadIO m2, MonadSqlQuery m) =>
Text
-> [PersistValue] -> m (Acquire (ConduitM () [PersistValue] m2 ()))
rawQueryRes Text
a1 [PersistValue]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *).
MonadIO a =>
Text
-> [PersistValue]
-> SqlQueryRep Void (Acquire (ConduitM () [PersistValue] a ()))
RawQueryRes Text
a1 [PersistValue]
a2

-- | The lifted version of 'Database.Persist.Sql.rawQuery'
rawQuery ::
  (MonadResource m, MonadSqlQuery m) =>
  Text ->
  [PersistValue] ->
  ConduitM () [PersistValue] m ()
rawQuery :: forall (m :: * -> *).
(MonadResource m, MonadSqlQuery m) =>
Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
rawQuery Text
a1 [PersistValue]
a2 =
  forall (m :: * -> *) i o a.
MonadResource m =>
m (Acquire (ConduitM i o m a)) -> ConduitM i o m a
fromAcquire forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *).
MonadIO a =>
Text
-> [PersistValue]
-> SqlQueryRep Void (Acquire (ConduitM () [PersistValue] a ()))
RawQueryRes Text
a1 [PersistValue]
a2

-- | The lifted version of 'Database.Persist.Sql.rawExecute'
rawExecute ::
  (MonadSqlQuery m) =>
  Text ->
  [PersistValue] ->
  m ()
rawExecute :: forall (m :: * -> *).
MonadSqlQuery m =>
Text -> [PersistValue] -> m ()
rawExecute Text
a1 [PersistValue]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ Text -> [PersistValue] -> SqlQueryRep Void ()
RawExecute Text
a1 [PersistValue]
a2

-- | The lifted version of 'Database.Persist.Sql.rawExecuteCount'
rawExecuteCount ::
  (MonadSqlQuery m) =>
  Text ->
  [PersistValue] ->
  m Int64
rawExecuteCount :: forall (m :: * -> *).
MonadSqlQuery m =>
Text -> [PersistValue] -> m Int64
rawExecuteCount Text
a1 [PersistValue]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ Text -> [PersistValue] -> SqlQueryRep Void Int64
RawExecuteCount Text
a1 [PersistValue]
a2

-- | The lifted version of 'Database.Persist.Sql.rawSql'
rawSql ::
  (RawSql a, MonadSqlQuery m) =>
  Text ->
  [PersistValue] ->
  m [a]
rawSql :: forall a (m :: * -> *).
(RawSql a, MonadSqlQuery m) =>
Text -> [PersistValue] -> m [a]
rawSql Text
a1 [PersistValue]
a2 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall a.
RawSql a =>
Text -> [PersistValue] -> SqlQueryRep Void [a]
RawSql Text
a1 [PersistValue]
a2

-- | The lifted version of 'Database.Persist.Sql.transactionSave'
transactionSave ::
  (MonadSqlQuery m) =>
  m ()
transactionSave :: forall (m :: * -> *). MonadSqlQuery m => m ()
transactionSave =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ SqlQueryRep Void ()
TransactionSave

-- | The lifted version of 'Database.Persist.Sql.transactionSaveWithIsolation'
transactionSaveWithIsolation ::
  (MonadSqlQuery m) =>
  IsolationLevel ->
  m ()
transactionSaveWithIsolation :: forall (m :: * -> *). MonadSqlQuery m => IsolationLevel -> m ()
transactionSaveWithIsolation IsolationLevel
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ IsolationLevel -> SqlQueryRep Void ()
TransactionSaveWithIsolation IsolationLevel
a1

-- | The lifted version of 'Database.Persist.Sql.transactionUndo'
transactionUndo ::
  (MonadSqlQuery m) =>
  m ()
transactionUndo :: forall (m :: * -> *). MonadSqlQuery m => m ()
transactionUndo =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ SqlQueryRep Void ()
TransactionUndo

-- | The lifted version of 'Database.Persist.Sql.transactionUndoWithIsolation'
transactionUndoWithIsolation ::
  (MonadSqlQuery m) =>
  IsolationLevel ->
  m ()
transactionUndoWithIsolation :: forall (m :: * -> *). MonadSqlQuery m => IsolationLevel -> m ()
transactionUndoWithIsolation IsolationLevel
a1 =
  forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ IsolationLevel -> SqlQueryRep Void ()
TransactionUndoWithIsolation IsolationLevel
a1

-- | Lift an arbitrary 'SqlPersistT' action into 'MonadSqlQuery'.
--
-- This is unsafe because the action may be rerun. This function should
-- primarily be used to interop with other libraries built on top of
-- persistent.
--
-- Example usage:
--
-- @
-- -- | Run an esqueleto select.
-- select :: (MonadSqlQuery m, E.SqlSelect a r) => E.SqlQuery a -> m [r]
-- select q = unsafeLiftSql "esqueleto-select" (E.select q)
-- @
unsafeLiftSql :: MonadSqlQuery m => Text -> (forall m2. MonadIO m2 => SqlPersistT m2 a) -> m a
unsafeLiftSql :: forall (m :: * -> *) a.
MonadSqlQuery m =>
Text
-> (forall (m2 :: * -> *). MonadIO m2 => SqlPersistT m2 a) -> m a
unsafeLiftSql Text
label forall (m2 :: * -> *). MonadIO m2 => SqlPersistT m2 a
action = forall (m :: * -> *) record a.
(MonadSqlQuery m, Typeable record) =>
SqlQueryRep record a -> m a
runQueryRep forall a b. (a -> b) -> a -> b
$ forall a.
Text
-> (forall (m :: * -> *). MonadIO m => SqlPersistT m a)
-> SqlQueryRep Void a
UnsafeLiftSql Text
label forall (m2 :: * -> *). MonadIO m2 => SqlPersistT m2 a
action

{- Helpers -}

-- | A helper for functions that return a conduit.
fromAcquire :: MonadResource m => m (Acquire (ConduitM i o m a)) -> ConduitM i o m a
fromAcquire :: forall (m :: * -> *) i o a.
MonadResource m =>
m (Acquire (ConduitM i o m a)) -> ConduitM i o m a
fromAcquire m (Acquire (ConduitM i o m a))
getAcquire = do
  (ReleaseKey
_, ConduitM i o m a
conduit) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ m (Acquire (ConduitM i o m a))
getAcquire forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
MonadResource m =>
Acquire a -> m (ReleaseKey, a)
allocateAcquire
  ConduitM i o m a
conduit