{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
-- Required for Projection'
{-# LANGUAGE UndecidableInstances #-}
-- Required for Projection'
{-# LANGUAGE UndecidableSuperClasses #-}

-- | This module defines the functions and datatypes used throughout the framework.
-- Most of them are for the internal use
module Database.Groundhog.Core
  ( -- * Main types
    PersistEntity (..),
    PersistValue (..),
    PersistField (..),
    SinglePersistField (..),
    PurePersistField (..),
    PrimitivePersistField (..),
    Embedded (..),
    Projection (..),
    Projection',
    RestrictionHolder,
    Unique,
    KeyForBackend (..),
    BackendSpecific,
    ConstructorMarker,
    UniqueMarker,
    HFalse,
    HTrue,
    ZT (..), -- ZonedTime wrapper
    Utf8 (..),
    fromUtf8,
    delim,

    -- * Constructing expressions
    Cond (..),
    ExprRelation (..),
    Update (..),
    (~>),
    FieldLike (..),
    Assignable,
    SubField (..),
    AutoKeyField (..),
    FieldChain,
    NeverNull,
    UntypedExpr (..),
    Expr (..),
    Order (..),
    HasSelectOptions (..),
    SelectOptions (..),
    limitTo,
    offsetBy,
    orderBy,
    distinct,

    -- * Type description
    -- $types
    DbTypePrimitive' (..),
    DbTypePrimitive,
    DbType (..),
    EntityDef' (..),
    EntityDef,
    EmbeddedDef' (..),
    EmbeddedDef,
    OtherTypeDef' (..),
    OtherTypeDef,
    ConstructorDef' (..),
    ConstructorDef,
    Constructor (..),
    EntityConstr (..),
    IsUniqueKey (..),
    UniqueDef' (..),
    UniqueDef,
    UniqueType (..),
    ReferenceActionType (..),
    ParentTableReference,

    -- * Migration
    SingleMigration,
    NamedMigrations,
    Migration,

    -- * Database
    PersistBackend (..),
    PersistBackendConn (..),
    Action,
    TryAction,
    RowStream,
    DbDescriptor (..),

    -- * Connections and transactions
    ExtractConnection (..),
    ConnectionManager (..),
    TryConnectionManager (..),
    Savepoint (..),
    withSavepoint,
    runDb,
    runDbConn,
    runTryDbConn,
    runTryDbConn',
    runDb',
    runDbConn',
  )
where

import Control.Exception.Safe (Exception, MonadCatch, SomeException (..), tryAny)
import Control.Monad.Fail (MonadFail)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Monad.Trans.Reader (ReaderT (..), runReaderT)
import Control.Monad.Trans.State (StateT (..))
import Data.Acquire (Acquire)
import Data.ByteString.Char8 (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Int (Int64)
import Data.Kind (Constraint, Type)
import Data.Map (Map)
import Data.Semigroup (Semigroup)
import Data.String (IsString)
import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Data.Time (Day, TimeOfDay, UTCTime)
import Data.Time.LocalTime (ZonedTime, zonedTimeToLocalTime, zonedTimeToUTC, zonedTimeZone)

-- | Only instances of this class can be persisted in a database
class (PurePersistField (AutoKey v), PurePersistField (DefaultKey v)) => PersistEntity v where
  -- | This type is used for typesafe manipulation of separate fields of datatype v.
  -- Each constructor in 'Field' corresponds to its field in a datatype v.
  -- It is parametrised by constructor phantom type and field value type.
  data Field v :: ((Type -> Type) -> Type) -> Type -> Type

  -- | A unique identifier of a value stored in a database. This may be a primary key, a constraint or unique indices. The second parameter is the key description.
  data Key v :: Type -> Type

  -- | This type is the default autoincremented key for the entity. If entity does not have such key, AutoKey v = ().
  type AutoKey v

  -- | This type is the default key for the entity.
  type DefaultKey v

  -- | It is HFalse for entity with one constructor and HTrue for sum types.
  type IsSumType v

  -- | Returns a complete description of the type
  entityDef :: DbDescriptor db => proxy db -> v -> EntityDef

  -- | Marshalls value to a list of 'PersistValue' ready for insert to a database
  toEntityPersistValues :: PersistBackend m => v -> m ([PersistValue] -> [PersistValue])

  -- | Constructs the value from the list of 'PersistValue'
  fromEntityPersistValues :: PersistBackend m => [PersistValue] -> m (v, [PersistValue])

  -- | Returns constructor number and a list of uniques names and corresponding field values
  getUniques :: v -> (Int, [(String, [PersistValue] -> [PersistValue])])

  -- | Is internally used by FieldLike Field instance
  -- We could avoid this function if class FieldLike allowed FieldLike Fields Data or FieldLike (Fields Data). However that would require additional extensions in user-space code
  entityFieldChain :: DbDescriptor db => proxy db -> Field v c a -> FieldChain

-- | A holder for Unique constraints
data Unique (u :: (Type -> Type) -> Type)

-- | Key marked with this type can have value for any backend
data BackendSpecific

-- | A phantom datatype to make instance head different @c (ConstructorMarker v)@
data ConstructorMarker v a

-- | A phantom datatype to make instance head different @u (UniqueMarker v)@
data UniqueMarker v a

-- | It allows to store autogenerated keys of one database in another if they have different datatype.
data KeyForBackend db v = (DbDescriptor db, PersistEntity v) => KeyForBackend (AutoKeyType db)

data HFalse

data HTrue

-- | Represents condition for a query.
data Cond db r
  = And (Cond db r) (Cond db r)
  | Or (Cond db r) (Cond db r)
  | Not (Cond db r)
  | Compare ExprRelation (UntypedExpr db r) (UntypedExpr db r)
  | CondRaw (QueryRaw db r)
  | CondEmpty

data ExprRelation = Eq | Ne | Gt | Lt | Ge | Le deriving (Int -> ExprRelation -> ShowS
[ExprRelation] -> ShowS
ExprRelation -> String
(Int -> ExprRelation -> ShowS)
-> (ExprRelation -> String)
-> ([ExprRelation] -> ShowS)
-> Show ExprRelation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExprRelation] -> ShowS
$cshowList :: [ExprRelation] -> ShowS
show :: ExprRelation -> String
$cshow :: ExprRelation -> String
showsPrec :: Int -> ExprRelation -> ShowS
$cshowsPrec :: Int -> ExprRelation -> ShowS
Show)

data Update db r = forall f a. (Assignable f a, Projection' f db r a) => Update f (UntypedExpr db r)

-- | Defines sort order of a result-set
data Order db r
  = forall a f. (Projection' f db r a) => Asc f
  | forall a f. (Projection' f db r a) => Desc f

-- | It is used to map field to column names. It can be either a column name for a regular field of non-embedded type or a list of this field and the outer fields in reverse order. Eg, fieldChain $ SomeField ~> Tuple2_0Selector may result in [(\"val0\", DbString), (\"some\", DbEmbedded False [dbType \"\", dbType True])].
type FieldChain = ((String, DbType), [(String, EmbeddedDef)])

-- | Any data that can be fetched from a database
class Projection p a | p -> a where
  type ProjectionDb p db :: Constraint
  type ProjectionRestriction p r :: Constraint

  -- | It returns multiple expressions that can be transformed into values which can be selected. Difflist is used for concatenation efficiency.
  projectionExprs :: (DbDescriptor db, ProjectionDb p db, ProjectionRestriction p r) => p -> [UntypedExpr db r] -> [UntypedExpr db r]

  -- | It is like 'fromPersistValues'. However, we cannot use it for projections in all cases. For the 'PersistEntity' instances 'fromPersistValues' expects entity id instead of the entity values.
  projectionResult :: PersistBackend m => p -> [PersistValue] -> m (a, [PersistValue])

class (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => Projection' p db r a

instance (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => Projection' p db r a

-- | This subset of Projection instances is for things that behave like fields. Namely, they can occur in condition expressions (for example, Field and SubField) and on the left side of update statements. For example \"lower(field)\" is a valid Projection, but not Field like because it cannot be on the left side. Datatypes that index PostgreSQL arrays \"arr[5]\" or access composites \"(comp).subfield\" are valid instances of Assignable.
class Projection f a => Assignable f a | f -> a

-- | This subset of Assignable is for plain database fields.
class Assignable f a => FieldLike f a | f -> a where
  fieldChain :: (DbDescriptor db, ProjectionDb f db) => proxy db -> f -> FieldChain

class PersistField v => Embedded v where
  data Selector v :: Type -> Type
  selectorNum :: Selector v a -> Int

infixl 5 ~>

-- | Accesses fields of the embedded datatypes. For example, @SomeField ==. (\"abc\", \"def\") ||. SomeField ~> Tuple2_0Selector ==. \"def\"@
(~>) :: (EntityConstr v c, FieldLike f a, DbDescriptor db, Projection' f db (RestrictionHolder v c) a, Embedded a) => f -> Selector a a' -> SubField db v c a'
f
field ~> :: f -> Selector a a' -> SubField db v c a'
~> Selector a a'
sel = SubField db v c a'
subField
  where
    subField :: SubField db v c a'
subField = case Any db -> f -> FieldChain
forall f a db (proxy :: * -> *).
(FieldLike f a, DbDescriptor db, ProjectionDb f db) =>
proxy db -> f -> FieldChain
fieldChain Any db
db f
field of
      ((String
name, DbType
typ), [(String, EmbeddedDef)]
prefix) -> case DbType
typ of
        DbEmbedded emb :: EmbeddedDef
emb@(EmbeddedDef Bool
_ [(String, DbType)]
ts) Maybe ParentTableReference
_ -> FieldChain -> SubField db v c a'
forall db v (c :: (* -> *) -> *) a. FieldChain -> SubField db v c a
SubField ([(String, DbType)]
ts [(String, DbType)] -> Int -> (String, DbType)
forall a. [a] -> Int -> a
!! Selector a a' -> Int
forall v a. Embedded v => Selector v a -> Int
selectorNum Selector a a'
sel, (String
name, EmbeddedDef
emb) (String, EmbeddedDef)
-> [(String, EmbeddedDef)] -> [(String, EmbeddedDef)]
forall a. a -> [a] -> [a]
: [(String, EmbeddedDef)]
prefix)
        DbType
other -> String -> SubField db v c a'
forall a. HasCallStack => String -> a
error (String -> SubField db v c a') -> String -> SubField db v c a'
forall a b. (a -> b) -> a -> b
$ String
"(~>): cannot get subfield of non-embedded type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DbType -> String
forall a. Show a => a -> String
show DbType
other
    db :: Any db
db = (forall db v (c :: (* -> *) -> *) a' (proxy :: * -> *).
SubField db v c a' -> proxy db
forall a. HasCallStack => a
undefined :: SubField db v c a' -> proxy db) SubField db v c a'
subField

newtype SubField db v (c :: (Type -> Type) -> Type) a = SubField FieldChain

-- | It can be used in expressions like a regular field.
-- For example, @delete (AutoKeyField ==. k)@
-- or @delete (AutoKeyField ==. k ||. SomeField ==. \"DUPLICATE\")@
data AutoKeyField v (c :: (Type -> Type) -> Type) where
  AutoKeyField :: AutoKeyField v c

data RestrictionHolder v (c :: (Type -> Type) -> Type)

data SelectOptions db r hasLimit hasOffset hasOrder hasDistinct = SelectOptions
  { SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> Cond db r
condOptions :: Cond db r,
    SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> Maybe Int
limitOptions :: Maybe Int,
    SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> Maybe Int
offsetOptions :: Maybe Int,
    -- | False - no DISTINCT, True - DISTINCT
    SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> [Order db r]
orderOptions :: [Order db r],
    -- | The name of the option and part of the SQL which will be put later
    SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> Bool
distinctOptions :: Bool,
    SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> [(String, QueryRaw db r)]
dbSpecificOptions :: [(String, QueryRaw db r)]
  }

-- | This class helps to check that limit, offset, or order clauses are added to condition only once.
class HasSelectOptions a db r | a -> db r where
  type HasLimit a
  type HasOffset a
  type HasOrder a
  type HasDistinct a
  getSelectOptions :: a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)

instance db' ~ db => HasSelectOptions (Cond db r) db' r where
  type HasLimit (Cond db r) = HFalse
  type HasOffset (Cond db r) = HFalse
  type HasOrder (Cond db r) = HFalse
  type HasDistinct (Cond db r) = HFalse
  getSelectOptions :: Cond db r
-> SelectOptions
     db'
     r
     (HasLimit (Cond db r))
     (HasOffset (Cond db r))
     (HasOrder (Cond db r))
     (HasDistinct (Cond db r))
getSelectOptions Cond db r
a = Cond db r
-> Maybe Int
-> Maybe Int
-> [Order db r]
-> Bool
-> [(String, QueryRaw db r)]
-> SelectOptions db r HFalse HFalse HFalse HFalse
forall db r hasLimit hasOffset hasOrder hasDistinct.
Cond db r
-> Maybe Int
-> Maybe Int
-> [Order db r]
-> Bool
-> [(String, QueryRaw db r)]
-> SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
SelectOptions Cond db r
a Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing [] Bool
False []

instance db' ~ db => HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) db' r where
  type HasLimit (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasLimit
  type HasOffset (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasOffset
  type HasOrder (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasOrder
  type HasDistinct (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasDistinct
  getSelectOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> SelectOptions
     db'
     r
     (HasLimit
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
     (HasOffset
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
     (HasOrder
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
     (HasDistinct
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
getSelectOptions = SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
-> SelectOptions
     db'
     r
     (HasLimit
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
     (HasOffset
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
     (HasOrder
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
     (HasDistinct
        (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct))
forall a. a -> a
id

limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a) (HasDistinct a)
limitTo :: a
-> Int
-> SelectOptions
     db r HTrue (HasOffset a) (HasOrder a) (HasDistinct a)
limitTo a
opts Int
lim = (a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions a
opts) {limitOptions :: Maybe Int
limitOptions = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lim}

offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a) (HasDistinct a)
offsetBy :: a
-> Int
-> SelectOptions
     db r (HasLimit a) HTrue (HasOrder a) (HasDistinct a)
offsetBy a
opts Int
off = (a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions a
opts) {offsetOptions :: Maybe Int
offsetOptions = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
off}

orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue (HasDistinct a)
orderBy :: a
-> [Order db r]
-> SelectOptions
     db r (HasLimit a) (HasOffset a) HTrue (HasDistinct a)
orderBy a
opts [Order db r]
ord = (a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions a
opts) {orderOptions :: [Order db r]
orderOptions = [Order db r]
ord}

-- | Select DISTINCT rows. @select $ distinct CondEmpty@
distinct :: (HasSelectOptions a db r, HasDistinct a ~ HFalse) => a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue
distinct :: a
-> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue
distinct a
opts = (a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
forall a db r.
HasSelectOptions a db r =>
a
-> SelectOptions
     db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
getSelectOptions a
opts) {distinctOptions :: Bool
distinctOptions = Bool
True}

class PrimitivePersistField (AutoKeyType db) => DbDescriptor db where
  -- | Type of the database default auto-incremented key. For example, Sqlite has Int64
  type AutoKeyType db

  -- | Value of this type can be used as a part of a query. For example, it can be RenderS for relational databases, or BSON for MongoDB.
  type QueryRaw db :: Type -> Type

  -- | Name of backend
  backendName :: proxy db -> String

class (DbDescriptor conn, ConnectionManager conn) => PersistBackendConn conn where
  -- | Insert a new record to a database and return its autogenerated key or ()
  insert :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => v -> m (AutoKey v)

  -- | Insert a new record to a database. For some backends it may be faster than 'insert'.
  insert_ :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => v -> m ()

  -- | Try to insert a record and return Right newkey. If there is a constraint violation for the given constraint, Left oldkey is returned
  -- , where oldkey is an identifier of the record with the matching values.
  insertBy :: (PersistEntity v, IsUniqueKey (Key v (Unique u)), PersistBackend m, Conn m ~ conn) => u (UniqueMarker v) -> v -> m (Either (AutoKey v) (AutoKey v))

  -- | Try to insert a record and return Right newkey. If there is a constraint violation for any constraint, Left oldkey is returned
  -- , where oldkey is an identifier of the record with the matching values. Note that if several constraints are violated, a key of an arbitrary matching record is returned.
  insertByAll :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => v -> m (Either (AutoKey v) (AutoKey v))

  -- | Replace a record with the given autogenerated key. Result is undefined if the record does not exist.
  replace :: (PersistEntity v, PrimitivePersistField (Key v BackendSpecific), PersistBackend m, Conn m ~ conn) => Key v BackendSpecific -> v -> m ()

  -- | Replace a record. The unique key marker defines what unique key of the entity is used.
  replaceBy :: (PersistEntity v, IsUniqueKey (Key v (Unique u)), PersistBackend m, Conn m ~ conn) => u (UniqueMarker v) -> v -> m ()

  -- | Return a list of the records satisfying the condition. Example: @select $ (FirstField ==. \"abc\" &&. SecondField >. \"def\") \`orderBy\` [Asc ThirdField] \`limitTo\` 100@
  select ::
    (PersistEntity v, EntityConstr v c, HasSelectOptions opts conn (RestrictionHolder v c), PersistBackend m, Conn m ~ conn) =>
    opts ->
    m [v]

  -- | Return a list of the records satisfying the condition. Example: @select $ (FirstField ==. \"abc\" &&. SecondField >. \"def\") \`orderBy\` [Asc ThirdField] \`limitTo\` 100@
  selectStream ::
    (PersistEntity v, EntityConstr v c, HasSelectOptions opts conn (RestrictionHolder v c), PersistBackend m, Conn m ~ conn) =>
    opts ->
    m (RowStream v)

  -- | Return a list of all records. Order is undefined. It can be useful for datatypes with multiple constructors.
  selectAll :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => m [(AutoKey v, v)]

  -- | Return a list of all records. Order is undefined. It can be useful for datatypes with multiple constructors.
  selectAllStream :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => m (RowStream (AutoKey v, v))

  -- | Fetch an entity from a database
  get :: (PersistEntity v, PrimitivePersistField (Key v BackendSpecific), PersistBackend m, Conn m ~ conn) => Key v BackendSpecific -> m (Maybe v)

  -- | Fetch an entity from a database by its unique key
  getBy :: (PersistEntity v, IsUniqueKey (Key v (Unique u)), PersistBackend m, Conn m ~ conn) => Key v (Unique u) -> m (Maybe v)

  -- | Update the records satisfying the condition. Example: @update [FirstField =. \"abc\"] $ FirstField ==. \"def\"@
  update :: (PersistEntity v, EntityConstr v c, PersistBackend m, Conn m ~ conn) => [Update conn (RestrictionHolder v c)] -> Cond conn (RestrictionHolder v c) -> m ()

  -- | Remove the records satisfying the condition
  delete :: (PersistEntity v, EntityConstr v c, PersistBackend m, Conn m ~ conn) => Cond conn (RestrictionHolder v c) -> m ()

  -- | Remove the record with given key. No-op if the record does not exist
  deleteBy :: (PersistEntity v, PrimitivePersistField (Key v BackendSpecific), PersistBackend m, Conn m ~ conn) => Key v BackendSpecific -> m ()

  -- | Remove all records. The entity parameter is used only for type inference.
  deleteAll :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => v -> m ()

  -- | Count total number of records satisfying the condition
  count :: (PersistEntity v, EntityConstr v c, PersistBackend m, Conn m ~ conn) => Cond conn (RestrictionHolder v c) -> m Int

  -- | Count total number of records with all constructors. The entity parameter is used only for type inference
  countAll :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => v -> m Int

  -- | Fetch projection of some fields. Example: @project (SecondField, ThirdField) $ (FirstField ==. \"abc\" &&. SecondField >. \"def\") \`orderBy\` [Asc ThirdField] \`offsetBy\` 100@
  project ::
    (PersistEntity v, EntityConstr v c, Projection' p conn (RestrictionHolder v c) a, HasSelectOptions opts conn (RestrictionHolder v c), PersistBackend m, Conn m ~ conn) =>
    p ->
    opts ->
    m [a]

  projectStream ::
    (PersistEntity v, EntityConstr v c, Projection' p conn (RestrictionHolder v c) a, HasSelectOptions opts conn (RestrictionHolder v c), PersistBackend m, Conn m ~ conn) =>
    p ->
    opts ->
    m (RowStream a)

  -- | Check database schema and create migrations for the entity and the entities it contains
  migrate :: (PersistEntity v, PersistBackend m, Conn m ~ conn) => v -> Migration m

  -- | Execute raw query
  executeRaw ::
    (PersistBackend m, Conn m ~ conn) =>
    -- | keep in cache
    Bool ->
    -- | query
    String ->
    -- | positional parameters
    [PersistValue] ->
    m ()

  -- | Execute raw query with results
  queryRaw ::
    (PersistBackend m, Conn m ~ conn) =>
    -- | keep in cache
    Bool ->
    -- | query
    String ->
    -- | positional parameters
    [PersistValue] ->
    m (RowStream [PersistValue])

  insertList :: (PersistField a, PersistBackend m, Conn m ~ conn) => [a] -> m Int64
  getList :: (PersistField a, PersistBackend m, Conn m ~ conn) => Int64 -> m [a]

type Action conn = ReaderT conn IO

type TryAction e m conn = ReaderT conn (ExceptT e m)

type RowStream a = Acquire (IO (Maybe a))

type Migration m = StateT NamedMigrations m ()

-- | Datatype names and corresponding migrations
type NamedMigrations = Map String SingleMigration

-- | Either error messages or migration queries with safety flag and execution order
type SingleMigration = Either [String] [(Bool, Int, String)]

-- $types
-- These types describe the mapping between database schema and datatype. They hold table names, columns, constraints, etc. Some types below are parameterized by string type str and dbType. This is done to make them promotable to kind level.

-- | Describes an ADT.
data EntityDef' str dbType = EntityDef
  { -- | Entity name. @entityName (entityDef v) == persistName v@
    EntityDef' str dbType -> str
entityName :: str,
    -- | Database schema for the entity table and tables of its constructors
    EntityDef' str dbType -> Maybe str
entitySchema :: Maybe str,
    -- | Named types of the instantiated polymorphic type parameters
    EntityDef' str dbType -> [dbType]
typeParams :: [dbType],
    -- | List of entity constructors definitions
    EntityDef' str dbType -> [ConstructorDef' str dbType]
constructors :: [ConstructorDef' str dbType]
  }
  deriving (Int -> EntityDef' str dbType -> ShowS
[EntityDef' str dbType] -> ShowS
EntityDef' str dbType -> String
(Int -> EntityDef' str dbType -> ShowS)
-> (EntityDef' str dbType -> String)
-> ([EntityDef' str dbType] -> ShowS)
-> Show (EntityDef' str dbType)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall str dbType.
(Show str, Show dbType) =>
Int -> EntityDef' str dbType -> ShowS
forall str dbType.
(Show str, Show dbType) =>
[EntityDef' str dbType] -> ShowS
forall str dbType.
(Show str, Show dbType) =>
EntityDef' str dbType -> String
showList :: [EntityDef' str dbType] -> ShowS
$cshowList :: forall str dbType.
(Show str, Show dbType) =>
[EntityDef' str dbType] -> ShowS
show :: EntityDef' str dbType -> String
$cshow :: forall str dbType.
(Show str, Show dbType) =>
EntityDef' str dbType -> String
showsPrec :: Int -> EntityDef' str dbType -> ShowS
$cshowsPrec :: forall str dbType.
(Show str, Show dbType) =>
Int -> EntityDef' str dbType -> ShowS
Show, EntityDef' str dbType -> EntityDef' str dbType -> Bool
(EntityDef' str dbType -> EntityDef' str dbType -> Bool)
-> (EntityDef' str dbType -> EntityDef' str dbType -> Bool)
-> Eq (EntityDef' str dbType)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall str dbType.
(Eq str, Eq dbType) =>
EntityDef' str dbType -> EntityDef' str dbType -> Bool
/= :: EntityDef' str dbType -> EntityDef' str dbType -> Bool
$c/= :: forall str dbType.
(Eq str, Eq dbType) =>
EntityDef' str dbType -> EntityDef' str dbType -> Bool
== :: EntityDef' str dbType -> EntityDef' str dbType -> Bool
$c== :: forall str dbType.
(Eq str, Eq dbType) =>
EntityDef' str dbType -> EntityDef' str dbType -> Bool
Eq)

type EntityDef = EntityDef' String DbType

-- | Describes an entity constructor
data ConstructorDef' str dbType = ConstructorDef
  { -- | Constructor name
    ConstructorDef' str dbType -> str
constrName :: str,
    -- | Autokey name if any
    ConstructorDef' str dbType -> Maybe str
constrAutoKeyName :: Maybe str,
    -- | Parameter names with their named type
    ConstructorDef' str dbType -> [(str, dbType)]
constrParams :: [(str, dbType)],
    -- | Uniqueness constraints on the constructor fiels
    ConstructorDef' str dbType
-> [UniqueDef' str (Either (str, dbType) str)]
constrUniques :: [UniqueDef' str (Either (str, dbType) str)]
  }
  deriving (Int -> ConstructorDef' str dbType -> ShowS
[ConstructorDef' str dbType] -> ShowS
ConstructorDef' str dbType -> String
(Int -> ConstructorDef' str dbType -> ShowS)
-> (ConstructorDef' str dbType -> String)
-> ([ConstructorDef' str dbType] -> ShowS)
-> Show (ConstructorDef' str dbType)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall str dbType.
(Show str, Show dbType) =>
Int -> ConstructorDef' str dbType -> ShowS
forall str dbType.
(Show str, Show dbType) =>
[ConstructorDef' str dbType] -> ShowS
forall str dbType.
(Show str, Show dbType) =>
ConstructorDef' str dbType -> String
showList :: [ConstructorDef' str dbType] -> ShowS
$cshowList :: forall str dbType.
(Show str, Show dbType) =>
[ConstructorDef' str dbType] -> ShowS
show :: ConstructorDef' str dbType -> String
$cshow :: forall str dbType.
(Show str, Show dbType) =>
ConstructorDef' str dbType -> String
showsPrec :: Int -> ConstructorDef' str dbType -> ShowS
$cshowsPrec :: forall str dbType.
(Show str, Show dbType) =>
Int -> ConstructorDef' str dbType -> ShowS
Show, ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool
(ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool)
-> (ConstructorDef' str dbType
    -> ConstructorDef' str dbType -> Bool)
-> Eq (ConstructorDef' str dbType)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall str dbType.
(Eq str, Eq dbType) =>
ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool
/= :: ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool
$c/= :: forall str dbType.
(Eq str, Eq dbType) =>
ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool
== :: ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool
$c== :: forall str dbType.
(Eq str, Eq dbType) =>
ConstructorDef' str dbType -> ConstructorDef' str dbType -> Bool
Eq)

type ConstructorDef = ConstructorDef' String DbType

-- | Phantom constructors are made instances of this class. This class should be used only by Template Haskell codegen
class Constructor c where
  -- returning ConstructorDef seems more logical, but it would require the value datatype
  -- it can be supplied either as a part of constructor type, eg instance Constructor (MyDataConstructor (MyData a)) which requires -XFlexibleInstances
  -- or as a separate type, eg instance Constructor MyDataConstructor (MyData a) which requires -XMultiParamTypeClasses

  -- | Returns constructor index which can be used to get ConstructorDef from EntityDef
  phantomConstrNum :: c (a :: Type -> Type) -> Int

-- | This class helps type inference in cases when query does not contain any fields which
-- define the constructor, but the entity has only one.
-- For example, in @select $ AutoKeyField ==. k@ the condition would need type annotation with constructor name only if we select a sum type.
class PersistEntity v => EntityConstr v c where
  entityConstrNum :: proxy v -> c (a :: Type -> Type) -> Int

class PurePersistField uKey => IsUniqueKey uKey where
  -- | Creates value of unique key using the data extracted from the passed value
  extractUnique :: uKey ~ Key v u => v -> uKey

  -- | Ordinal number of the unique constraint in the list returned by 'constrUniques'
  uniqueNum :: uKey -> Int

-- | Unique name and list of the fields that form a unique combination. The fields are parametrized to reuse this datatype both with field and DbType and with column name
data UniqueDef' str field = UniqueDef
  { UniqueDef' str field -> Maybe str
uniqueDefName :: Maybe str,
    UniqueDef' str field -> UniqueType
uniqueDefType :: UniqueType,
    UniqueDef' str field -> [field]
uniqueDefFields :: [field]
  }
  deriving (Int -> UniqueDef' str field -> ShowS
[UniqueDef' str field] -> ShowS
UniqueDef' str field -> String
(Int -> UniqueDef' str field -> ShowS)
-> (UniqueDef' str field -> String)
-> ([UniqueDef' str field] -> ShowS)
-> Show (UniqueDef' str field)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall str field.
(Show str, Show field) =>
Int -> UniqueDef' str field -> ShowS
forall str field.
(Show str, Show field) =>
[UniqueDef' str field] -> ShowS
forall str field.
(Show str, Show field) =>
UniqueDef' str field -> String
showList :: [UniqueDef' str field] -> ShowS
$cshowList :: forall str field.
(Show str, Show field) =>
[UniqueDef' str field] -> ShowS
show :: UniqueDef' str field -> String
$cshow :: forall str field.
(Show str, Show field) =>
UniqueDef' str field -> String
showsPrec :: Int -> UniqueDef' str field -> ShowS
$cshowsPrec :: forall str field.
(Show str, Show field) =>
Int -> UniqueDef' str field -> ShowS
Show, UniqueDef' str field -> UniqueDef' str field -> Bool
(UniqueDef' str field -> UniqueDef' str field -> Bool)
-> (UniqueDef' str field -> UniqueDef' str field -> Bool)
-> Eq (UniqueDef' str field)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall str field.
(Eq str, Eq field) =>
UniqueDef' str field -> UniqueDef' str field -> Bool
/= :: UniqueDef' str field -> UniqueDef' str field -> Bool
$c/= :: forall str field.
(Eq str, Eq field) =>
UniqueDef' str field -> UniqueDef' str field -> Bool
== :: UniqueDef' str field -> UniqueDef' str field -> Bool
$c== :: forall str field.
(Eq str, Eq field) =>
UniqueDef' str field -> UniqueDef' str field -> Bool
Eq)

-- | Field is either a pair of entity field name and its type or an expression which will be used in query as-is.
type UniqueDef = UniqueDef' String (Either (String, DbType) String)

-- | Defines how to treat the unique set of fields for a datatype
data UniqueType
  = UniqueConstraint
  | UniqueIndex
  | -- | is autoincremented
    UniquePrimary Bool
  deriving (Int -> UniqueType -> ShowS
[UniqueType] -> ShowS
UniqueType -> String
(Int -> UniqueType -> ShowS)
-> (UniqueType -> String)
-> ([UniqueType] -> ShowS)
-> Show UniqueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniqueType] -> ShowS
$cshowList :: [UniqueType] -> ShowS
show :: UniqueType -> String
$cshow :: UniqueType -> String
showsPrec :: Int -> UniqueType -> ShowS
$cshowsPrec :: Int -> UniqueType -> ShowS
Show, UniqueType -> UniqueType -> Bool
(UniqueType -> UniqueType -> Bool)
-> (UniqueType -> UniqueType -> Bool) -> Eq UniqueType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniqueType -> UniqueType -> Bool
$c/= :: UniqueType -> UniqueType -> Bool
== :: UniqueType -> UniqueType -> Bool
$c== :: UniqueType -> UniqueType -> Bool
Eq, Eq UniqueType
Eq UniqueType
-> (UniqueType -> UniqueType -> Ordering)
-> (UniqueType -> UniqueType -> Bool)
-> (UniqueType -> UniqueType -> Bool)
-> (UniqueType -> UniqueType -> Bool)
-> (UniqueType -> UniqueType -> Bool)
-> (UniqueType -> UniqueType -> UniqueType)
-> (UniqueType -> UniqueType -> UniqueType)
-> Ord UniqueType
UniqueType -> UniqueType -> Bool
UniqueType -> UniqueType -> Ordering
UniqueType -> UniqueType -> UniqueType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UniqueType -> UniqueType -> UniqueType
$cmin :: UniqueType -> UniqueType -> UniqueType
max :: UniqueType -> UniqueType -> UniqueType
$cmax :: UniqueType -> UniqueType -> UniqueType
>= :: UniqueType -> UniqueType -> Bool
$c>= :: UniqueType -> UniqueType -> Bool
> :: UniqueType -> UniqueType -> Bool
$c> :: UniqueType -> UniqueType -> Bool
<= :: UniqueType -> UniqueType -> Bool
$c<= :: UniqueType -> UniqueType -> Bool
< :: UniqueType -> UniqueType -> Bool
$c< :: UniqueType -> UniqueType -> Bool
compare :: UniqueType -> UniqueType -> Ordering
$ccompare :: UniqueType -> UniqueType -> Ordering
$cp1Ord :: Eq UniqueType
Ord)

data ReferenceActionType
  = NoAction
  | Restrict
  | Cascade
  | SetNull
  | SetDefault
  deriving (ReferenceActionType -> ReferenceActionType -> Bool
(ReferenceActionType -> ReferenceActionType -> Bool)
-> (ReferenceActionType -> ReferenceActionType -> Bool)
-> Eq ReferenceActionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceActionType -> ReferenceActionType -> Bool
$c/= :: ReferenceActionType -> ReferenceActionType -> Bool
== :: ReferenceActionType -> ReferenceActionType -> Bool
$c== :: ReferenceActionType -> ReferenceActionType -> Bool
Eq, Int -> ReferenceActionType -> ShowS
[ReferenceActionType] -> ShowS
ReferenceActionType -> String
(Int -> ReferenceActionType -> ShowS)
-> (ReferenceActionType -> String)
-> ([ReferenceActionType] -> ShowS)
-> Show ReferenceActionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceActionType] -> ShowS
$cshowList :: [ReferenceActionType] -> ShowS
show :: ReferenceActionType -> String
$cshow :: ReferenceActionType -> String
showsPrec :: Int -> ReferenceActionType -> ShowS
$cshowsPrec :: Int -> ReferenceActionType -> ShowS
Show)

-- | A DB data type. Naming attempts to reflect the underlying Haskell
-- datatypes, eg DbString instead of DbVarchar. Different databases may
-- have different representations for these types.
data DbTypePrimitive' str
  = DbString
  | DbInt32
  | DbInt64
  | DbReal
  | DbBool
  | DbDay
  | DbTime
  | DbDayTime
  | DbDayTimeZoned
  | -- | ByteString
    DbBlob
  | DbOther (OtherTypeDef' str)
  deriving (DbTypePrimitive' str -> DbTypePrimitive' str -> Bool
(DbTypePrimitive' str -> DbTypePrimitive' str -> Bool)
-> (DbTypePrimitive' str -> DbTypePrimitive' str -> Bool)
-> Eq (DbTypePrimitive' str)
forall str.
Eq str =>
DbTypePrimitive' str -> DbTypePrimitive' str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbTypePrimitive' str -> DbTypePrimitive' str -> Bool
$c/= :: forall str.
Eq str =>
DbTypePrimitive' str -> DbTypePrimitive' str -> Bool
== :: DbTypePrimitive' str -> DbTypePrimitive' str -> Bool
$c== :: forall str.
Eq str =>
DbTypePrimitive' str -> DbTypePrimitive' str -> Bool
Eq, Int -> DbTypePrimitive' str -> ShowS
[DbTypePrimitive' str] -> ShowS
DbTypePrimitive' str -> String
(Int -> DbTypePrimitive' str -> ShowS)
-> (DbTypePrimitive' str -> String)
-> ([DbTypePrimitive' str] -> ShowS)
-> Show (DbTypePrimitive' str)
forall str. Show str => Int -> DbTypePrimitive' str -> ShowS
forall str. Show str => [DbTypePrimitive' str] -> ShowS
forall str. Show str => DbTypePrimitive' str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbTypePrimitive' str] -> ShowS
$cshowList :: forall str. Show str => [DbTypePrimitive' str] -> ShowS
show :: DbTypePrimitive' str -> String
$cshow :: forall str. Show str => DbTypePrimitive' str -> String
showsPrec :: Int -> DbTypePrimitive' str -> ShowS
$cshowsPrec :: forall str. Show str => Int -> DbTypePrimitive' str -> ShowS
Show)

type DbTypePrimitive = DbTypePrimitive' String

data DbType
  = -- | type, nullable, default value, reference
    DbTypePrimitive DbTypePrimitive Bool (Maybe String) (Maybe ParentTableReference)
  | DbEmbedded EmbeddedDef (Maybe ParentTableReference)
  | -- | List table name and type of its argument
    DbList String DbType
  deriving (DbType -> DbType -> Bool
(DbType -> DbType -> Bool)
-> (DbType -> DbType -> Bool) -> Eq DbType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbType -> DbType -> Bool
$c/= :: DbType -> DbType -> Bool
== :: DbType -> DbType -> Bool
$c== :: DbType -> DbType -> Bool
Eq, Int -> DbType -> ShowS
[DbType] -> ShowS
DbType -> String
(Int -> DbType -> ShowS)
-> (DbType -> String) -> ([DbType] -> ShowS) -> Show DbType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbType] -> ShowS
$cshowList :: [DbType] -> ShowS
show :: DbType -> String
$cshow :: DbType -> String
showsPrec :: Int -> DbType -> ShowS
$cshowsPrec :: Int -> DbType -> ShowS
Show)

-- | The reference contains either EntityDef of the parent table and name of the unique constraint. Or for tables not mapped by Groundhog schema name, table name, and list of columns
-- Reference to the autogenerated key of a mapped entity = (Left (entityDef, Nothing), onDelete, onUpdate)
-- Reference to a unique key of a mapped entity = (Left (entityDef, Just uniqueKeyName), onDelete, onUpdate)
-- Reference to a table that is not mapped = (Right ((schema, tableName), columns), onDelete, onUpdate)
type ParentTableReference = (Either (EntityDef, Maybe String) ((Maybe String, String), [String]), Maybe ReferenceActionType, Maybe ReferenceActionType)

-- | Stores a database type. The list contains two kinds of tokens for the type string. Backend will choose a string representation for DbTypePrimitive's, and the string literals will go to the type as-is. As the final step, these tokens are concatenated. For example, @[Left \"varchar(50)\"]@ will become a string with max length and @[Right DbInt64, Left \"[]\"]@ will become integer[] in PostgreSQL.
newtype OtherTypeDef' str = OtherTypeDef [Either str (DbTypePrimitive' str)] deriving (OtherTypeDef' str -> OtherTypeDef' str -> Bool
(OtherTypeDef' str -> OtherTypeDef' str -> Bool)
-> (OtherTypeDef' str -> OtherTypeDef' str -> Bool)
-> Eq (OtherTypeDef' str)
forall str.
Eq str =>
OtherTypeDef' str -> OtherTypeDef' str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OtherTypeDef' str -> OtherTypeDef' str -> Bool
$c/= :: forall str.
Eq str =>
OtherTypeDef' str -> OtherTypeDef' str -> Bool
== :: OtherTypeDef' str -> OtherTypeDef' str -> Bool
$c== :: forall str.
Eq str =>
OtherTypeDef' str -> OtherTypeDef' str -> Bool
Eq, Int -> OtherTypeDef' str -> ShowS
[OtherTypeDef' str] -> ShowS
OtherTypeDef' str -> String
(Int -> OtherTypeDef' str -> ShowS)
-> (OtherTypeDef' str -> String)
-> ([OtherTypeDef' str] -> ShowS)
-> Show (OtherTypeDef' str)
forall str. Show str => Int -> OtherTypeDef' str -> ShowS
forall str. Show str => [OtherTypeDef' str] -> ShowS
forall str. Show str => OtherTypeDef' str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OtherTypeDef' str] -> ShowS
$cshowList :: forall str. Show str => [OtherTypeDef' str] -> ShowS
show :: OtherTypeDef' str -> String
$cshow :: forall str. Show str => OtherTypeDef' str -> String
showsPrec :: Int -> OtherTypeDef' str -> ShowS
$cshowsPrec :: forall str. Show str => Int -> OtherTypeDef' str -> ShowS
Show)

type OtherTypeDef = OtherTypeDef' String

-- | The first argument is a flag which defines if the field names should be concatenated with the outer field name (False) or used as is which provides full control over table column names (True).
-- Value False should be the default value so that a datatype can be embedded without name conflict concern. The second argument list of field names and field types.
data EmbeddedDef' str dbType = EmbeddedDef Bool [(str, dbType)] deriving (EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool
(EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool)
-> (EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool)
-> Eq (EmbeddedDef' str dbType)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall str dbType.
(Eq str, Eq dbType) =>
EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool
/= :: EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool
$c/= :: forall str dbType.
(Eq str, Eq dbType) =>
EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool
== :: EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool
$c== :: forall str dbType.
(Eq str, Eq dbType) =>
EmbeddedDef' str dbType -> EmbeddedDef' str dbType -> Bool
Eq, Int -> EmbeddedDef' str dbType -> ShowS
[EmbeddedDef' str dbType] -> ShowS
EmbeddedDef' str dbType -> String
(Int -> EmbeddedDef' str dbType -> ShowS)
-> (EmbeddedDef' str dbType -> String)
-> ([EmbeddedDef' str dbType] -> ShowS)
-> Show (EmbeddedDef' str dbType)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall str dbType.
(Show str, Show dbType) =>
Int -> EmbeddedDef' str dbType -> ShowS
forall str dbType.
(Show str, Show dbType) =>
[EmbeddedDef' str dbType] -> ShowS
forall str dbType.
(Show str, Show dbType) =>
EmbeddedDef' str dbType -> String
showList :: [EmbeddedDef' str dbType] -> ShowS
$cshowList :: forall str dbType.
(Show str, Show dbType) =>
[EmbeddedDef' str dbType] -> ShowS
show :: EmbeddedDef' str dbType -> String
$cshow :: forall str dbType.
(Show str, Show dbType) =>
EmbeddedDef' str dbType -> String
showsPrec :: Int -> EmbeddedDef' str dbType -> ShowS
$cshowsPrec :: forall str dbType.
(Show str, Show dbType) =>
Int -> EmbeddedDef' str dbType -> ShowS
Show)

type EmbeddedDef = EmbeddedDef' String DbType

newtype Utf8 = Utf8 Builder
  deriving (Utf8 -> Utf8 -> Bool
(Utf8 -> Utf8 -> Bool) -> (Utf8 -> Utf8 -> Bool) -> Eq Utf8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Utf8 -> Utf8 -> Bool
$c/= :: Utf8 -> Utf8 -> Bool
== :: Utf8 -> Utf8 -> Bool
$c== :: Utf8 -> Utf8 -> Bool
Eq, Eq Utf8
Eq Utf8
-> (Utf8 -> Utf8 -> Ordering)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Bool)
-> (Utf8 -> Utf8 -> Utf8)
-> (Utf8 -> Utf8 -> Utf8)
-> Ord Utf8
Utf8 -> Utf8 -> Bool
Utf8 -> Utf8 -> Ordering
Utf8 -> Utf8 -> Utf8
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Utf8 -> Utf8 -> Utf8
$cmin :: Utf8 -> Utf8 -> Utf8
max :: Utf8 -> Utf8 -> Utf8
$cmax :: Utf8 -> Utf8 -> Utf8
>= :: Utf8 -> Utf8 -> Bool
$c>= :: Utf8 -> Utf8 -> Bool
> :: Utf8 -> Utf8 -> Bool
$c> :: Utf8 -> Utf8 -> Bool
<= :: Utf8 -> Utf8 -> Bool
$c<= :: Utf8 -> Utf8 -> Bool
< :: Utf8 -> Utf8 -> Bool
$c< :: Utf8 -> Utf8 -> Bool
compare :: Utf8 -> Utf8 -> Ordering
$ccompare :: Utf8 -> Utf8 -> Ordering
$cp1Ord :: Eq Utf8
Ord, Int -> Utf8 -> ShowS
[Utf8] -> ShowS
Utf8 -> String
(Int -> Utf8 -> ShowS)
-> (Utf8 -> String) -> ([Utf8] -> ShowS) -> Show Utf8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Utf8] -> ShowS
$cshowList :: [Utf8] -> ShowS
show :: Utf8 -> String
$cshow :: Utf8 -> String
showsPrec :: Int -> Utf8 -> ShowS
$cshowsPrec :: Int -> Utf8 -> ShowS
Show, b -> Utf8 -> Utf8
NonEmpty Utf8 -> Utf8
Utf8 -> Utf8 -> Utf8
(Utf8 -> Utf8 -> Utf8)
-> (NonEmpty Utf8 -> Utf8)
-> (forall b. Integral b => b -> Utf8 -> Utf8)
-> Semigroup Utf8
forall b. Integral b => b -> Utf8 -> Utf8
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Utf8 -> Utf8
$cstimes :: forall b. Integral b => b -> Utf8 -> Utf8
sconcat :: NonEmpty Utf8 -> Utf8
$csconcat :: NonEmpty Utf8 -> Utf8
<> :: Utf8 -> Utf8 -> Utf8
$c<> :: Utf8 -> Utf8 -> Utf8
Semigroup, Semigroup Utf8
Utf8
Semigroup Utf8
-> Utf8
-> (Utf8 -> Utf8 -> Utf8)
-> ([Utf8] -> Utf8)
-> Monoid Utf8
[Utf8] -> Utf8
Utf8 -> Utf8 -> Utf8
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Utf8] -> Utf8
$cmconcat :: [Utf8] -> Utf8
mappend :: Utf8 -> Utf8 -> Utf8
$cmappend :: Utf8 -> Utf8 -> Utf8
mempty :: Utf8
$cmempty :: Utf8
$cp1Monoid :: Semigroup Utf8
Monoid, String -> Utf8
(String -> Utf8) -> IsString Utf8
forall a. (String -> a) -> IsString a
fromString :: String -> Utf8
$cfromString :: String -> Utf8
IsString)

fromUtf8 :: Utf8 -> ByteString
fromUtf8 :: Utf8 -> ByteString
fromUtf8 (Utf8 Builder
s) = ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText Builder
s

instance Read Utf8 where
  readsPrec :: Int -> ReadS Utf8
readsPrec Int
prec String
str = ((Text, String) -> (Utf8, String))
-> [(Text, String)] -> [(Utf8, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
a, String
b) -> (Builder -> Utf8
Utf8 (Builder -> Utf8) -> Builder -> Utf8
forall a b. (a -> b) -> a -> b
$ Text -> Builder
fromText Text
a, String
b)) ([(Text, String)] -> [(Utf8, String)])
-> [(Text, String)] -> [(Utf8, String)]
forall a b. (a -> b) -> a -> b
$ Int -> ReadS Text
forall a. Read a => Int -> ReadS a
readsPrec Int
prec String
str

-- | A raw value which can be stored in any backend and can be marshalled to
-- and from a 'PersistField'.
data PersistValue
  = PersistString String
  | PersistText Text
  | PersistByteString ByteString
  | PersistInt64 Int64
  | PersistDouble Double
  | PersistBool Bool
  | PersistDay Day
  | PersistTimeOfDay TimeOfDay
  | PersistUTCTime UTCTime
  | PersistZonedTime ZT
  | PersistNull
  | -- | Creating some datatypes may require calling a function, using a special constructor, or other syntax. The string (which can have placeholders) is included into query without escaping. The recursive constructions are not allowed, i.e., [PersistValue] cannot contain PersistCustom values.
    PersistCustom Utf8 [PersistValue]
  deriving (PersistValue -> PersistValue -> Bool
(PersistValue -> PersistValue -> Bool)
-> (PersistValue -> PersistValue -> Bool) -> Eq PersistValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PersistValue -> PersistValue -> Bool
$c/= :: PersistValue -> PersistValue -> Bool
== :: PersistValue -> PersistValue -> Bool
$c== :: PersistValue -> PersistValue -> Bool
Eq, Int -> PersistValue -> ShowS
[PersistValue] -> ShowS
PersistValue -> String
(Int -> PersistValue -> ShowS)
-> (PersistValue -> String)
-> ([PersistValue] -> ShowS)
-> Show PersistValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistValue] -> ShowS
$cshowList :: [PersistValue] -> ShowS
show :: PersistValue -> String
$cshow :: PersistValue -> String
showsPrec :: Int -> PersistValue -> ShowS
$cshowsPrec :: Int -> PersistValue -> ShowS
Show, ReadPrec [PersistValue]
ReadPrec PersistValue
Int -> ReadS PersistValue
ReadS [PersistValue]
(Int -> ReadS PersistValue)
-> ReadS [PersistValue]
-> ReadPrec PersistValue
-> ReadPrec [PersistValue]
-> Read PersistValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PersistValue]
$creadListPrec :: ReadPrec [PersistValue]
readPrec :: ReadPrec PersistValue
$creadPrec :: ReadPrec PersistValue
readList :: ReadS [PersistValue]
$creadList :: ReadS [PersistValue]
readsPrec :: Int -> ReadS PersistValue
$creadsPrec :: Int -> ReadS PersistValue
Read)

-- | Avoid orphan instances.
newtype ZT = ZT ZonedTime deriving (Int -> ZT -> ShowS
[ZT] -> ShowS
ZT -> String
(Int -> ZT -> ShowS)
-> (ZT -> String) -> ([ZT] -> ShowS) -> Show ZT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZT] -> ShowS
$cshowList :: [ZT] -> ShowS
show :: ZT -> String
$cshow :: ZT -> String
showsPrec :: Int -> ZT -> ShowS
$cshowsPrec :: Int -> ZT -> ShowS
Show, ReadPrec [ZT]
ReadPrec ZT
Int -> ReadS ZT
ReadS [ZT]
(Int -> ReadS ZT)
-> ReadS [ZT] -> ReadPrec ZT -> ReadPrec [ZT] -> Read ZT
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ZT]
$creadListPrec :: ReadPrec [ZT]
readPrec :: ReadPrec ZT
$creadPrec :: ReadPrec ZT
readList :: ReadS [ZT]
$creadList :: ReadS [ZT]
readsPrec :: Int -> ReadS ZT
$creadsPrec :: Int -> ReadS ZT
Read)

instance Eq ZT where
  ZT ZonedTime
a == :: ZT -> ZT -> Bool
== ZT ZonedTime
b = ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
a LocalTime -> LocalTime -> Bool
forall a. Eq a => a -> a -> Bool
== ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
b Bool -> Bool -> Bool
&& ZonedTime -> TimeZone
zonedTimeZone ZonedTime
a TimeZone -> TimeZone -> Bool
forall a. Eq a => a -> a -> Bool
== ZonedTime -> TimeZone
zonedTimeZone ZonedTime
b

instance Ord ZT where
  ZT ZonedTime
a compare :: ZT -> ZT -> Ordering
`compare` ZT ZonedTime
b = ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
a UTCTime -> UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
b

-- | Types which are never NULL when converted to 'PersistValue'.
-- Consider the type @Maybe (Maybe a)@. Now Nothing is stored as NULL, so we cannot distinguish between Just Nothing and Nothing which is a problem.
-- The purpose of this class is to ban the inner Maybe's.
-- Maybe this class can be removed when support for inner Maybe's appears.
class NeverNull a

-- | Used to uniformly represent fields, constants and more complex things, e.g., arithmetic expressions.
-- A value should be converted to 'UntypedExpr' for usage in expressions
data UntypedExpr db r where
  ExprRaw :: DbType -> QueryRaw db r -> UntypedExpr db r
  ExprField :: FieldChain -> UntypedExpr db r
  ExprPure :: forall db r a. PurePersistField a => a -> UntypedExpr db r
  ExprCond :: Cond db r -> UntypedExpr db r

-- | Expr with phantom type helps to keep type safety in complex expressions
newtype Expr db r a = Expr (UntypedExpr db r)

instance Show (Expr db r a) where show :: Expr db r a -> String
show Expr db r a
_ = String
"Expr"

instance Eq (Expr db r a) where == :: Expr db r a -> Expr db r a -> Bool
(==) = String -> Expr db r a -> Expr db r a -> Bool
forall a. HasCallStack => String -> a
error String
"(==): this instance Eq (Expr db r a) is made only for Num superclass constraint"

-- | Represents everything which can be put into a database. This data can be stored in multiple columns and tables. To get value of those columns we might need to access another table. That is why the result type is monadic.
class PersistField a where
  -- | Return name of the type. If it is polymorphic, the names of parameter types are separated with 'Database.Groundhog.Generic.delim' symbol
  persistName :: a -> String

  -- | Convert a value into something which can be stored in a database column.
  -- Note that for complex datatypes it may insert them to return identifier
  toPersistValues :: PersistBackend m => a -> m ([PersistValue] -> [PersistValue])

  -- | Constructs a value from a 'PersistValue'. For complex datatypes it may query the database
  fromPersistValues :: PersistBackend m => [PersistValue] -> m (a, [PersistValue])

  -- | Description of value type. It depends on database so that we can have, for example, xml column type in Postgres and varchar type in other databases
  dbType :: DbDescriptor db => proxy db -> a -> DbType

-- | Represents all datatypes that map into a single column. Getting value for that column might require monadic actions to access other tables.
class PersistField a => SinglePersistField a where
  toSinglePersistValue :: PersistBackend m => a -> m PersistValue
  fromSinglePersistValue :: PersistBackend m => PersistValue -> m a

-- | Represents all datatypes that map into several columns. Getting values for those columns is pure.
class PersistField a => PurePersistField a where
  toPurePersistValues :: a -> ([PersistValue] -> [PersistValue])
  fromPurePersistValues :: [PersistValue] -> (a, [PersistValue])

-- | Datatypes which can be converted directly to 'PersistValue'
class PersistField a => PrimitivePersistField a where
  toPrimitivePersistValue :: a -> PersistValue
  fromPrimitivePersistValue :: PersistValue -> a

delim :: Char
delim :: Char
delim = Char
'#'

class ExtractConnection cm conn | cm -> conn where
  -- | Extracts the connection. The connection manager can be a pool or the connection itself
  extractConn :: (MonadBaseControl IO m, MonadIO m) => (conn -> m a) -> cm -> m a

-- | Connection manager provides connection to the passed function handles transations. Manager can be a connection itself, a pool, Snaplet in Snap, foundation datatype in Yesod, etc.
class ConnectionManager conn where
  -- | Opens the transaction.
  withConn :: (MonadBaseControl IO m, MonadIO m) => (conn -> m a) -> conn -> m a

class TryConnectionManager conn where
  -- | Tries the transaction, using a provided function which evaluates to an Either. Any Left result will cause transaction rollback.
  tryWithConn :: (MonadBaseControl IO m, MonadIO m, MonadCatch m) => (conn -> n a) -> (n a -> m (Either SomeException a)) -> conn -> m (Either SomeException a)

class Savepoint conn where
  -- | Wraps the passed action into a named savepoint
  withConnSavepoint :: (MonadBaseControl IO m, MonadIO m) => String -> m a -> conn -> m a

-- | This class helps to shorten the type signatures of user monadic code.
-- If your monad has several connections, e.g., for main and audit databases, create run*Db function
-- runAuditDb :: Action conn a -> m a
class (Monad m, MonadIO m, MonadFail m, ConnectionManager (Conn m), PersistBackendConn (Conn m)) => PersistBackend m where
  type Conn m
  getConnection :: m (Conn m)

instance (Monad m, MonadIO m, MonadFail m, PersistBackendConn conn) => PersistBackend (ReaderT conn m) where
  type Conn (ReaderT conn m) = conn
  getConnection :: ReaderT conn m (Conn (ReaderT conn m))
getConnection = ReaderT conn m (Conn (ReaderT conn m))
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | It helps to run database operations within an application monad.
runDb :: PersistBackend m => Action (Conn m) a -> m a
runDb :: Action (Conn m) a -> m a
runDb Action (Conn m) a
f = m (Conn m)
forall (m :: * -> *). PersistBackend m => m (Conn m)
getConnection m (Conn m) -> (Conn m -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Conn m -> IO a) -> Conn m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Conn m -> IO a) -> Conn m -> IO a
forall conn (m :: * -> *) a.
(ConnectionManager conn, MonadBaseControl IO m, MonadIO m) =>
(conn -> m a) -> conn -> m a
withConn (Action (Conn m) a -> Conn m -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Action (Conn m) a
f)

-- | Runs action within connection. It can handle a simple connection, a pool of them, etc.
runDbConn :: (MonadIO m, MonadBaseControl IO m, ConnectionManager conn, ExtractConnection cm conn) => Action conn a -> cm -> m a
runDbConn :: Action conn a -> cm -> m a
runDbConn Action conn a
f = (conn -> m a) -> cm -> m a
forall cm conn (m :: * -> *) a.
(ExtractConnection cm conn, MonadBaseControl IO m, MonadIO m) =>
(conn -> m a) -> cm -> m a
extractConn (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (conn -> IO a) -> conn -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (conn -> IO a) -> conn -> IO a
forall conn (m :: * -> *) a.
(ConnectionManager conn, MonadBaseControl IO m, MonadIO m) =>
(conn -> m a) -> conn -> m a
withConn (Action conn a -> conn -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Action conn a
f))

-- | Runs TryAction within connection.
runTryDbConn :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, TryConnectionManager conn, ExtractConnection cm conn, Exception e) => TryAction e m conn a -> cm -> m (Either SomeException a)
runTryDbConn :: TryAction e m conn a -> cm -> m (Either SomeException a)
runTryDbConn TryAction e m conn a
f = (conn -> m (Either SomeException a))
-> cm -> m (Either SomeException a)
forall cm conn (m :: * -> *) a.
(ExtractConnection cm conn, MonadBaseControl IO m, MonadIO m) =>
(conn -> m a) -> cm -> m a
extractConn ((conn -> ExceptT e m a)
-> (ExceptT e m a -> m (Either SomeException a))
-> conn
-> m (Either SomeException a)
forall conn (m :: * -> *) (n :: * -> *) a.
(TryConnectionManager conn, MonadBaseControl IO m, MonadIO m,
 MonadCatch m) =>
(conn -> n a)
-> (n a -> m (Either SomeException a))
-> conn
-> m (Either SomeException a)
tryWithConn (TryAction e m conn a -> conn -> ExceptT e m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT TryAction e m conn a
f) ExceptT e m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ExceptT e m a -> m (Either SomeException a)
tryExceptT)

-- | Tries Action within connection.
runTryDbConn' :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, TryConnectionManager conn, ExtractConnection cm conn) => Action conn a -> cm -> m (Either SomeException a)
runTryDbConn' :: Action conn a -> cm -> m (Either SomeException a)
runTryDbConn' Action conn a
f = (conn -> m (Either SomeException a))
-> cm -> m (Either SomeException a)
forall cm conn (m :: * -> *) a.
(ExtractConnection cm conn, MonadBaseControl IO m, MonadIO m) =>
(conn -> m a) -> cm -> m a
extractConn (IO (Either SomeException a) -> m (Either SomeException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a) -> m (Either SomeException a))
-> (conn -> IO (Either SomeException a))
-> conn
-> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (conn -> IO a)
-> (IO a -> IO (Either SomeException a))
-> conn
-> IO (Either SomeException a)
forall conn (m :: * -> *) (n :: * -> *) a.
(TryConnectionManager conn, MonadBaseControl IO m, MonadIO m,
 MonadCatch m) =>
(conn -> n a)
-> (n a -> m (Either SomeException a))
-> conn
-> m (Either SomeException a)
tryWithConn (Action conn a -> conn -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Action conn a
f) IO a -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny)

-- | It helps to run database operations within an application monad. Unlike `runDb` it does not wrap action in transaction
runDb' :: PersistBackend m => Action (Conn m) a -> m a
runDb' :: Action (Conn m) a -> m a
runDb' Action (Conn m) a
f = m (Conn m)
forall (m :: * -> *). PersistBackend m => m (Conn m)
getConnection m (Conn m) -> (Conn m -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Conn m -> IO a) -> Conn m -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action (Conn m) a -> Conn m -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Action (Conn m) a
f

-- | It is similar to `runDbConn` but runs action without transaction.
--
-- @
-- flip withConn conn $ \\conn -> liftIO $ do
--   -- transaction is already opened by withConn at this point
--   someIOAction
--   runDbConn' (insert_ value) conn
-- @
runDbConn' :: (MonadIO m, MonadBaseControl IO m, ConnectionManager conn, ExtractConnection cm conn) => Action conn a -> cm -> m a
runDbConn' :: Action conn a -> cm -> m a
runDbConn' Action conn a
f = (conn -> m a) -> cm -> m a
forall cm conn (m :: * -> *) a.
(ExtractConnection cm conn, MonadBaseControl IO m, MonadIO m) =>
(conn -> m a) -> cm -> m a
extractConn (IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (conn -> IO a) -> conn -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action conn a -> conn -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Action conn a
f)

-- | It helps to run 'withConnSavepoint' within a monad. Make sure that transaction is open
withSavepoint :: (PersistBackend m, MonadBaseControl IO m, MonadIO m, Savepoint (Conn m)) => String -> m a -> m a
withSavepoint :: String -> m a -> m a
withSavepoint String
name m a
m = m (Conn m)
forall (m :: * -> *). PersistBackend m => m (Conn m)
getConnection m (Conn m) -> (Conn m -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> m a -> Conn m -> m a
forall conn (m :: * -> *) a.
(Savepoint conn, MonadBaseControl IO m, MonadIO m) =>
String -> m a -> conn -> m a
withConnSavepoint String
name m a
m

tryExceptT ::
  ( MonadCatch m,
    Exception e
  ) =>
  ExceptT e m a ->
  m (Either SomeException a)
tryExceptT :: ExceptT e m a -> m (Either SomeException a)
tryExceptT ExceptT e m a
e = do
  Either SomeException (Either e a)
outside <- m (Either e a) -> m (Either SomeException (Either e a))
forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny (m (Either e a) -> m (Either SomeException (Either e a)))
-> m (Either e a) -> m (Either SomeException (Either e a))
forall a b. (a -> b) -> a -> b
$ ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
e
  case Either SomeException (Either e a)
outside of
    Left SomeException
outsideErr -> Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m (Either SomeException a))
-> (SomeException -> Either SomeException a)
-> SomeException
-> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> m (Either SomeException a))
-> SomeException -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ SomeException
outsideErr
    Right Either e a
inside -> case Either e a
inside of
      Left e
insideErr -> Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m (Either SomeException a))
-> (e -> Either SomeException a) -> e -> m (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Either SomeException a
forall a b. a -> Either a b
Left (SomeException -> Either SomeException a)
-> (e -> SomeException) -> e -> Either SomeException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeException
forall e. Exception e => e -> SomeException
SomeException (e -> m (Either SomeException a))
-> e -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ e
insideErr
      Right a
y -> Either SomeException a -> m (Either SomeException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException a -> m (Either SomeException a))
-> Either SomeException a -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ a -> Either SomeException a
forall a b. b -> Either a b
Right a
y