    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE NamedFieldPuns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns #-}

    module Database.Persist.Postgresql.Internal
        ( P (..)
        , PgInterval (..)
        , getGetter
        , AlterDB (..)
        , AlterTable (..)
        , AlterColumn (..)
        , SafeToRemove
        , migrateStructured
        , mockMigrateStructured
        , addTable
        , findAlters
        , maySerial
        , mayDefault
        , showSqlType
        , showColumn
        , showAlter
        , showAlterDb
        , showAlterTable
        , getAddReference
        , udToPair
        , safeToRemove
        , postgresMkColumns
        , getAlters
        , escapeE
        , escapeF
        , escape
        ) where

    import qualified Database.PostgreSQL.Simple as PG
    import qualified Database.PostgreSQL.Simple.FromField as PGFF
    import qualified Database.PostgreSQL.Simple.Internal as PG
    import qualified Database.PostgreSQL.Simple.ToField as PGTF
    import qualified Database.PostgreSQL.Simple.TypeInfo.Static as PS
    import qualified Database.PostgreSQL.Simple.Types as PG

    import qualified Blaze.ByteString.Builder.Char8 as BBB
    import Control.Arrow
    import Control.Monad
    import Control.Monad.Except
    import Control.Monad.IO.Unlift (MonadIO (..))
    import Control.Monad.Trans.Class (lift)
    import Data.Acquire (with)
    import qualified Data.Attoparsec.ByteString.Char8 as P
    import Data.Bits ((.&.))
    import Data.ByteString (ByteString)
    import qualified Data.ByteString.Builder as BB
    import qualified Data.ByteString.Char8 as B8
    import Data.Char (ord)
    import Data.Conduit
    import qualified Data.Conduit.List as CL
    import Data.Data (Typeable)
    import Data.Either (partitionEithers)
    import Data.Fixed (Fixed (..), Pico)
    import Data.Function (on)
    import Data.Int (Int64)
    import qualified Data.IntMap as I
    import Data.List as List (find, foldl', groupBy, sort)
    import qualified Data.List.NonEmpty as NEL
    import qualified Data.Map as Map
    import Data.Maybe
    import Data.String.Conversions.Monomorphic (toStrictByteString)
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    import Data.Time (NominalDiffTime, localTimeToUTC, utc)
    import Database.Persist.Sql
    import qualified Database.Persist.Sql.Util as Util

    -- | Newtype used to avoid orphan instances for @postgresql-simple@ classes.
    --
    -- @since 2.13.2.0
    newtype P = P {P -> PersistValue
    unP :: PersistValue}

    instance PGTF.ToField P where
        toField :: P -> Action
    toField (P (PersistText Text
    t)) = Text -> Action
    forall a. ToField a => a -> Action
    PGTF.toField Text
    t
        toField (P (PersistByteString StrictByteString
    bs)) = Binary StrictByteString -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (StrictByteString -> Binary StrictByteString
    forall a. a -> Binary a
    PG.Binary StrictByteString
    bs)
        toField (P (PersistInt64 Int64
    i)) = Int64 -> Action
    forall a. ToField a => a -> Action
    PGTF.toField Int64
    i
        toField (P (PersistDouble Double
    d)) = Double -> Action
    forall a. ToField a => a -> Action
    PGTF.toField Double
    d
        toField (P (PersistRational Rational
    r)) =
            Builder -> Action
    PGTF.Plain (Builder -> Action) -> Builder -> Action
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> Builder
    BBB.fromString ([Char] -> Builder) -> [Char] -> Builder
    forall a b. (a -> b) -> a -> b
    $
                    Pico -> [Char]
    forall a. Show a => a -> [Char]
    show (Rational -> Pico
    forall a. Fractional a => Rational -> a
    fromRational Rational
    r :: Pico) --  FIXME: Too Ambigous, can not select precision without information about field
        toField (P (PersistBool Bool
    b)) = Bool -> Action
    forall a. ToField a => a -> Action
    PGTF.toField Bool
    b
        toField (P (PersistDay Day
    d)) = Day -> Action
    forall a. ToField a => a -> Action
    PGTF.toField Day
    d
        toField (P (PersistTimeOfDay TimeOfDay
    t)) = TimeOfDay -> Action
    forall a. ToField a => a -> Action
    PGTF.toField TimeOfDay
    t
        toField (P (PersistUTCTime UTCTime
    t)) = UTCTime -> Action
    forall a. ToField a => a -> Action
    PGTF.toField UTCTime
    t
        toField (P PersistValue
    PersistNull) = Null -> Action
    forall a. ToField a => a -> Action
    PGTF.toField Null
    PG.Null
        toField (P (PersistList [PersistValue]
    l)) = Text -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (Text -> Action) -> Text -> Action
    forall a b. (a -> b) -> a -> b
    $ [PersistValue] -> Text
    listToJSON [PersistValue]
    l
        toField (P (PersistMap [(Text, PersistValue)]
    m)) = Text -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (Text -> Action) -> Text -> Action
    forall a b. (a -> b) -> a -> b
    $ [(Text, PersistValue)] -> Text
    mapToJSON [(Text, PersistValue)]
    m
        toField (P (PersistLiteral_ LiteralType
    DbSpecific StrictByteString
    s)) = Unknown -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (StrictByteString -> Unknown
    Unknown StrictByteString
    s)
        toField (P (PersistLiteral_ LiteralType
    Unescaped StrictByteString
    l)) = UnknownLiteral -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (StrictByteString -> UnknownLiteral
    UnknownLiteral StrictByteString
    l)
        toField (P (PersistLiteral_ LiteralType
    Escaped StrictByteString
    e)) = Unknown -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (StrictByteString -> Unknown
    Unknown StrictByteString
    e)
        toField (P (PersistArray [PersistValue]
    a)) = PGArray P -> Action
    forall a. ToField a => a -> Action
    PGTF.toField (PGArray P -> Action) -> PGArray P -> Action
    forall a b. (a -> b) -> a -> b
    $ [P] -> PGArray P
    forall a. [a] -> PGArray a
    PG.PGArray ([P] -> PGArray P) -> [P] -> PGArray P
    forall a b. (a -> b) -> a -> b
    $ PersistValue -> P
    P (PersistValue -> P) -> [PersistValue] -> [P]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [PersistValue]
    a
        toField (P (PersistObjectId StrictByteString
    _)) =
            [Char] -> Action
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Refusing to serialize a PersistObjectId to a PostgreSQL value"

    instance PGFF.FromField P where
        fromField :: FieldParser P
    fromField Field
    field Maybe StrictByteString
    mdata = (PersistValue -> P) -> Conversion PersistValue -> Conversion P
    forall a b. (a -> b) -> Conversion a -> Conversion b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PersistValue -> P
    P (Conversion PersistValue -> Conversion P)
    -> Conversion PersistValue -> Conversion P
    forall a b. (a -> b) -> a -> b
    $ case Maybe StrictByteString
    mdata of
            -- If we try to simply decode based on oid, we will hit unexpected null
            -- errors.
            Maybe StrictByteString
    Nothing -> PersistValue -> Conversion PersistValue
    forall a. a -> Conversion a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PersistValue
    PersistNull
            Maybe StrictByteString
    data' -> Oid -> Getter PersistValue
    getGetter (Field -> Oid
    PGFF.typeOid Field
    field) Field
    field Maybe StrictByteString
    data'

    newtype Unknown = Unknown {Unknown -> StrictByteString
    unUnknown :: ByteString}
        deriving (Unknown -> Unknown -> Bool
    (Unknown -> Unknown -> Bool)
    -> (Unknown -> Unknown -> Bool) -> Eq Unknown
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Unknown -> Unknown -> Bool
    == :: Unknown -> Unknown -> Bool
    $c/= :: Unknown -> Unknown -> Bool
    /= :: Unknown -> Unknown -> Bool
    Eq, Int -> Unknown -> ShowS
    [Unknown] -> ShowS
    Unknown -> [Char]
    (Int -> Unknown -> ShowS)
    -> (Unknown -> [Char]) -> ([Unknown] -> ShowS) -> Show Unknown
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Unknown -> ShowS
    showsPrec :: Int -> Unknown -> ShowS
    $cshow :: Unknown -> [Char]
    show :: Unknown -> [Char]
    $cshowList :: [Unknown] -> ShowS
    showList :: [Unknown] -> ShowS
    Show, ReadPrec [Unknown]
    ReadPrec Unknown
    Int -> ReadS Unknown
    ReadS [Unknown]
    (Int -> ReadS Unknown)
    -> ReadS [Unknown]
    -> ReadPrec Unknown
    -> ReadPrec [Unknown]
    -> Read Unknown
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Unknown
    readsPrec :: Int -> ReadS Unknown
    $creadList :: ReadS [Unknown]
    readList :: ReadS [Unknown]
    $creadPrec :: ReadPrec Unknown
    readPrec :: ReadPrec Unknown
    $creadListPrec :: ReadPrec [Unknown]
    readListPrec :: ReadPrec [Unknown]
    Read, Eq Unknown
    Eq Unknown =>
    (Unknown -> Unknown -> Ordering)
    -> (Unknown -> Unknown -> Bool)
    -> (Unknown -> Unknown -> Bool)
    -> (Unknown -> Unknown -> Bool)
    -> (Unknown -> Unknown -> Bool)
    -> (Unknown -> Unknown -> Unknown)
    -> (Unknown -> Unknown -> Unknown)
    -> Ord Unknown
    Unknown -> Unknown -> Bool
    Unknown -> Unknown -> Ordering
    Unknown -> Unknown -> Unknown
    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
    $ccompare :: Unknown -> Unknown -> Ordering
    compare :: Unknown -> Unknown -> Ordering
    $c< :: Unknown -> Unknown -> Bool
    < :: Unknown -> Unknown -> Bool
    $c<= :: Unknown -> Unknown -> Bool
    <= :: Unknown -> Unknown -> Bool
    $c> :: Unknown -> Unknown -> Bool
    > :: Unknown -> Unknown -> Bool
    $c>= :: Unknown -> Unknown -> Bool
    >= :: Unknown -> Unknown -> Bool
    $cmax :: Unknown -> Unknown -> Unknown
    max :: Unknown -> Unknown -> Unknown
    $cmin :: Unknown -> Unknown -> Unknown
    min :: Unknown -> Unknown -> Unknown
    Ord)

    instance PGFF.FromField Unknown where
        fromField :: FieldParser Unknown
    fromField Field
    f Maybe StrictByteString
    mdata =
            case Maybe StrictByteString
    mdata of
                Maybe StrictByteString
    Nothing ->
                    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError)
    -> Field -> [Char] -> Conversion Unknown
    forall a err.
    (Typeable a, Exception err) =>
    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> err)
    -> Field -> [Char] -> Conversion a
    PGFF.returnError
                        [Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError
    PGFF.UnexpectedNull
                        Field
    f
                        [Char]
    "Database.Persist.Postgresql/PGFF.FromField Unknown"
                Just StrictByteString
    dat -> Unknown -> Conversion Unknown
    forall a. a -> Conversion a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StrictByteString -> Unknown
    Unknown StrictByteString
    dat)

    instance PGTF.ToField Unknown where
        toField :: Unknown -> Action
    toField (Unknown StrictByteString
    a) = StrictByteString -> Action
    PGTF.Escape StrictByteString
    a

    newtype UnknownLiteral = UnknownLiteral {UnknownLiteral -> StrictByteString
    unUnknownLiteral :: ByteString}
        deriving (UnknownLiteral -> UnknownLiteral -> Bool
    (UnknownLiteral -> UnknownLiteral -> Bool)
    -> (UnknownLiteral -> UnknownLiteral -> Bool) -> Eq UnknownLiteral
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnknownLiteral -> UnknownLiteral -> Bool
    == :: UnknownLiteral -> UnknownLiteral -> Bool
    $c/= :: UnknownLiteral -> UnknownLiteral -> Bool
    /= :: UnknownLiteral -> UnknownLiteral -> Bool
    Eq, Int -> UnknownLiteral -> ShowS
    [UnknownLiteral] -> ShowS
    UnknownLiteral -> [Char]
    (Int -> UnknownLiteral -> ShowS)
    -> (UnknownLiteral -> [Char])
    -> ([UnknownLiteral] -> ShowS)
    -> Show UnknownLiteral
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnknownLiteral -> ShowS
    showsPrec :: Int -> UnknownLiteral -> ShowS
    $cshow :: UnknownLiteral -> [Char]
    show :: UnknownLiteral -> [Char]
    $cshowList :: [UnknownLiteral] -> ShowS
    showList :: [UnknownLiteral] -> ShowS
    Show, ReadPrec [UnknownLiteral]
    ReadPrec UnknownLiteral
    Int -> ReadS UnknownLiteral
    ReadS [UnknownLiteral]
    (Int -> ReadS UnknownLiteral)
    -> ReadS [UnknownLiteral]
    -> ReadPrec UnknownLiteral
    -> ReadPrec [UnknownLiteral]
    -> Read UnknownLiteral
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS UnknownLiteral
    readsPrec :: Int -> ReadS UnknownLiteral
    $creadList :: ReadS [UnknownLiteral]
    readList :: ReadS [UnknownLiteral]
    $creadPrec :: ReadPrec UnknownLiteral
    readPrec :: ReadPrec UnknownLiteral
    $creadListPrec :: ReadPrec [UnknownLiteral]
    readListPrec :: ReadPrec [UnknownLiteral]
    Read, Eq UnknownLiteral
    Eq UnknownLiteral =>
    (UnknownLiteral -> UnknownLiteral -> Ordering)
    -> (UnknownLiteral -> UnknownLiteral -> Bool)
    -> (UnknownLiteral -> UnknownLiteral -> Bool)
    -> (UnknownLiteral -> UnknownLiteral -> Bool)
    -> (UnknownLiteral -> UnknownLiteral -> Bool)
    -> (UnknownLiteral -> UnknownLiteral -> UnknownLiteral)
    -> (UnknownLiteral -> UnknownLiteral -> UnknownLiteral)
    -> Ord UnknownLiteral
    UnknownLiteral -> UnknownLiteral -> Bool
    UnknownLiteral -> UnknownLiteral -> Ordering
    UnknownLiteral -> UnknownLiteral -> UnknownLiteral
    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
    $ccompare :: UnknownLiteral -> UnknownLiteral -> Ordering
    compare :: UnknownLiteral -> UnknownLiteral -> Ordering
    $c< :: UnknownLiteral -> UnknownLiteral -> Bool
    < :: UnknownLiteral -> UnknownLiteral -> Bool
    $c<= :: UnknownLiteral -> UnknownLiteral -> Bool
    <= :: UnknownLiteral -> UnknownLiteral -> Bool
    $c> :: UnknownLiteral -> UnknownLiteral -> Bool
    > :: UnknownLiteral -> UnknownLiteral -> Bool
    $c>= :: UnknownLiteral -> UnknownLiteral -> Bool
    >= :: UnknownLiteral -> UnknownLiteral -> Bool
    $cmax :: UnknownLiteral -> UnknownLiteral -> UnknownLiteral
    max :: UnknownLiteral -> UnknownLiteral -> UnknownLiteral
    $cmin :: UnknownLiteral -> UnknownLiteral -> UnknownLiteral
    min :: UnknownLiteral -> UnknownLiteral -> UnknownLiteral
    Ord, Typeable)

    instance PGFF.FromField UnknownLiteral where
        fromField :: FieldParser UnknownLiteral
    fromField Field
    f Maybe StrictByteString
    mdata =
            case Maybe StrictByteString
    mdata of
                Maybe StrictByteString
    Nothing ->
                    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError)
    -> Field -> [Char] -> Conversion UnknownLiteral
    forall a err.
    (Typeable a, Exception err) =>
    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> err)
    -> Field -> [Char] -> Conversion a
    PGFF.returnError
                        [Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError
    PGFF.UnexpectedNull
                        Field
    f
                        [Char]
    "Database.Persist.Postgresql/PGFF.FromField UnknownLiteral"
                Just StrictByteString
    dat -> UnknownLiteral -> Conversion UnknownLiteral
    forall a. a -> Conversion a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (StrictByteString -> UnknownLiteral
    UnknownLiteral StrictByteString
    dat)

    instance PGTF.ToField UnknownLiteral where
        toField :: UnknownLiteral -> Action
    toField (UnknownLiteral StrictByteString
    a) = Builder -> Action
    PGTF.Plain (Builder -> Action) -> Builder -> Action
    forall a b. (a -> b) -> a -> b
    $ StrictByteString -> Builder
    BB.byteString StrictByteString
    a

    type Getter a = PGFF.FieldParser a

    convertPV :: (PGFF.FromField a) => (a -> b) -> Getter b
    convertPV :: forall a b. FromField a => (a -> b) -> Getter b
    convertPV a -> b
    f = ((a -> b) -> Conversion a -> Conversion b
    forall a b. (a -> b) -> Conversion a -> Conversion b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Conversion a -> Conversion b)
    -> (Maybe StrictByteString -> Conversion a)
    -> Maybe StrictByteString
    -> Conversion b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .) ((Maybe StrictByteString -> Conversion a)
     -> Maybe StrictByteString -> Conversion b)
    -> (Field -> Maybe StrictByteString -> Conversion a)
    -> Field
    -> Maybe StrictByteString
    -> Conversion b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Field -> Maybe StrictByteString -> Conversion a
    forall a. FromField a => FieldParser a
    PGFF.fromField

    builtinGetters :: I.IntMap (Getter PersistValue)
    builtinGetters :: IntMap (Getter PersistValue)
    builtinGetters =
        [(Int, Getter PersistValue)] -> IntMap (Getter PersistValue)
    forall a. [(Int, a)] -> IntMap a
    I.fromList
            [ (TypeInfo -> Int
    k TypeInfo
    PS.bool, (Bool -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Bool -> PersistValue
    PersistBool)
            , (TypeInfo -> Int
    k TypeInfo
    PS.bytea, (Binary StrictByteString -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Binary StrictByteString -> StrictByteString)
    -> Binary StrictByteString
    -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Binary StrictByteString -> StrictByteString
    forall a. Binary a -> a
    unBinary))
            , (TypeInfo -> Int
    k TypeInfo
    PS.char, (Text -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Text -> PersistValue
    PersistText)
            , (TypeInfo -> Int
    k TypeInfo
    PS.name, (Text -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Text -> PersistValue
    PersistText)
            , (TypeInfo -> Int
    k TypeInfo
    PS.int8, (Int64 -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Int64 -> PersistValue
    PersistInt64)
            , (TypeInfo -> Int
    k TypeInfo
    PS.int2, (Int64 -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Int64 -> PersistValue
    PersistInt64)
            , (TypeInfo -> Int
    k TypeInfo
    PS.int4, (Int64 -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Int64 -> PersistValue
    PersistInt64)
            , (TypeInfo -> Int
    k TypeInfo
    PS.text, (Text -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Text -> PersistValue
    PersistText)
            , (TypeInfo -> Int
    k TypeInfo
    PS.xml, (Unknown -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , (TypeInfo -> Int
    k TypeInfo
    PS.float4, (Double -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Double -> PersistValue
    PersistDouble)
            , (TypeInfo -> Int
    k TypeInfo
    PS.float8, (Double -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Double -> PersistValue
    PersistDouble)
            , (TypeInfo -> Int
    k TypeInfo
    PS.money, (Rational -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Rational -> PersistValue
    PersistRational)
            , (TypeInfo -> Int
    k TypeInfo
    PS.bpchar, (Text -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Text -> PersistValue
    PersistText)
            , (TypeInfo -> Int
    k TypeInfo
    PS.varchar, (Text -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Text -> PersistValue
    PersistText)
            , (TypeInfo -> Int
    k TypeInfo
    PS.date, (Day -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Day -> PersistValue
    PersistDay)
            , (TypeInfo -> Int
    k TypeInfo
    PS.time, (TimeOfDay -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV TimeOfDay -> PersistValue
    PersistTimeOfDay)
            , (TypeInfo -> Int
    k TypeInfo
    PS.timestamp, (LocalTime -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (UTCTime -> PersistValue
    PersistUTCTime (UTCTime -> PersistValue)
    -> (LocalTime -> UTCTime) -> LocalTime -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeZone -> LocalTime -> UTCTime
    localTimeToUTC TimeZone
    utc))
            , (TypeInfo -> Int
    k TypeInfo
    PS.timestamptz, (UTCTime -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV UTCTime -> PersistValue
    PersistUTCTime)
            , (TypeInfo -> Int
    k TypeInfo
    PS.interval, (PgInterval -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistLiteralEscaped (StrictByteString -> PersistValue)
    -> (PgInterval -> StrictByteString) -> PgInterval -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PgInterval -> StrictByteString
    pgIntervalToBs))
            , (TypeInfo -> Int
    k TypeInfo
    PS.bit, (Int64 -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Int64 -> PersistValue
    PersistInt64)
            , (TypeInfo -> Int
    k TypeInfo
    PS.varbit, (Int64 -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Int64 -> PersistValue
    PersistInt64)
            , (TypeInfo -> Int
    k TypeInfo
    PS.numeric, (Rational -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV Rational -> PersistValue
    PersistRational)
            , (TypeInfo -> Int
    k TypeInfo
    PS.void, \Field
    _ Maybe StrictByteString
    _ -> PersistValue -> Conversion PersistValue
    forall a. a -> Conversion a
    forall (m :: * -> *) a. Monad m => a -> m a
    return PersistValue
    PersistNull)
            , (TypeInfo -> Int
    k TypeInfo
    PS.json, (Unknown -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , (TypeInfo -> Int
    k TypeInfo
    PS.jsonb, (Unknown -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , (TypeInfo -> Int
    k TypeInfo
    PS.unknown, (Unknown -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , -- Array types: same order as above.
              -- The OIDs were taken from pg_type.
              (Int
    1000, (Bool -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Bool -> PersistValue
    PersistBool)
            , (Int
    1001, (Binary StrictByteString -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Binary StrictByteString -> StrictByteString)
    -> Binary StrictByteString
    -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Binary StrictByteString -> StrictByteString
    forall a. Binary a -> a
    unBinary))
            , (Int
    1002, (Text -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Text -> PersistValue
    PersistText)
            , (Int
    1003, (Text -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Text -> PersistValue
    PersistText)
            , (Int
    1016, (Int64 -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Int64 -> PersistValue
    PersistInt64)
            , (Int
    1005, (Int64 -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Int64 -> PersistValue
    PersistInt64)
            , (Int
    1007, (Int64 -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Int64 -> PersistValue
    PersistInt64)
            , (Int
    1009, (Text -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Text -> PersistValue
    PersistText)
            , (Int
    143, (Unknown -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , (Int
    1021, (Double -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Double -> PersistValue
    PersistDouble)
            , (Int
    1022, (Double -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Double -> PersistValue
    PersistDouble)
            , (Int
    1023, (UTCTime -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf UTCTime -> PersistValue
    PersistUTCTime)
            , (Int
    1024, (UTCTime -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf UTCTime -> PersistValue
    PersistUTCTime)
            , (Int
    791, (Rational -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Rational -> PersistValue
    PersistRational)
            , (Int
    1014, (Text -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Text -> PersistValue
    PersistText)
            , (Int
    1015, (Text -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Text -> PersistValue
    PersistText)
            , (Int
    1182, (Day -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Day -> PersistValue
    PersistDay)
            , (Int
    1183, (TimeOfDay -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf TimeOfDay -> PersistValue
    PersistTimeOfDay)
            , (Int
    1115, (UTCTime -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf UTCTime -> PersistValue
    PersistUTCTime)
            , (Int
    1185, (UTCTime -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf UTCTime -> PersistValue
    PersistUTCTime)
            , (Int
    1187, (PgInterval -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf (StrictByteString -> PersistValue
    PersistLiteralEscaped (StrictByteString -> PersistValue)
    -> (PgInterval -> StrictByteString) -> PgInterval -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PgInterval -> StrictByteString
    pgIntervalToBs))
            , (Int
    1561, (Int64 -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Int64 -> PersistValue
    PersistInt64)
            , (Int
    1563, (Int64 -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Int64 -> PersistValue
    PersistInt64)
            , (Int
    1231, (Rational -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf Rational -> PersistValue
    PersistRational)
            , -- no array(void) type
              (Int
    2951, (Unknown -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf (StrictByteString -> PersistValue
    PersistLiteralEscaped (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , (Int
    199, (Unknown -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            , (Int
    3807, (Unknown -> PersistValue) -> Getter PersistValue
    forall {a}.
    (FromField a, Typeable a) =>
    (a -> PersistValue) -> Getter PersistValue
    listOf (StrictByteString -> PersistValue
    PersistByteString (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown))
            -- no array(unknown) either
            ]
      where
        k :: TypeInfo -> Int
    k (TypeInfo -> Oid
    PGFF.typoid -> Oid
    i) = Oid -> Int
    PG.oid2int Oid
    i
        -- A @listOf f@ will use a @PGArray (Maybe T)@ to convert
        -- the values to Haskell-land.  The @Maybe@ is important
        -- because the usual way of checking NULLs
        -- (c.f. withStmt') won't check for NULL inside
        -- arrays---or any other compound structure for that matter.
        listOf :: (a -> PersistValue) -> Getter PersistValue
    listOf a -> PersistValue
    f = (PGArray (Maybe a) -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV ([PersistValue] -> PersistValue
    PersistList ([PersistValue] -> PersistValue)
    -> (PGArray (Maybe a) -> [PersistValue])
    -> PGArray (Maybe a)
    -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe a -> PersistValue) -> [Maybe a] -> [PersistValue]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> PersistValue) -> Maybe a -> PersistValue
    forall {a}. (a -> PersistValue) -> Maybe a -> PersistValue
    nullable a -> PersistValue
    f) ([Maybe a] -> [PersistValue])
    -> (PGArray (Maybe a) -> [Maybe a])
    -> PGArray (Maybe a)
    -> [PersistValue]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PGArray (Maybe a) -> [Maybe a]
    forall a. PGArray a -> [a]
    PG.fromPGArray)
          where
            nullable :: (a -> PersistValue) -> Maybe a -> PersistValue
    nullable = PersistValue -> (a -> PersistValue) -> Maybe a -> PersistValue
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe PersistValue
    PersistNull

    -- | Get the field parser corresponding to the given 'PG.Oid'.
    --
    -- For example, pass in the 'PG.Oid' of 'PS.bool', and you will get back a
    -- field parser which parses boolean values in the table into 'PersistBool's.
    --
    -- @since 2.13.2.0
    getGetter :: PG.Oid -> Getter PersistValue
    getGetter :: Oid -> Getter PersistValue
    getGetter Oid
    oid =
        Getter PersistValue
    -> Maybe (Getter PersistValue) -> Getter PersistValue
    forall a. a -> Maybe a -> a
    fromMaybe Getter PersistValue
    defaultGetter (Maybe (Getter PersistValue) -> Getter PersistValue)
    -> Maybe (Getter PersistValue) -> Getter PersistValue
    forall a b. (a -> b) -> a -> b
    $ Int -> IntMap (Getter PersistValue) -> Maybe (Getter PersistValue)
    forall a. Int -> IntMap a -> Maybe a
    I.lookup (Oid -> Int
    PG.oid2int Oid
    oid) IntMap (Getter PersistValue)
    builtinGetters
      where
        defaultGetter :: Getter PersistValue
    defaultGetter = (Unknown -> PersistValue) -> Getter PersistValue
    forall a b. FromField a => (a -> b) -> Getter b
    convertPV (StrictByteString -> PersistValue
    PersistLiteralEscaped (StrictByteString -> PersistValue)
    -> (Unknown -> StrictByteString) -> Unknown -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Unknown -> StrictByteString
    unUnknown)

    unBinary :: PG.Binary a -> a
    unBinary :: forall a. Binary a -> a
    unBinary (PG.Binary a
    x) = a
    x

    -- | Represent Postgres interval using NominalDiffTime
    --
    -- @since 2.11.0.0
    newtype PgInterval = PgInterval {PgInterval -> NominalDiffTime
    getPgInterval :: NominalDiffTime}
        deriving (PgInterval -> PgInterval -> Bool
    (PgInterval -> PgInterval -> Bool)
    -> (PgInterval -> PgInterval -> Bool) -> Eq PgInterval
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PgInterval -> PgInterval -> Bool
    == :: PgInterval -> PgInterval -> Bool
    $c/= :: PgInterval -> PgInterval -> Bool
    /= :: PgInterval -> PgInterval -> Bool
    Eq, Int -> PgInterval -> ShowS
    [PgInterval] -> ShowS
    PgInterval -> [Char]
    (Int -> PgInterval -> ShowS)
    -> (PgInterval -> [Char])
    -> ([PgInterval] -> ShowS)
    -> Show PgInterval
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PgInterval -> ShowS
    showsPrec :: Int -> PgInterval -> ShowS
    $cshow :: PgInterval -> [Char]
    show :: PgInterval -> [Char]
    $cshowList :: [PgInterval] -> ShowS
    showList :: [PgInterval] -> ShowS
    Show)

    pgIntervalToBs :: PgInterval -> ByteString
    pgIntervalToBs :: PgInterval -> StrictByteString
    pgIntervalToBs = [Char] -> StrictByteString
    forall a.
    ConvertibleStrings a StrictByteString =>
    a -> StrictByteString
    toStrictByteString ([Char] -> StrictByteString)
    -> (PgInterval -> [Char]) -> PgInterval -> StrictByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NominalDiffTime -> [Char]
    forall a. Show a => a -> [Char]
    show (NominalDiffTime -> [Char])
    -> (PgInterval -> NominalDiffTime) -> PgInterval -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PgInterval -> NominalDiffTime
    getPgInterval

    instance PGTF.ToField PgInterval where
        toField :: PgInterval -> Action
    toField (PgInterval NominalDiffTime
    t) = NominalDiffTime -> Action
    forall a. ToField a => a -> Action
    PGTF.toField NominalDiffTime
    t

    instance PGFF.FromField PgInterval where
        fromField :: FieldParser PgInterval
    fromField Field
    f Maybe StrictByteString
    mdata =
            if Field -> Oid
    PGFF.typeOid Field
    f Oid -> Oid -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TypeInfo -> Oid
    PS.typoid TypeInfo
    PS.interval
                then ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError)
    -> Field -> [Char] -> Conversion PgInterval
    forall a err.
    (Typeable a, Exception err) =>
    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> err)
    -> Field -> [Char] -> Conversion a
    PGFF.returnError [Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError
    PGFF.Incompatible Field
    f [Char]
    ""
                else case Maybe StrictByteString
    mdata of
                    Maybe StrictByteString
    Nothing -> ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError)
    -> Field -> [Char] -> Conversion PgInterval
    forall a err.
    (Typeable a, Exception err) =>
    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> err)
    -> Field -> [Char] -> Conversion a
    PGFF.returnError [Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError
    PGFF.UnexpectedNull Field
    f [Char]
    ""
                    Just StrictByteString
    dat -> case Parser NominalDiffTime
    -> StrictByteString -> Either [Char] NominalDiffTime
    forall a. Parser a -> StrictByteString -> Either [Char] a
    P.parseOnly (Parser NominalDiffTime
    nominalDiffTime Parser NominalDiffTime
    -> Parser StrictByteString () -> Parser NominalDiffTime
    forall a b.
    Parser StrictByteString a
    -> Parser StrictByteString b -> Parser StrictByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser StrictByteString ()
    forall t. Chunk t => Parser t ()
    P.endOfInput) StrictByteString
    dat of
                        Left [Char]
    msg -> ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError)
    -> Field -> [Char] -> Conversion PgInterval
    forall a err.
    (Typeable a, Exception err) =>
    ([Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> err)
    -> Field -> [Char] -> Conversion a
    PGFF.returnError [Char] -> Maybe Oid -> [Char] -> [Char] -> [Char] -> ResultError
    PGFF.ConversionFailed Field
    f [Char]
    msg
                        Right NominalDiffTime
    t -> PgInterval -> Conversion PgInterval
    forall a. a -> Conversion a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PgInterval -> Conversion PgInterval)
    -> PgInterval -> Conversion PgInterval
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> PgInterval
    PgInterval NominalDiffTime
    t
          where
            toPico :: Integer -> Pico
            toPico :: Integer -> Pico
    toPico = Integer -> Pico
    forall k (a :: k). Integer -> Fixed a
    MkFixed

            -- Taken from Database.PostgreSQL.Simple.Time.Internal.Parser
            twoDigits :: P.Parser Int
            twoDigits :: Parser Int
    twoDigits = do
                a <- Parser Char
    P.digit
                b <- P.digit
                let
                    c2d Char
    c = Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    15
                return $! c2d a * 10 + c2d b

            -- Taken from Database.PostgreSQL.Simple.Time.Internal.Parser
            seconds :: P.Parser Pico
            seconds :: Parser Pico
    seconds = do
                real <- Parser Int
    twoDigits
                mc <- P.peekChar
                case mc of
                    Just Char
    '.' -> do
                        t <- Parser Char
    P.anyChar Parser Char
    -> Parser StrictByteString StrictByteString
    -> Parser StrictByteString StrictByteString
    forall a b.
    Parser StrictByteString a
    -> Parser StrictByteString b -> Parser StrictByteString b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Char -> Bool) -> Parser StrictByteString StrictByteString
    P.takeWhile1 Char -> Bool
    P.isDigit
                        return $! parsePicos (fromIntegral real) t
                    Maybe Char
    _ -> Pico -> Parser Pico
    forall a. a -> Parser StrictByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pico -> Parser Pico) -> Pico -> Parser Pico
    forall a b. (a -> b) -> a -> b
    $! Int -> Pico
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    real
              where
                parsePicos :: Int64 -> B8.ByteString -> Pico
                parsePicos :: Int64 -> StrictByteString -> Pico
    parsePicos Int64
    a0 StrictByteString
    t = Integer -> Pico
    toPico (Int64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64
    t' Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    10 Int64 -> Int -> Int64
    forall a b. (Num a, Integral b) => a -> b -> a
    ^ Int
    n))
                  where
                    n :: Int
    n = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    0 (Int
    12 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - StrictByteString -> Int
    B8.length StrictByteString
    t)
                    t' :: Int64
    t' =
                        (Int64 -> Char -> Int64) -> Int64 -> StrictByteString -> Int64
    forall a. (a -> Char -> a) -> a -> StrictByteString -> a
    B8.foldl'
                            (\Int64
    a Char
    c -> Int64
    10 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    a Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Char -> Int
    ord Char
    c Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    15))
                            Int64
    a0
                            (Int -> StrictByteString -> StrictByteString
    B8.take Int
    12 StrictByteString
    t)

            parseSign :: P.Parser Bool
            parseSign :: Parser Bool
    parseSign = [Parser Bool] -> Parser Bool
    forall (f :: * -> *) a. Alternative f => [f a] -> f a
    P.choice [Char -> Parser Char
    P.char Char
    '-' Parser Char -> Parser Bool -> Parser Bool
    forall a b.
    Parser StrictByteString a
    -> Parser StrictByteString b -> Parser StrictByteString b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> Parser Bool
    forall a. a -> Parser StrictByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True, Bool -> Parser Bool
    forall a. a -> Parser StrictByteString a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False]

            -- Db stores it in [-]HHH:MM:SS.[SSSS]
            -- For example, nominalDay is stored as 24:00:00
            interval :: P.Parser (Bool, Int, Int, Pico)
            interval :: Parser (Bool, Int, Int, Pico)
    interval = do
                s <- Parser Bool
    parseSign
                h <- P.decimal <* P.char ':'
                m <- twoDigits <* P.char ':'
                ss <- seconds
                if m < 60 && ss <= 60
                    then return (s, h, m, ss)
                    else fail "Invalid interval"

            nominalDiffTime :: P.Parser NominalDiffTime
            nominalDiffTime :: Parser NominalDiffTime
    nominalDiffTime = do
                (s, h, m, ss) <- Parser (Bool, Int, Int, Pico)
    interval
                let
                    pico = Pico
    ss Pico -> Pico -> Pico
    forall a. Num a => a -> a -> a
    + Pico
    60 Pico -> Pico -> Pico
    forall a. Num a => a -> a -> a
    * (Int -> Pico
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    m) Pico -> Pico -> Pico
    forall a. Num a => a -> a -> a
    + Pico
    60 Pico -> Pico -> Pico
    forall a. Num a => a -> a -> a
    * Pico
    60 Pico -> Pico -> Pico
    forall a. Num a => a -> a -> a
    * (Int -> Pico
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int
    forall a. Num a => a -> a
    abs Int
    h))
                return . fromRational . toRational $ if s then (-pico) else pico

    fromPersistValueError
        :: Text
        -- ^ Haskell type, should match Haskell name exactly, e.g. "Int64"
        -> Text
        -- ^ Database type(s), should appear different from Haskell name, e.g. "integer" or "INT", not "Int".
        -> PersistValue
        -- ^ Incorrect value
        -> Text
        -- ^ Error message
    fromPersistValueError :: Text -> Text -> PersistValue -> Text
    fromPersistValueError Text
    haskellType Text
    databaseType PersistValue
    received =
        [Text] -> Text
    T.concat
            [ Text
    "Failed to parse Haskell type `"
            , Text
    haskellType
            , Text
    "`; expected "
            , Text
    databaseType
            , Text
    " from database, but received: "
            , [Char] -> Text
    T.pack (PersistValue -> [Char]
    forall a. Show a => a -> [Char]
    show PersistValue
    received)
            , Text
    ". Potential solution: Check that your database schema matches your Persistent model definitions."
            ]

    instance PersistField PgInterval where
        toPersistValue :: PgInterval -> PersistValue
    toPersistValue = StrictByteString -> PersistValue
    PersistLiteralEscaped (StrictByteString -> PersistValue)
    -> (PgInterval -> StrictByteString) -> PgInterval -> PersistValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PgInterval -> StrictByteString
    pgIntervalToBs
        fromPersistValue :: PersistValue -> Either Text PgInterval
    fromPersistValue (PersistLiteral_ LiteralType
    DbSpecific StrictByteString
    bs) =
            PersistValue -> Either Text PgInterval
    forall a. PersistField a => PersistValue -> Either Text a
    fromPersistValue (StrictByteString -> PersistValue
    PersistLiteralEscaped StrictByteString
    bs)
        fromPersistValue x :: PersistValue
    x@(PersistLiteral_ LiteralType
    Escaped StrictByteString
    bs) =
            case Parser NominalDiffTime
    -> StrictByteString -> Either [Char] NominalDiffTime
    forall a. Parser a -> StrictByteString -> Either [Char] a
    P.parseOnly (Parser NominalDiffTime -> Parser NominalDiffTime
    forall a. Num a => Parser a -> Parser a
    P.signed Parser NominalDiffTime
    forall a. Fractional a => Parser a
    P.rational Parser NominalDiffTime -> Parser Char -> Parser NominalDiffTime
    forall a b.
    Parser StrictByteString a
    -> Parser StrictByteString b -> Parser StrictByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Char -> Parser Char
    P.char Char
    's' Parser NominalDiffTime
    -> Parser StrictByteString () -> Parser NominalDiffTime
    forall a b.
    Parser StrictByteString a
    -> Parser StrictByteString b -> Parser StrictByteString a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser StrictByteString ()
    forall t. Chunk t => Parser t ()
    P.endOfInput) StrictByteString
    bs of
                Left [Char]
    _ -> Text -> Either Text PgInterval
    forall a b. a -> Either a b
    Left (Text -> Either Text PgInterval) -> Text -> Either Text PgInterval
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PersistValue -> Text
    fromPersistValueError Text
    "PgInterval" Text
    "Interval" PersistValue
    x
                Right NominalDiffTime
    i -> PgInterval -> Either Text PgInterval
    forall a b. b -> Either a b
    Right (PgInterval -> Either Text PgInterval)
    -> PgInterval -> Either Text PgInterval
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> PgInterval
    PgInterval NominalDiffTime
    i
        fromPersistValue PersistValue
    x = Text -> Either Text PgInterval
    forall a b. a -> Either a b
    Left (Text -> Either Text PgInterval) -> Text -> Either Text PgInterval
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> PersistValue -> Text
    fromPersistValueError Text
    "PgInterval" Text
    "Interval" PersistValue
    x

    instance PersistFieldSql PgInterval where
        sqlType :: Proxy PgInterval -> SqlType
    sqlType Proxy PgInterval
    _ = Text -> SqlType
    SqlOther Text
    "interval"

    -- | Indicates whether a Postgres Column is safe to drop.
    --
    -- @since 2.17.1.0
    newtype SafeToRemove = SafeToRemove Bool
        deriving (Int -> SafeToRemove -> ShowS
    [SafeToRemove] -> ShowS
    SafeToRemove -> [Char]
    (Int -> SafeToRemove -> ShowS)
    -> (SafeToRemove -> [Char])
    -> ([SafeToRemove] -> ShowS)
    -> Show SafeToRemove
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> SafeToRemove -> ShowS
    showsPrec :: Int -> SafeToRemove -> ShowS
    $cshow :: SafeToRemove -> [Char]
    show :: SafeToRemove -> [Char]
    $cshowList :: [SafeToRemove] -> ShowS
    showList :: [SafeToRemove] -> ShowS
    Show, SafeToRemove -> SafeToRemove -> Bool
    (SafeToRemove -> SafeToRemove -> Bool)
    -> (SafeToRemove -> SafeToRemove -> Bool) -> Eq SafeToRemove
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SafeToRemove -> SafeToRemove -> Bool
    == :: SafeToRemove -> SafeToRemove -> Bool
    $c/= :: SafeToRemove -> SafeToRemove -> Bool
    /= :: SafeToRemove -> SafeToRemove -> Bool
    Eq)

    -- | Represents a change to a Postgres column in a DB statement.
    --
    -- @since 2.17.1.0
    data AlterColumn
        = ChangeType Column SqlType Text
        | IsNull Column
        | NotNull Column
        | AddColumn Column
        | Drop Column SafeToRemove
        | Default Column Text
        | NoDefault Column
        | UpdateNullToValue Column Text
        | AddReference
            EntityNameDB
            ConstraintNameDB
            (NEL.NonEmpty FieldNameDB)
            [Text]
            FieldCascade
        | DropReference ConstraintNameDB
        deriving (Int -> AlterColumn -> ShowS
    [AlterColumn] -> ShowS
    AlterColumn -> [Char]
    (Int -> AlterColumn -> ShowS)
    -> (AlterColumn -> [Char])
    -> ([AlterColumn] -> ShowS)
    -> Show AlterColumn
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AlterColumn -> ShowS
    showsPrec :: Int -> AlterColumn -> ShowS
    $cshow :: AlterColumn -> [Char]
    show :: AlterColumn -> [Char]
    $cshowList :: [AlterColumn] -> ShowS
    showList :: [AlterColumn] -> ShowS
    Show, AlterColumn -> AlterColumn -> Bool
    (AlterColumn -> AlterColumn -> Bool)
    -> (AlterColumn -> AlterColumn -> Bool) -> Eq AlterColumn
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AlterColumn -> AlterColumn -> Bool
    == :: AlterColumn -> AlterColumn -> Bool
    $c/= :: AlterColumn -> AlterColumn -> Bool
    /= :: AlterColumn -> AlterColumn -> Bool
    Eq)

    -- | Represents a change to a Postgres table in a DB statement.
    --
    -- @since 2.17.1.0
    data AlterTable
        = AddUniqueConstraint ConstraintNameDB [FieldNameDB]
        | DropConstraint ConstraintNameDB
        deriving (Int -> AlterTable -> ShowS
    [AlterTable] -> ShowS
    AlterTable -> [Char]
    (Int -> AlterTable -> ShowS)
    -> (AlterTable -> [Char])
    -> ([AlterTable] -> ShowS)
    -> Show AlterTable
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AlterTable -> ShowS
    showsPrec :: Int -> AlterTable -> ShowS
    $cshow :: AlterTable -> [Char]
    show :: AlterTable -> [Char]
    $cshowList :: [AlterTable] -> ShowS
    showList :: [AlterTable] -> ShowS
    Show, AlterTable -> AlterTable -> Bool
    (AlterTable -> AlterTable -> Bool)
    -> (AlterTable -> AlterTable -> Bool) -> Eq AlterTable
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AlterTable -> AlterTable -> Bool
    == :: AlterTable -> AlterTable -> Bool
    $c/= :: AlterTable -> AlterTable -> Bool
    /= :: AlterTable -> AlterTable -> Bool
    Eq)

    -- | Represents a change to a Postgres DB in a statement.
    --
    -- @since 2.17.1.0
    data AlterDB
        = AddTable EntityNameDB EntityIdDef [Column]
        | AlterColumn EntityNameDB AlterColumn
        | AlterTable EntityNameDB AlterTable
        deriving (Int -> AlterDB -> ShowS
    [AlterDB] -> ShowS
    AlterDB -> [Char]
    (Int -> AlterDB -> ShowS)
    -> (AlterDB -> [Char]) -> ([AlterDB] -> ShowS) -> Show AlterDB
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> AlterDB -> ShowS
    showsPrec :: Int -> AlterDB -> ShowS
    $cshow :: AlterDB -> [Char]
    show :: AlterDB -> [Char]
    $cshowList :: [AlterDB] -> ShowS
    showList :: [AlterDB] -> ShowS
    Show, AlterDB -> AlterDB -> Bool
    (AlterDB -> AlterDB -> Bool)
    -> (AlterDB -> AlterDB -> Bool) -> Eq AlterDB
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AlterDB -> AlterDB -> Bool
    == :: AlterDB -> AlterDB -> Bool
    $c/= :: AlterDB -> AlterDB -> Bool
    /= :: AlterDB -> AlterDB -> Bool
    Eq)

    -- | Returns a structured representation of all of the
    -- DB changes required to migrate the Entity from its
    -- current state in the database to the state described in
    -- Haskell.
    --
    -- @since 2.17.1.0
    migrateStructured
        :: [EntityDef]
        -> (Text -> IO Statement)
        -> EntityDef
        -> IO (Either [Text] [AlterDB])
    migrateStructured :: [EntityDef]
    -> (Text -> IO Statement)
    -> EntityDef
    -> IO (Either [Text] [AlterDB])
    migrateStructured [EntityDef]
    allDefs Text -> IO Statement
    getter EntityDef
    entity = do
        old <- (Text -> IO Statement)
    -> EntityDef
    -> [Column]
    -> IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    getColumns Text -> IO Statement
    getter EntityDef
    entity [Column]
    newcols'
        case partitionEithers old of
            ([], [Either Column (ConstraintNameDB, [FieldNameDB])]
    old'') -> do
                exists' <-
                    if [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    old
                        then (Text -> IO Statement) -> EntityNameDB -> IO Bool
    doesTableExist Text -> IO Statement
    getter EntityNameDB
    name
                        else Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
                return $ Right $ migrationText exists' old''
            ([Text]
    errs, [Either Column (ConstraintNameDB, [FieldNameDB])]
    _) -> Either [Text] [AlterDB] -> IO (Either [Text] [AlterDB])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either [Text] [AlterDB] -> IO (Either [Text] [AlterDB]))
    -> Either [Text] [AlterDB] -> IO (Either [Text] [AlterDB])
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Either [Text] [AlterDB]
    forall a b. a -> Either a b
    Left [Text]
    errs
      where
        name :: EntityNameDB
    name = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    entity
        ([Column]
    newcols', [UniqueDef]
    udefs, [ForeignDef]
    fdefs) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
    postgresMkColumns [EntityDef]
    allDefs EntityDef
    entity
        migrationText :: Bool
    -> [Either Column (ConstraintNameDB, [FieldNameDB])] -> [AlterDB]
    migrationText Bool
    exists' [Either Column (ConstraintNameDB, [FieldNameDB])]
    old''
            | Bool -> Bool
    not Bool
    exists' =
                [Column]
    -> [ForeignDef] -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterDB]
    forall {t :: * -> *}.
    Foldable t =>
    [Column]
    -> [ForeignDef] -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB]
    createText [Column]
    newcols [ForeignDef]
    fdefs [(ConstraintNameDB, [FieldNameDB])]
    udspair
            | Bool
    otherwise =
                let
                    ([AlterColumn]
    acs, [AlterTable]
    ats) =
                        [EntityDef]
    -> EntityDef
    -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
    -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
    -> ([AlterColumn], [AlterTable])
    getAlters [EntityDef]
    allDefs EntityDef
    entity ([Column]
    newcols, [(ConstraintNameDB, [FieldNameDB])]
    udspair) ([Column], [(ConstraintNameDB, [FieldNameDB])])
    old'
                    acs' :: [AlterDB]
    acs' = (AlterColumn -> AlterDB) -> [AlterColumn] -> [AlterDB]
    forall a b. (a -> b) -> [a] -> [b]
    map (EntityNameDB -> AlterColumn -> AlterDB
    AlterColumn EntityNameDB
    name) [AlterColumn]
    acs
                    ats' :: [AlterDB]
    ats' = (AlterTable -> AlterDB) -> [AlterTable] -> [AlterDB]
    forall a b. (a -> b) -> [a] -> [b]
    map (EntityNameDB -> AlterTable -> AlterDB
    AlterTable EntityNameDB
    name) [AlterTable]
    ats
                 in
                    [AlterDB]
    acs' [AlterDB] -> [AlterDB] -> [AlterDB]
    forall a. [a] -> [a] -> [a]
    ++ [AlterDB]
    ats'
          where
            old' :: ([Column], [(ConstraintNameDB, [FieldNameDB])])
    old' = [Either Column (ConstraintNameDB, [FieldNameDB])]
    -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either Column (ConstraintNameDB, [FieldNameDB])]
    old''
            newcols :: [Column]
    newcols = (Column -> Bool) -> [Column] -> [Column]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Column -> Bool) -> Column -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityDef -> FieldNameDB -> Bool
    safeToRemove EntityDef
    entity (FieldNameDB -> Bool) -> (Column -> FieldNameDB) -> Column -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Column -> FieldNameDB
    cName) [Column]
    newcols'
            udspair :: [(ConstraintNameDB, [FieldNameDB])]
    udspair = (UniqueDef -> (ConstraintNameDB, [FieldNameDB]))
    -> [UniqueDef] -> [(ConstraintNameDB, [FieldNameDB])]
    forall a b. (a -> b) -> [a] -> [b]
    map UniqueDef -> (ConstraintNameDB, [FieldNameDB])
    udToPair [UniqueDef]
    udefs
        -- Check for table existence if there are no columns, workaround
        -- for https://github.com/yesodweb/persistent/issues/152

        createText :: [Column]
    -> [ForeignDef] -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB]
    createText [Column]
    newcols [ForeignDef]
    fdefs_ t (ConstraintNameDB, [FieldNameDB])
    udspair =
            ([Column] -> EntityDef -> AlterDB
    addTable [Column]
    newcols EntityDef
    entity) AlterDB -> [AlterDB] -> [AlterDB]
    forall a. a -> [a] -> [a]
    : [AlterDB]
    uniques [AlterDB] -> [AlterDB] -> [AlterDB]
    forall a. [a] -> [a] -> [a]
    ++ [AlterDB]
    references [AlterDB] -> [AlterDB] -> [AlterDB]
    forall a. [a] -> [a] -> [a]
    ++ [AlterDB]
    foreignsAlt
          where
            uniques :: [AlterDB]
    uniques = (((ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
     -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
    -> t (ConstraintNameDB, [FieldNameDB])
    -> ((ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
    -> [AlterDB]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
    -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap t (ConstraintNameDB, [FieldNameDB])
    udspair (((ConstraintNameDB, [FieldNameDB]) -> [AlterDB]) -> [AlterDB])
    -> ((ConstraintNameDB, [FieldNameDB]) -> [AlterDB]) -> [AlterDB]
    forall a b. (a -> b) -> a -> b
    $ \(ConstraintNameDB
    uname, [FieldNameDB]
    ucols) ->
                [EntityNameDB -> AlterTable -> AlterDB
    AlterTable EntityNameDB
    name (AlterTable -> AlterDB) -> AlterTable -> AlterDB
    forall a b. (a -> b) -> a -> b
    $ ConstraintNameDB -> [FieldNameDB] -> AlterTable
    AddUniqueConstraint ConstraintNameDB
    uname [FieldNameDB]
    ucols]
            references :: [AlterDB]
    references =
                (Column -> Maybe AlterDB) -> [Column] -> [AlterDB]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
                    ( \Column{FieldNameDB
    cName :: Column -> FieldNameDB
    cName :: FieldNameDB
    cName, Maybe ColumnReference
    cReference :: Maybe ColumnReference
    cReference :: Column -> Maybe ColumnReference
    cReference} ->
                        [EntityDef]
    -> EntityDef -> FieldNameDB -> ColumnReference -> Maybe AlterDB
    getAddReference [EntityDef]
    allDefs EntityDef
    entity FieldNameDB
    cName (ColumnReference -> Maybe AlterDB)
    -> Maybe ColumnReference -> Maybe AlterDB
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe ColumnReference
    cReference
                    )
                    [Column]
    newcols
            foreignsAlt :: [AlterDB]
    foreignsAlt = (ForeignDef -> Maybe AlterDB) -> [ForeignDef] -> [AlterDB]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (EntityDef -> ForeignDef -> Maybe AlterDB
    mkForeignAlt EntityDef
    entity) [ForeignDef]
    fdefs_

    -- | Returns a structured representation of all of the
    -- DB changes required to migrate the Entity to the state
    -- described in Haskell, assuming it currently does not
    -- exist in the database.
    --
    -- @since 2.17.1.0
    mockMigrateStructured
        :: [EntityDef]
        -> EntityDef
        -> [AlterDB]
    mockMigrateStructured :: [EntityDef] -> EntityDef -> [AlterDB]
    mockMigrateStructured [EntityDef]
    allDefs EntityDef
    entity = [AlterDB]
    migrationText
      where
        name :: EntityNameDB
    name = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    entity
        migrationText :: [AlterDB]
    migrationText = [Column]
    -> [ForeignDef] -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterDB]
    forall {t :: * -> *}.
    Foldable t =>
    [Column]
    -> [ForeignDef] -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB]
    createText [Column]
    newcols [ForeignDef]
    fdefs [(ConstraintNameDB, [FieldNameDB])]
    udspair
          where
            ([Column]
    newcols', [UniqueDef]
    udefs, [ForeignDef]
    fdefs) = [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
    postgresMkColumns [EntityDef]
    allDefs EntityDef
    entity
            newcols :: [Column]
    newcols = (Column -> Bool) -> [Column] -> [Column]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Column -> Bool) -> Column -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityDef -> FieldNameDB -> Bool
    safeToRemove EntityDef
    entity (FieldNameDB -> Bool) -> (Column -> FieldNameDB) -> Column -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Column -> FieldNameDB
    cName) [Column]
    newcols'
            udspair :: [(ConstraintNameDB, [FieldNameDB])]
    udspair = (UniqueDef -> (ConstraintNameDB, [FieldNameDB]))
    -> [UniqueDef] -> [(ConstraintNameDB, [FieldNameDB])]
    forall a b. (a -> b) -> [a] -> [b]
    map UniqueDef -> (ConstraintNameDB, [FieldNameDB])
    udToPair [UniqueDef]
    udefs
        -- Check for table existence if there are no columns, workaround
        -- for https://github.com/yesodweb/persistent/issues/152

        createText :: [Column]
    -> [ForeignDef] -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB]
    createText [Column]
    newcols [ForeignDef]
    fdefs t (ConstraintNameDB, [FieldNameDB])
    udspair =
            ([Column] -> EntityDef -> AlterDB
    addTable [Column]
    newcols EntityDef
    entity) AlterDB -> [AlterDB] -> [AlterDB]
    forall a. a -> [a] -> [a]
    : [AlterDB]
    uniques [AlterDB] -> [AlterDB] -> [AlterDB]
    forall a. [a] -> [a] -> [a]
    ++ [AlterDB]
    references [AlterDB] -> [AlterDB] -> [AlterDB]
    forall a. [a] -> [a] -> [a]
    ++ [AlterDB]
    foreignsAlt
          where
            uniques :: [AlterDB]
    uniques = (((ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
     -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
    -> t (ConstraintNameDB, [FieldNameDB])
    -> ((ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
    -> [AlterDB]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((ConstraintNameDB, [FieldNameDB]) -> [AlterDB])
    -> t (ConstraintNameDB, [FieldNameDB]) -> [AlterDB]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap t (ConstraintNameDB, [FieldNameDB])
    udspair (((ConstraintNameDB, [FieldNameDB]) -> [AlterDB]) -> [AlterDB])
    -> ((ConstraintNameDB, [FieldNameDB]) -> [AlterDB]) -> [AlterDB]
    forall a b. (a -> b) -> a -> b
    $ \(ConstraintNameDB
    uname, [FieldNameDB]
    ucols) ->
                [EntityNameDB -> AlterTable -> AlterDB
    AlterTable EntityNameDB
    name (AlterTable -> AlterDB) -> AlterTable -> AlterDB
    forall a b. (a -> b) -> a -> b
    $ ConstraintNameDB -> [FieldNameDB] -> AlterTable
    AddUniqueConstraint ConstraintNameDB
    uname [FieldNameDB]
    ucols]
            references :: [AlterDB]
    references =
                (Column -> Maybe AlterDB) -> [Column] -> [AlterDB]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe
                    ( \Column{FieldNameDB
    cName :: Column -> FieldNameDB
    cName :: FieldNameDB
    cName, Maybe ColumnReference
    cReference :: Column -> Maybe ColumnReference
    cReference :: Maybe ColumnReference
    cReference} ->
                        [EntityDef]
    -> EntityDef -> FieldNameDB -> ColumnReference -> Maybe AlterDB
    getAddReference [EntityDef]
    allDefs EntityDef
    entity FieldNameDB
    cName (ColumnReference -> Maybe AlterDB)
    -> Maybe ColumnReference -> Maybe AlterDB
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe ColumnReference
    cReference
                    )
                    [Column]
    newcols
            foreignsAlt :: [AlterDB]
    foreignsAlt = (ForeignDef -> Maybe AlterDB) -> [ForeignDef] -> [AlterDB]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (EntityDef -> ForeignDef -> Maybe AlterDB
    mkForeignAlt EntityDef
    entity) [ForeignDef]
    fdefs

    -- | Returns a structured representation of all of the
    -- DB changes required to migrate the Entity from its current state
    -- in the database to the state described in Haskell.
    --
    -- @since 2.17.1.0
    addTable :: [Column] -> EntityDef -> AlterDB
    addTable :: [Column] -> EntityDef -> AlterDB
    addTable [Column]
    cols EntityDef
    entity =
        EntityNameDB -> EntityIdDef -> [Column] -> AlterDB
    AddTable EntityNameDB
    name EntityIdDef
    entityId [Column]
    nonIdCols
      where
        nonIdCols :: [Column]
    nonIdCols =
            case EntityDef -> Maybe CompositeDef
    entityPrimary EntityDef
    entity of
                Just CompositeDef
    _ ->
                    [Column]
    cols
                Maybe CompositeDef
    _ ->
                    (Column -> Bool) -> [Column] -> [Column]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Column -> Bool
    keepField [Column]
    cols
          where
            keepField :: Column -> Bool
    keepField Column
    c =
                FieldNameDB -> Maybe FieldNameDB
    forall a. a -> Maybe a
    Just (Column -> FieldNameDB
    cName Column
    c) Maybe FieldNameDB -> Maybe FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (FieldDef -> FieldNameDB) -> Maybe FieldDef -> Maybe FieldNameDB
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldDef -> FieldNameDB
    fieldDB (EntityDef -> Maybe FieldDef
    getEntityIdField EntityDef
    entity)
                    Bool -> Bool -> Bool
    && Bool -> Bool
    not (EntityDef -> FieldNameDB -> Bool
    safeToRemove EntityDef
    entity (Column -> FieldNameDB
    cName Column
    c))
        entityId :: EntityIdDef
    entityId = EntityDef -> EntityIdDef
    getEntityId EntityDef
    entity
        name :: EntityNameDB
    name = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    entity

    maySerial :: SqlType -> Maybe Text -> Text
    maySerial :: SqlType -> Maybe Text -> Text
    maySerial SqlType
    SqlInt64 Maybe Text
    Nothing = Text
    " SERIAL8 "
    maySerial SqlType
    sType Maybe Text
    _ = Text
    " " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> SqlType -> Text
    showSqlType SqlType
    sType

    mayDefault :: Maybe Text -> Text
    mayDefault :: Maybe Text -> Text
    mayDefault Maybe Text
    def = case Maybe Text
    def of
        Maybe Text
    Nothing -> Text
    ""
        Just Text
    d -> Text
    " DEFAULT " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    d

    getAlters
        :: [EntityDef]
        -> EntityDef
        -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
        -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
        -> ([AlterColumn], [AlterTable])
    getAlters :: [EntityDef]
    -> EntityDef
    -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
    -> ([Column], [(ConstraintNameDB, [FieldNameDB])])
    -> ([AlterColumn], [AlterTable])
    getAlters [EntityDef]
    defs EntityDef
    def ([Column]
    c1, [(ConstraintNameDB, [FieldNameDB])]
    u1) ([Column]
    c2, [(ConstraintNameDB, [FieldNameDB])]
    u2) =
        ([Column] -> [Column] -> [AlterColumn]
    getAltersC [Column]
    c1 [Column]
    c2, [(ConstraintNameDB, [FieldNameDB])]
    -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterTable]
    getAltersU [(ConstraintNameDB, [FieldNameDB])]
    u1 [(ConstraintNameDB, [FieldNameDB])]
    u2)
      where
        getAltersC :: [Column] -> [Column] -> [AlterColumn]
    getAltersC [] [Column]
    old =
            (Column -> AlterColumn) -> [Column] -> [AlterColumn]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Column
    x -> Column -> SafeToRemove -> AlterColumn
    Drop Column
    x (SafeToRemove -> AlterColumn) -> SafeToRemove -> AlterColumn
    forall a b. (a -> b) -> a -> b
    $ Bool -> SafeToRemove
    SafeToRemove (Bool -> SafeToRemove) -> Bool -> SafeToRemove
    forall a b. (a -> b) -> a -> b
    $ EntityDef -> FieldNameDB -> Bool
    safeToRemove EntityDef
    def (FieldNameDB -> Bool) -> FieldNameDB -> Bool
    forall a b. (a -> b) -> a -> b
    $ Column -> FieldNameDB
    cName Column
    x) [Column]
    old
        getAltersC (Column
    new : [Column]
    news) [Column]
    old =
            let
                ([AlterColumn]
    alters, [Column]
    old') = [EntityDef]
    -> EntityDef -> Column -> [Column] -> ([AlterColumn], [Column])
    findAlters [EntityDef]
    defs EntityDef
    def Column
    new [Column]
    old
             in
                [AlterColumn]
    alters [AlterColumn] -> [AlterColumn] -> [AlterColumn]
    forall a. [a] -> [a] -> [a]
    ++ [Column] -> [Column] -> [AlterColumn]
    getAltersC [Column]
    news [Column]
    old'

        getAltersU
            :: [(ConstraintNameDB, [FieldNameDB])]
            -> [(ConstraintNameDB, [FieldNameDB])]
            -> [AlterTable]
        getAltersU :: [(ConstraintNameDB, [FieldNameDB])]
    -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterTable]
    getAltersU [] [(ConstraintNameDB, [FieldNameDB])]
    old =
            (ConstraintNameDB -> AlterTable)
    -> [ConstraintNameDB] -> [AlterTable]
    forall a b. (a -> b) -> [a] -> [b]
    map ConstraintNameDB -> AlterTable
    DropConstraint ([ConstraintNameDB] -> [AlterTable])
    -> [ConstraintNameDB] -> [AlterTable]
    forall a b. (a -> b) -> a -> b
    $ (ConstraintNameDB -> Bool)
    -> [ConstraintNameDB] -> [ConstraintNameDB]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool)
    -> (ConstraintNameDB -> Bool) -> ConstraintNameDB -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConstraintNameDB -> Bool
    isManual) ([ConstraintNameDB] -> [ConstraintNameDB])
    -> [ConstraintNameDB] -> [ConstraintNameDB]
    forall a b. (a -> b) -> a -> b
    $ ((ConstraintNameDB, [FieldNameDB]) -> ConstraintNameDB)
    -> [(ConstraintNameDB, [FieldNameDB])] -> [ConstraintNameDB]
    forall a b. (a -> b) -> [a] -> [b]
    map (ConstraintNameDB, [FieldNameDB]) -> ConstraintNameDB
    forall a b. (a, b) -> a
    fst [(ConstraintNameDB, [FieldNameDB])]
    old
        getAltersU ((ConstraintNameDB
    name, [FieldNameDB]
    cols) : [(ConstraintNameDB, [FieldNameDB])]
    news) [(ConstraintNameDB, [FieldNameDB])]
    old =
            case ConstraintNameDB
    -> [(ConstraintNameDB, [FieldNameDB])] -> Maybe [FieldNameDB]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ConstraintNameDB
    name [(ConstraintNameDB, [FieldNameDB])]
    old of
                Maybe [FieldNameDB]
    Nothing ->
                    ConstraintNameDB -> [FieldNameDB] -> AlterTable
    AddUniqueConstraint ConstraintNameDB
    name [FieldNameDB]
    cols AlterTable -> [AlterTable] -> [AlterTable]
    forall a. a -> [a] -> [a]
    : [(ConstraintNameDB, [FieldNameDB])]
    -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterTable]
    getAltersU [(ConstraintNameDB, [FieldNameDB])]
    news [(ConstraintNameDB, [FieldNameDB])]
    old
                Just [FieldNameDB]
    ocols ->
                    let
                        old' :: [(ConstraintNameDB, [FieldNameDB])]
    old' = ((ConstraintNameDB, [FieldNameDB]) -> Bool)
    -> [(ConstraintNameDB, [FieldNameDB])]
    -> [(ConstraintNameDB, [FieldNameDB])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(ConstraintNameDB
    x, [FieldNameDB]
    _) -> ConstraintNameDB
    x ConstraintNameDB -> ConstraintNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ConstraintNameDB
    name) [(ConstraintNameDB, [FieldNameDB])]
    old
                     in
                        if [FieldNameDB] -> [FieldNameDB]
    forall a. Ord a => [a] -> [a]
    sort [FieldNameDB]
    cols [FieldNameDB] -> [FieldNameDB] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [FieldNameDB] -> [FieldNameDB]
    forall a. Ord a => [a] -> [a]
    sort [FieldNameDB]
    ocols
                            then [(ConstraintNameDB, [FieldNameDB])]
    -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterTable]
    getAltersU [(ConstraintNameDB, [FieldNameDB])]
    news [(ConstraintNameDB, [FieldNameDB])]
    old'
                            else
                                ConstraintNameDB -> AlterTable
    DropConstraint ConstraintNameDB
    name
                                    AlterTable -> [AlterTable] -> [AlterTable]
    forall a. a -> [a] -> [a]
    : ConstraintNameDB -> [FieldNameDB] -> AlterTable
    AddUniqueConstraint ConstraintNameDB
    name [FieldNameDB]
    cols
                                    AlterTable -> [AlterTable] -> [AlterTable]
    forall a. a -> [a] -> [a]
    : [(ConstraintNameDB, [FieldNameDB])]
    -> [(ConstraintNameDB, [FieldNameDB])] -> [AlterTable]
    getAltersU [(ConstraintNameDB, [FieldNameDB])]
    news [(ConstraintNameDB, [FieldNameDB])]
    old'

        -- Don't drop constraints which were manually added.
        isManual :: ConstraintNameDB -> Bool
    isManual (ConstraintNameDB Text
    x) = Text
    "__manual_" Text -> Text -> Bool
    `T.isPrefixOf` Text
    x

    -- | Postgres' default maximum identifier length in bytes
    -- (You can re-compile Postgres with a new limit, but I'm assuming that virtually noone does this).
    -- See https://www.postgresql.org/docs/11/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS
    maximumIdentifierLength :: Int
    maximumIdentifierLength :: Int
    maximumIdentifierLength = Int
    63

    -- | Intelligent comparison of SQL types, to account for SqlInt32 vs SqlOther integer
    sqlTypeEq :: SqlType -> SqlType -> Bool
    sqlTypeEq :: SqlType -> SqlType -> Bool
    sqlTypeEq SqlType
    x SqlType
    y =
        let
            -- Non exhaustive helper to map postgres aliases to the same name. Based on
            -- https://www.postgresql.org/docs/9.5/datatype.html.
            -- This prevents needless `ALTER TYPE`s when the type is the same.
            normalize :: a -> a
    normalize a
    "int8" = a
    "bigint"
            normalize a
    "serial8" = a
    "bigserial"
            normalize a
    v = a
    v
         in
            Text -> Text
    forall {a}. (Eq a, IsString a) => a -> a
    normalize (Text -> Text
    T.toCaseFold (SqlType -> Text
    showSqlType SqlType
    x))
                Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Text
    forall {a}. (Eq a, IsString a) => a -> a
    normalize (Text -> Text
    T.toCaseFold (SqlType -> Text
    showSqlType SqlType
    y))

    -- We check if we should alter a foreign key. This is almost an equality check,
    -- except we consider 'Nothing' and 'Just Restrict' equivalent.
    equivalentRef :: Maybe ColumnReference -> Maybe ColumnReference -> Bool
    equivalentRef :: Maybe ColumnReference -> Maybe ColumnReference -> Bool
    equivalentRef Maybe ColumnReference
    Nothing Maybe ColumnReference
    Nothing = Bool
    True
    equivalentRef (Just ColumnReference
    cr1) (Just ColumnReference
    cr2) =
        ColumnReference -> EntityNameDB
    crTableName ColumnReference
    cr1 EntityNameDB -> EntityNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColumnReference -> EntityNameDB
    crTableName ColumnReference
    cr2
            Bool -> Bool -> Bool
    && ColumnReference -> ConstraintNameDB
    crConstraintName ColumnReference
    cr1 ConstraintNameDB -> ConstraintNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColumnReference -> ConstraintNameDB
    crConstraintName ColumnReference
    cr2
            Bool -> Bool -> Bool
    && Maybe CascadeAction -> Maybe CascadeAction -> Bool
    eqCascade (FieldCascade -> Maybe CascadeAction
    fcOnUpdate (FieldCascade -> Maybe CascadeAction)
    -> FieldCascade -> Maybe CascadeAction
    forall a b. (a -> b) -> a -> b
    $ ColumnReference -> FieldCascade
    crFieldCascade ColumnReference
    cr1) (FieldCascade -> Maybe CascadeAction
    fcOnUpdate (FieldCascade -> Maybe CascadeAction)
    -> FieldCascade -> Maybe CascadeAction
    forall a b. (a -> b) -> a -> b
    $ ColumnReference -> FieldCascade
    crFieldCascade ColumnReference
    cr2)
            Bool -> Bool -> Bool
    && Maybe CascadeAction -> Maybe CascadeAction -> Bool
    eqCascade (FieldCascade -> Maybe CascadeAction
    fcOnDelete (FieldCascade -> Maybe CascadeAction)
    -> FieldCascade -> Maybe CascadeAction
    forall a b. (a -> b) -> a -> b
    $ ColumnReference -> FieldCascade
    crFieldCascade ColumnReference
    cr1) (FieldCascade -> Maybe CascadeAction
    fcOnDelete (FieldCascade -> Maybe CascadeAction)
    -> FieldCascade -> Maybe CascadeAction
    forall a b. (a -> b) -> a -> b
    $ ColumnReference -> FieldCascade
    crFieldCascade ColumnReference
    cr2)
      where
        eqCascade :: Maybe CascadeAction -> Maybe CascadeAction -> Bool
        eqCascade :: Maybe CascadeAction -> Maybe CascadeAction -> Bool
    eqCascade Maybe CascadeAction
    Nothing Maybe CascadeAction
    Nothing = Bool
    True
        eqCascade Maybe CascadeAction
    Nothing (Just CascadeAction
    Restrict) = Bool
    True
        eqCascade (Just CascadeAction
    Restrict) Maybe CascadeAction
    Nothing = Bool
    True
        eqCascade (Just CascadeAction
    cs1) (Just CascadeAction
    cs2) = CascadeAction
    cs1 CascadeAction -> CascadeAction -> Bool
    forall a. Eq a => a -> a -> Bool
    == CascadeAction
    cs2
        eqCascade Maybe CascadeAction
    _ Maybe CascadeAction
    _ = Bool
    False
    equivalentRef Maybe ColumnReference
    _ Maybe ColumnReference
    _ = Bool
    False

    refName :: EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refName :: EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refName (EntityNameDB Text
    table) (FieldNameDB Text
    column) =
        let
            overhead :: Int
    overhead = Text -> Int
    T.length (Text -> Int) -> Text -> Int
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    T.concat [Text
    "_", Text
    "_fkey"]
            (Int
    fromTable, Int
    fromColumn) = Int -> (Int, Int) -> (Int, Int)
    shortenNames Int
    overhead (Text -> Int
    T.length Text
    table, Text -> Int
    T.length Text
    column)
         in
            Text -> ConstraintNameDB
    ConstraintNameDB (Text -> ConstraintNameDB) -> Text -> ConstraintNameDB
    forall a b. (a -> b) -> a -> b
    $
                [Text] -> Text
    T.concat [Int -> Text -> Text
    T.take Int
    fromTable Text
    table, Text
    "_", Int -> Text -> Text
    T.take Int
    fromColumn Text
    column, Text
    "_fkey"]
      where
        -- Postgres automatically truncates too long foreign keys to a combination of
        -- truncatedTableName + "_" + truncatedColumnName + "_fkey"
        -- This works fine for normal use cases, but it creates an issue for Persistent
        -- Because after running the migrations, Persistent sees the truncated foreign key constraint
        -- doesn't have the expected name, and suggests that you migrate again
        -- To workaround this, we copy the Postgres truncation approach before sending foreign key constraints to it.
        --
        -- I believe this will also be an issue for extremely long table names,
        -- but it's just much more likely to exist with foreign key constraints because they're usually tablename * 2 in length

        -- Approximation of the algorithm Postgres uses to truncate identifiers
        -- See makeObjectName https://github.com/postgres/postgres/blob/5406513e997f5ee9de79d4076ae91c04af0c52f6/src/backend/commands/indexcmds.c#L2074-L2080
        shortenNames :: Int -> (Int, Int) -> (Int, Int)
        shortenNames :: Int -> (Int, Int) -> (Int, Int)
    shortenNames Int
    overhead (Int
    x, Int
    y)
            | Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    overhead Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    maximumIdentifierLength = (Int
    x, Int
    y)
            | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    y = Int -> (Int, Int) -> (Int, Int)
    shortenNames Int
    overhead (Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1, Int
    y)
            | Bool
    otherwise = Int -> (Int, Int) -> (Int, Int)
    shortenNames Int
    overhead (Int
    x, Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

    postgresMkColumns
        :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
    postgresMkColumns :: [EntityDef] -> EntityDef -> ([Column], [UniqueDef], [ForeignDef])
    postgresMkColumns [EntityDef]
    allDefs EntityDef
    t =
        [EntityDef]
    -> EntityDef
    -> BackendSpecificOverrides
    -> ([Column], [UniqueDef], [ForeignDef])
    mkColumns [EntityDef]
    allDefs EntityDef
    t (BackendSpecificOverrides -> ([Column], [UniqueDef], [ForeignDef]))
    -> BackendSpecificOverrides
    -> ([Column], [UniqueDef], [ForeignDef])
    forall a b. (a -> b) -> a -> b
    $
            (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    -> BackendSpecificOverrides -> BackendSpecificOverrides
    setBackendSpecificForeignKeyName EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refName BackendSpecificOverrides
    emptyBackendSpecificOverrides

    -- | Check if a column name is listed as the "safe to remove" in the entity
    -- list.
    safeToRemove :: EntityDef -> FieldNameDB -> Bool
    safeToRemove :: EntityDef -> FieldNameDB -> Bool
    safeToRemove EntityDef
    def (FieldNameDB Text
    colName) =
        (FieldDef -> Bool) -> [FieldDef] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FieldAttr -> [FieldAttr] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem FieldAttr
    FieldAttrSafeToRemove ([FieldAttr] -> Bool)
    -> (FieldDef -> [FieldAttr]) -> FieldDef -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FieldDef -> [FieldAttr]
    fieldAttrs) ([FieldDef] -> Bool) -> [FieldDef] -> Bool
    forall a b. (a -> b) -> a -> b
    $
            (FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((FieldNameDB -> FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> FieldNameDB
    FieldNameDB Text
    colName) (FieldNameDB -> Bool)
    -> (FieldDef -> FieldNameDB) -> FieldDef -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FieldDef -> FieldNameDB
    fieldDB) ([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
    forall a b. (a -> b) -> a -> b
    $
                [FieldDef]
    allEntityFields
      where
        allEntityFields :: [FieldDef]
    allEntityFields =
            EntityDef -> [FieldDef]
    getEntityFieldsDatabase EntityDef
    def [FieldDef] -> [FieldDef] -> [FieldDef]
    forall a. Semigroup a => a -> a -> a
    <> case EntityDef -> EntityIdDef
    getEntityId EntityDef
    def of
                EntityIdField FieldDef
    fdef ->
                    [FieldDef
    fdef]
                EntityIdDef
    _ ->
                    []

    udToPair :: UniqueDef -> (ConstraintNameDB, [FieldNameDB])
    udToPair :: UniqueDef -> (ConstraintNameDB, [FieldNameDB])
    udToPair UniqueDef
    ud = (UniqueDef -> ConstraintNameDB
    uniqueDBName UniqueDef
    ud, ((FieldNameHS, FieldNameDB) -> FieldNameDB)
    -> [(FieldNameHS, FieldNameDB)] -> [FieldNameDB]
    forall a b. (a -> b) -> [a] -> [b]
    map (FieldNameHS, FieldNameDB) -> FieldNameDB
    forall a b. (a, b) -> b
    snd ([(FieldNameHS, FieldNameDB)] -> [FieldNameDB])
    -> [(FieldNameHS, FieldNameDB)] -> [FieldNameDB]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty (FieldNameHS, FieldNameDB) -> [(FieldNameHS, FieldNameDB)]
    forall a. NonEmpty a -> [a]
    NEL.toList (NonEmpty (FieldNameHS, FieldNameDB)
     -> [(FieldNameHS, FieldNameDB)])
    -> NonEmpty (FieldNameHS, FieldNameDB)
    -> [(FieldNameHS, FieldNameDB)]
    forall a b. (a -> b) -> a -> b
    $ UniqueDef -> NonEmpty (FieldNameHS, FieldNameDB)
    uniqueFields UniqueDef
    ud)

    -- | Get the references to be added to a table for the given column.
    getAddReference
        :: [EntityDef]
        -> EntityDef
        -> FieldNameDB
        -> ColumnReference
        -> Maybe AlterDB
    getAddReference :: [EntityDef]
    -> EntityDef -> FieldNameDB -> ColumnReference -> Maybe AlterDB
    getAddReference [EntityDef]
    allDefs EntityDef
    entity FieldNameDB
    cname cr :: ColumnReference
    cr@ColumnReference{crTableName :: ColumnReference -> EntityNameDB
    crTableName = EntityNameDB
    s, crConstraintName :: ColumnReference -> ConstraintNameDB
    crConstraintName = ConstraintNameDB
    constraintName} = do
        Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> Bool -> Maybe ()
    forall a b. (a -> b) -> a -> b
    $ FieldNameDB -> Maybe FieldNameDB
    forall a. a -> Maybe a
    Just FieldNameDB
    cname Maybe FieldNameDB -> Maybe FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (FieldDef -> FieldNameDB) -> Maybe FieldDef -> Maybe FieldNameDB
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldDef -> FieldNameDB
    fieldDB (EntityDef -> Maybe FieldDef
    getEntityIdField EntityDef
    entity)
        AlterDB -> Maybe AlterDB
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (AlterDB -> Maybe AlterDB) -> AlterDB -> Maybe AlterDB
    forall a b. (a -> b) -> a -> b
    $
            EntityNameDB -> AlterColumn -> AlterDB
    AlterColumn
                EntityNameDB
    table
                (EntityNameDB
    -> ConstraintNameDB
    -> NonEmpty FieldNameDB
    -> [Text]
    -> FieldCascade
    -> AlterColumn
    AddReference EntityNameDB
    s ConstraintNameDB
    constraintName (FieldNameDB
    cname FieldNameDB -> [FieldNameDB] -> NonEmpty FieldNameDB
    forall a. a -> [a] -> NonEmpty a
    NEL.:| []) [Text]
    id_ (ColumnReference -> FieldCascade
    crFieldCascade ColumnReference
    cr))
      where
        table :: EntityNameDB
    table = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    entity
        id_ :: [Text]
    id_ =
            [Text] -> Maybe [Text] -> [Text]
    forall a. a -> Maybe a -> a
    fromMaybe
                ([Char] -> [Text]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [Text]) -> [Char] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Could not find ID of entity " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ EntityNameDB -> [Char]
    forall a. Show a => a -> [Char]
    show EntityNameDB
    s)
                (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ do
                    entDef <- (EntityDef -> Bool) -> [EntityDef] -> Maybe EntityDef
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((EntityNameDB -> EntityNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    == EntityNameDB
    s) (EntityNameDB -> Bool)
    -> (EntityDef -> EntityNameDB) -> EntityDef -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityDef -> EntityNameDB
    getEntityDBName) [EntityDef]
    allDefs
                    return $ NEL.toList $ Util.dbIdColumnsEsc escapeF entDef

    mkForeignAlt
        :: EntityDef
        -> ForeignDef
        -> Maybe AlterDB
    mkForeignAlt :: EntityDef -> ForeignDef -> Maybe AlterDB
    mkForeignAlt EntityDef
    entity ForeignDef
    fdef = case [FieldNameDB] -> Maybe (NonEmpty FieldNameDB)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [FieldNameDB]
    childfields of
        Maybe (NonEmpty FieldNameDB)
    Nothing -> Maybe AlterDB
    forall a. Maybe a
    Nothing
        Just NonEmpty FieldNameDB
    childfields' -> AlterDB -> Maybe AlterDB
    forall a. a -> Maybe a
    Just (AlterDB -> Maybe AlterDB) -> AlterDB -> Maybe AlterDB
    forall a b. (a -> b) -> a -> b
    $ EntityNameDB -> AlterColumn -> AlterDB
    AlterColumn EntityNameDB
    tableName_ AlterColumn
    addReference
          where
            addReference :: AlterColumn
    addReference =
                EntityNameDB
    -> ConstraintNameDB
    -> NonEmpty FieldNameDB
    -> [Text]
    -> FieldCascade
    -> AlterColumn
    AddReference
                    (ForeignDef -> EntityNameDB
    foreignRefTableDBName ForeignDef
    fdef)
                    ConstraintNameDB
    constraintName
                    NonEmpty FieldNameDB
    childfields'
                    [Text]
    escapedParentFields
                    (ForeignDef -> FieldCascade
    foreignFieldCascade ForeignDef
    fdef)
      where
        tableName_ :: EntityNameDB
    tableName_ = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    entity
        constraintName :: ConstraintNameDB
    constraintName =
            ForeignDef -> ConstraintNameDB
    foreignConstraintNameDBName ForeignDef
    fdef
        ([FieldNameDB]
    childfields, [FieldNameDB]
    parentfields) =
            [(FieldNameDB, FieldNameDB)] -> ([FieldNameDB], [FieldNameDB])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ((((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))
     -> (FieldNameDB, FieldNameDB))
    -> [((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))]
    -> [(FieldNameDB, FieldNameDB)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\((FieldNameHS
    _, FieldNameDB
    b), (FieldNameHS
    _, FieldNameDB
    d)) -> (FieldNameDB
    b, FieldNameDB
    d)) (ForeignDef
    -> [((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))]
    foreignFields ForeignDef
    fdef))
        escapedParentFields :: [Text]
    escapedParentFields =
            (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldNameDB -> Text
    escapeF [FieldNameDB]
    parentfields

    escapeC :: ConstraintNameDB -> Text
    escapeC :: ConstraintNameDB -> Text
    escapeC = (Text -> Text) -> ConstraintNameDB -> Text
    forall a str. DatabaseName a => (Text -> str) -> a -> str
    forall str. (Text -> str) -> ConstraintNameDB -> str
    escapeWith Text -> Text
    escape

    escapeE :: EntityNameDB -> Text
    escapeE :: EntityNameDB -> Text
    escapeE = (Text -> Text) -> EntityNameDB -> Text
    forall a str. DatabaseName a => (Text -> str) -> a -> str
    forall str. (Text -> str) -> EntityNameDB -> str
    escapeWith Text -> Text
    escape

    escapeF :: FieldNameDB -> Text
    escapeF :: FieldNameDB -> Text
    escapeF = (Text -> Text) -> FieldNameDB -> Text
    forall a str. DatabaseName a => (Text -> str) -> a -> str
    forall str. (Text -> str) -> FieldNameDB -> str
    escapeWith Text -> Text
    escape

    escape :: Text -> Text
    escape :: Text -> Text
    escape Text
    s =
        [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ Char
    '"' Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    go (Text -> [Char]
    T.unpack Text
    s) [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\""
      where
        go :: ShowS
    go [Char]
    "" = [Char]
    ""
        go (Char
    '"' : [Char]
    xs) = [Char]
    "\"\"" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    go [Char]
    xs
        go (Char
    x : [Char]
    xs) = Char
    x Char -> ShowS
    forall a. a -> [a] -> [a]
    : ShowS
    go [Char]
    xs

    showAlterDb :: AlterDB -> (Bool, Text)
    showAlterDb :: AlterDB -> (Bool, Text)
    showAlterDb (AddTable EntityNameDB
    name EntityIdDef
    entityId [Column]
    nonIdCols) = (Bool
    False, Text
    rawText)
      where
        idtxt :: Text
    idtxt =
            case EntityIdDef
    entityId of
                EntityIdNaturalKey CompositeDef
    pdef ->
                    [Text] -> Text
    T.concat
                        [ Text
    " PRIMARY KEY ("
                        , Text -> [Text] -> Text
    T.intercalate Text
    "," ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (FieldDef -> Text) -> [FieldDef] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (FieldNameDB -> Text
    escapeF (FieldNameDB -> Text)
    -> (FieldDef -> FieldNameDB) -> FieldDef -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FieldDef -> FieldNameDB
    fieldDB) ([FieldDef] -> [Text]) -> [FieldDef] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty FieldDef -> [FieldDef]
    forall a. NonEmpty a -> [a]
    NEL.toList (NonEmpty FieldDef -> [FieldDef])
    -> NonEmpty FieldDef -> [FieldDef]
    forall a b. (a -> b) -> a -> b
    $ CompositeDef -> NonEmpty FieldDef
    compositeFields CompositeDef
    pdef
                        , Text
    ")"
                        ]
                EntityIdField FieldDef
    field ->
                    let
                        defText :: Maybe Text
    defText = [FieldAttr] -> Maybe Text
    defaultAttribute ([FieldAttr] -> Maybe Text) -> [FieldAttr] -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    field
                        sType :: SqlType
    sType = FieldDef -> SqlType
    fieldSqlType FieldDef
    field
                     in
                        [Text] -> Text
    T.concat
                            [ FieldNameDB -> Text
    escapeF (FieldNameDB -> Text) -> FieldNameDB -> Text
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> FieldNameDB
    fieldDB FieldDef
    field
                            , SqlType -> Maybe Text -> Text
    maySerial SqlType
    sType Maybe Text
    defText
                            , Text
    " PRIMARY KEY UNIQUE"
                            , Maybe Text -> Text
    mayDefault Maybe Text
    defText
                            ]
        rawText :: Text
    rawText =
            [Text] -> Text
    T.concat
                -- Lower case e: see Database.Persist.Sql.Migration
                [ Text
    "CREATe TABLE " -- DO NOT FIX THE CAPITALIZATION!
                , EntityNameDB -> Text
    escapeE EntityNameDB
    name
                , Text
    "("
                , Text
    idtxt
                , if [Column] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Column]
    nonIdCols then Text
    "" else Text
    ","
                , Text -> [Text] -> Text
    T.intercalate Text
    "," ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Column -> Text) -> [Column] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Column -> Text
    showColumn [Column]
    nonIdCols
                , Text
    ")"
                ]
    showAlterDb (AlterColumn EntityNameDB
    t AlterColumn
    ac) =
        (AlterColumn -> Bool
    isUnsafe AlterColumn
    ac, EntityNameDB -> AlterColumn -> Text
    showAlter EntityNameDB
    t AlterColumn
    ac)
      where
        isUnsafe :: AlterColumn -> Bool
    isUnsafe (Drop Column
    _ (SafeToRemove Bool
    safeRemove)) = Bool -> Bool
    not Bool
    safeRemove
        isUnsafe AlterColumn
    _ = Bool
    False
    showAlterDb (AlterTable EntityNameDB
    t AlterTable
    at) = (Bool
    False, EntityNameDB -> AlterTable -> Text
    showAlterTable EntityNameDB
    t AlterTable
    at)

    showAlterTable :: EntityNameDB -> AlterTable -> Text
    showAlterTable :: EntityNameDB -> AlterTable -> Text
    showAlterTable EntityNameDB
    table (AddUniqueConstraint ConstraintNameDB
    cname [FieldNameDB]
    cols) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ADD CONSTRAINT "
            , ConstraintNameDB -> Text
    escapeC ConstraintNameDB
    cname
            , Text
    " UNIQUE("
            , Text -> [Text] -> Text
    T.intercalate Text
    "," ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldNameDB -> Text
    escapeF [FieldNameDB]
    cols
            , Text
    ")"
            ]
    showAlterTable EntityNameDB
    table (DropConstraint ConstraintNameDB
    cname) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " DROP CONSTRAINT "
            , ConstraintNameDB -> Text
    escapeC ConstraintNameDB
    cname
            ]

    showAlter :: EntityNameDB -> AlterColumn -> Text
    showAlter :: EntityNameDB -> AlterColumn -> Text
    showAlter EntityNameDB
    table (ChangeType Column
    c SqlType
    t Text
    extra) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ALTER COLUMN "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    " TYPE "
            , SqlType -> Text
    showSqlType SqlType
    t
            , Text
    extra
            ]
    showAlter EntityNameDB
    table (IsNull Column
    c) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ALTER COLUMN "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    " DROP NOT NULL"
            ]
    showAlter EntityNameDB
    table (NotNull Column
    c) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ALTER COLUMN "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    " SET NOT NULL"
            ]
    showAlter EntityNameDB
    table (AddColumn Column
    col) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ADD COLUMN "
            , Column -> Text
    showColumn Column
    col
            ]
    showAlter EntityNameDB
    table (Drop Column
    c SafeToRemove
    _) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " DROP COLUMN "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            ]
    showAlter EntityNameDB
    table (Default Column
    c Text
    s) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ALTER COLUMN "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    " SET DEFAULT "
            , Text
    s
            ]
    showAlter EntityNameDB
    table (NoDefault Column
    c) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ALTER COLUMN "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    " DROP DEFAULT"
            ]
    showAlter EntityNameDB
    table (UpdateNullToValue Column
    c Text
    s) =
        [Text] -> Text
    T.concat
            [ Text
    "UPDATE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " SET "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    "="
            , Text
    s
            , Text
    " WHERE "
            , FieldNameDB -> Text
    escapeF (Column -> FieldNameDB
    cName Column
    c)
            , Text
    " IS NULL"
            ]
    showAlter EntityNameDB
    table (AddReference EntityNameDB
    reftable ConstraintNameDB
    fkeyname NonEmpty FieldNameDB
    t2 [Text]
    id2 FieldCascade
    cascade) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " ADD CONSTRAINT "
            , ConstraintNameDB -> Text
    escapeC ConstraintNameDB
    fkeyname
            , Text
    " FOREIGN KEY("
            , Text -> [Text] -> Text
    T.intercalate Text
    "," ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (FieldNameDB -> Text) -> [FieldNameDB] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldNameDB -> Text
    escapeF ([FieldNameDB] -> [Text]) -> [FieldNameDB] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ NonEmpty FieldNameDB -> [FieldNameDB]
    forall a. NonEmpty a -> [a]
    NEL.toList NonEmpty FieldNameDB
    t2
            , Text
    ") REFERENCES "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    reftable
            , Text
    "("
            , Text -> [Text] -> Text
    T.intercalate Text
    "," [Text]
    id2
            , Text
    ")"
            ]
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> FieldCascade -> Text
    renderFieldCascade FieldCascade
    cascade
    showAlter EntityNameDB
    table (DropReference ConstraintNameDB
    cname) =
        [Text] -> Text
    T.concat
            [ Text
    "ALTER TABLE "
            , EntityNameDB -> Text
    escapeE EntityNameDB
    table
            , Text
    " DROP CONSTRAINT "
            , ConstraintNameDB -> Text
    escapeC ConstraintNameDB
    cname
            ]

    showColumn :: Column -> Text
    showColumn :: Column -> Text
    showColumn (Column FieldNameDB
    n Bool
    nu SqlType
    sqlType' Maybe Text
    def Maybe Text
    gen Maybe ConstraintNameDB
    _defConstraintName Maybe Integer
    _maxLen Maybe ColumnReference
    _ref) =
        [Text] -> Text
    T.concat
            [ FieldNameDB -> Text
    escapeF FieldNameDB
    n
            , Text
    " "
            , SqlType -> Text
    showSqlType SqlType
    sqlType'
            , Text
    " "
            , if Bool
    nu then Text
    "NULL" else Text
    "NOT NULL"
            , case Maybe Text
    def of
                Maybe Text
    Nothing -> Text
    ""
                Just Text
    s -> Text
    " DEFAULT " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s
            , case Maybe Text
    gen of
                Maybe Text
    Nothing -> Text
    ""
                Just Text
    s -> Text
    " GENERATED ALWAYS AS (" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ") STORED"
            ]

    showSqlType :: SqlType -> Text
    showSqlType :: SqlType -> Text
    showSqlType SqlType
    SqlString = Text
    "VARCHAR"
    showSqlType SqlType
    SqlInt32 = Text
    "INT4"
    showSqlType SqlType
    SqlInt64 = Text
    "INT8"
    showSqlType SqlType
    SqlReal = Text
    "DOUBLE PRECISION"
    showSqlType (SqlNumeric Word32
    s Word32
    prec) = [Text] -> Text
    T.concat [Text
    "NUMERIC(", [Char] -> Text
    T.pack (Word32 -> [Char]
    forall a. Show a => a -> [Char]
    show Word32
    s), Text
    ",", [Char] -> Text
    T.pack (Word32 -> [Char]
    forall a. Show a => a -> [Char]
    show Word32
    prec), Text
    ")"]
    showSqlType SqlType
    SqlDay = Text
    "DATE"
    showSqlType SqlType
    SqlTime = Text
    "TIME"
    showSqlType SqlType
    SqlDayTime = Text
    "TIMESTAMP WITH TIME ZONE"
    showSqlType SqlType
    SqlBlob = Text
    "BYTEA"
    showSqlType SqlType
    SqlBool = Text
    "BOOLEAN"
    -- Added for aliasing issues re: https://github.com/yesodweb/yesod/issues/682
    showSqlType (SqlOther (Text -> Text
    T.toLower -> Text
    "integer")) = Text
    "INT4"
    showSqlType (SqlOther Text
    t) = Text
    t

    findAlters
        :: [EntityDef]
        -- ^ The list of all entity definitions that persistent is aware of.
        -> EntityDef
        -- ^ The entity definition for the entity that we're working on.
        -> Column
        -- ^ The column that we're searching for potential alterations for.
        -> [Column]
        -> ([AlterColumn], [Column])
    findAlters :: [EntityDef]
    -> EntityDef -> Column -> [Column] -> ([AlterColumn], [Column])
    findAlters [EntityDef]
    defs EntityDef
    edef col :: Column
    col@(Column FieldNameDB
    name Bool
    isNull SqlType
    sqltype Maybe Text
    def Maybe Text
    _gen Maybe ConstraintNameDB
    _defConstraintName Maybe Integer
    _maxLen Maybe ColumnReference
    ref) [Column]
    cols =
        case (Column -> Bool) -> [Column] -> Maybe Column
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    List.find (\Column
    c -> Column -> FieldNameDB
    cName Column
    c FieldNameDB -> FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    == FieldNameDB
    name) [Column]
    cols of
            Maybe Column
    Nothing ->
                ([Column -> AlterColumn
    AddColumn Column
    col], [Column]
    cols)
            Just
                (Column FieldNameDB
    _oldName Bool
    isNull' SqlType
    sqltype' Maybe Text
    def' Maybe Text
    _gen' Maybe ConstraintNameDB
    _defConstraintName' Maybe Integer
    _maxLen' Maybe ColumnReference
    ref') ->
                    let
                        refDrop :: Maybe ColumnReference -> [AlterColumn]
    refDrop Maybe ColumnReference
    Nothing = []
                        refDrop (Just ColumnReference{crConstraintName :: ColumnReference -> ConstraintNameDB
    crConstraintName = ConstraintNameDB
    cname}) =
                            [ConstraintNameDB -> AlterColumn
    DropReference ConstraintNameDB
    cname]

                        refAdd :: Maybe ColumnReference -> [AlterColumn]
    refAdd Maybe ColumnReference
    Nothing = []
                        refAdd (Just ColumnReference
    colRef) =
                            case (EntityDef -> Bool) -> [EntityDef] -> Maybe EntityDef
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find ((EntityNameDB -> EntityNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    == ColumnReference -> EntityNameDB
    crTableName ColumnReference
    colRef) (EntityNameDB -> Bool)
    -> (EntityDef -> EntityNameDB) -> EntityDef -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityDef -> EntityNameDB
    getEntityDBName) [EntityDef]
    defs of
                                Just EntityDef
    refdef
                                    | FieldNameDB -> Maybe FieldNameDB
    forall a. a -> Maybe a
    Just FieldNameDB
    _oldName Maybe FieldNameDB -> Maybe FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (FieldDef -> FieldNameDB) -> Maybe FieldDef -> Maybe FieldNameDB
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldDef -> FieldNameDB
    fieldDB (EntityDef -> Maybe FieldDef
    getEntityIdField EntityDef
    edef) ->
                                        [ EntityNameDB
    -> ConstraintNameDB
    -> NonEmpty FieldNameDB
    -> [Text]
    -> FieldCascade
    -> AlterColumn
    AddReference
                                            (ColumnReference -> EntityNameDB
    crTableName ColumnReference
    colRef)
                                            (ColumnReference -> ConstraintNameDB
    crConstraintName ColumnReference
    colRef)
                                            (FieldNameDB
    name FieldNameDB -> [FieldNameDB] -> NonEmpty FieldNameDB
    forall a. a -> [a] -> NonEmpty a
    NEL.:| [])
                                            (NonEmpty Text -> [Text]
    forall a. NonEmpty a -> [a]
    NEL.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ (FieldNameDB -> Text) -> EntityDef -> NonEmpty Text
    Util.dbIdColumnsEsc FieldNameDB -> Text
    escapeF EntityDef
    refdef)
                                            (ColumnReference -> FieldCascade
    crFieldCascade ColumnReference
    colRef)
                                        ]
                                Just EntityDef
    _ -> []
                                Maybe EntityDef
    Nothing ->
                                    [Char] -> [AlterColumn]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> [AlterColumn]) -> [Char] -> [AlterColumn]
    forall a b. (a -> b) -> a -> b
    $
                                        [Char]
    "could not find the entityDef for reftable["
                                            [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ EntityNameDB -> [Char]
    forall a. Show a => a -> [Char]
    show (ColumnReference -> EntityNameDB
    crTableName ColumnReference
    colRef)
                                            [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "]"
                        modRef :: [AlterColumn]
    modRef =
                            if Maybe ColumnReference -> Maybe ColumnReference -> Bool
    equivalentRef Maybe ColumnReference
    ref Maybe ColumnReference
    ref'
                                then []
                                else Maybe ColumnReference -> [AlterColumn]
    refDrop Maybe ColumnReference
    ref' [AlterColumn] -> [AlterColumn] -> [AlterColumn]
    forall a. [a] -> [a] -> [a]
    ++ Maybe ColumnReference -> [AlterColumn]
    refAdd Maybe ColumnReference
    ref
                        modNull :: [AlterColumn]
    modNull = case (Bool
    isNull, Bool
    isNull') of
                            (Bool
    True, Bool
    False) -> do
                                Bool -> [()]
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> [()]) -> Bool -> [()]
    forall a b. (a -> b) -> a -> b
    $ FieldNameDB -> Maybe FieldNameDB
    forall a. a -> Maybe a
    Just FieldNameDB
    name Maybe FieldNameDB -> Maybe FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    /= (FieldDef -> FieldNameDB) -> Maybe FieldDef -> Maybe FieldNameDB
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldDef -> FieldNameDB
    fieldDB (EntityDef -> Maybe FieldDef
    getEntityIdField EntityDef
    edef)
                                AlterColumn -> [AlterColumn]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Column -> AlterColumn
    IsNull Column
    col)
                            (Bool
    False, Bool
    True) ->
                                let
                                    up :: [AlterColumn] -> [AlterColumn]
    up = case Maybe Text
    def of
                                        Maybe Text
    Nothing -> [AlterColumn] -> [AlterColumn]
    forall a. a -> a
    id
                                        Just Text
    s -> (:) (Column -> Text -> AlterColumn
    UpdateNullToValue Column
    col Text
    s)
                                 in
                                    [AlterColumn] -> [AlterColumn]
    up [Column -> AlterColumn
    NotNull Column
    col]
                            (Bool, Bool)
    _ -> []
                        modType :: [AlterColumn]
    modType
                            | SqlType -> SqlType -> Bool
    sqlTypeEq SqlType
    sqltype SqlType
    sqltype' = []
                            -- When converting from Persistent pre-2.0 databases, we
                            -- need to make sure that TIMESTAMP WITHOUT TIME ZONE is
                            -- treated as UTC.
                            | SqlType
    sqltype SqlType -> SqlType -> Bool
    forall a. Eq a => a -> a -> Bool
    == SqlType
    SqlDayTime Bool -> Bool -> Bool
    && SqlType
    sqltype' SqlType -> SqlType -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> SqlType
    SqlOther Text
    "timestamp" =
                                [ Column -> SqlType -> Text -> AlterColumn
    ChangeType Column
    col SqlType
    sqltype (Text -> AlterColumn) -> Text -> AlterColumn
    forall a b. (a -> b) -> a -> b
    $
                                    [Text] -> Text
    T.concat
                                        [ Text
    " USING "
                                        , FieldNameDB -> Text
    escapeF FieldNameDB
    name
                                        , Text
    " AT TIME ZONE 'UTC'"
                                        ]
                                ]
                            | Bool
    otherwise = [Column -> SqlType -> Text -> AlterColumn
    ChangeType Column
    col SqlType
    sqltype Text
    ""]
                        modDef :: [AlterColumn]
    modDef =
                            if Maybe Text
    def Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe Text
    def'
                                Bool -> Bool -> Bool
    || Maybe Text -> Bool
    forall a. Maybe a -> Bool
    isJust (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "nextval" (Text -> Maybe Text) -> Maybe Text -> Maybe Text
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe Text
    def')
                                then []
                                else case Maybe Text
    def of
                                    Maybe Text
    Nothing -> [Column -> AlterColumn
    NoDefault Column
    col]
                                    Just Text
    s -> [Column -> Text -> AlterColumn
    Default Column
    col Text
    s]
                        dropSafe :: [a]
    dropSafe =
                            if EntityDef -> FieldNameDB -> Bool
    safeToRemove EntityDef
    edef FieldNameDB
    name
                                then [Char] -> [AlterColumn] -> [a]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "wtf" [Column -> SafeToRemove -> AlterColumn
    Drop Column
    col (Bool -> SafeToRemove
    SafeToRemove Bool
    True)]
                                else []
                     in
                        ( [AlterColumn]
    modRef [AlterColumn] -> [AlterColumn] -> [AlterColumn]
    forall a. [a] -> [a] -> [a]
    ++ [AlterColumn]
    modDef [AlterColumn] -> [AlterColumn] -> [AlterColumn]
    forall a. [a] -> [a] -> [a]
    ++ [AlterColumn]
    modNull [AlterColumn] -> [AlterColumn] -> [AlterColumn]
    forall a. [a] -> [a] -> [a]
    ++ [AlterColumn]
    modType [AlterColumn] -> [AlterColumn] -> [AlterColumn]
    forall a. [a] -> [a] -> [a]
    ++ [AlterColumn]
    forall a. [a]
    dropSafe
                        , (Column -> Bool) -> [Column] -> [Column]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Column
    c -> Column -> FieldNameDB
    cName Column
    c FieldNameDB -> FieldNameDB -> Bool
    forall a. Eq a => a -> a -> Bool
    /= FieldNameDB
    name) [Column]
    cols
                        )

    -- | Returns all of the columns in the given table currently in the database.
    getColumns
        :: (Text -> IO Statement)
        -> EntityDef
        -> [Column]
        -> IO [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    getColumns :: (Text -> IO Statement)
    -> EntityDef
    -> [Column]
    -> IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    getColumns Text -> IO Statement
    getter EntityDef
    def [Column]
    cols = do
        let
            sqlv :: Text
    sqlv =
                [Text] -> Text
    T.concat
                    [ Text
    "SELECT "
                    , Text
    "column_name "
                    , Text
    ",is_nullable "
                    , Text
    ",COALESCE(domain_name, udt_name)" -- See DOMAINS below
                    , Text
    ",column_default "
                    , Text
    ",generation_expression "
                    , Text
    ",numeric_precision "
                    , Text
    ",numeric_scale "
                    , Text
    ",character_maximum_length "
                    , Text
    "FROM information_schema.columns "
                    , Text
    "WHERE table_catalog=current_database() "
                    , Text
    "AND table_schema=current_schema() "
                    , Text
    "AND table_name=? "
                    ]

        -- DOMAINS Postgres supports the concept of domains, which are data types
        -- with optional constraints.  An app might make an "email" domain over the
        -- varchar type, with a CHECK that the emails are valid In this case the
        -- generated SQL should use the domain name: ALTER TABLE users ALTER COLUMN
        -- foo TYPE email This code exists to use the domain name (email), instead
        -- of the underlying type (varchar).  This is tested in
        -- EquivalentTypeTest.hs

        stmt <- Text -> IO Statement
    getter Text
    sqlv
        let
            vals =
                [ Text -> PersistValue
    PersistText (Text -> PersistValue) -> Text -> PersistValue
    forall a b. (a -> b) -> a -> b
    $ EntityNameDB -> Text
    unEntityNameDB (EntityNameDB -> Text) -> EntityNameDB -> Text
    forall a b. (a -> b) -> a -> b
    $ EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    def
                ]
        columns <-
            with
                (stmtQuery stmt vals)
                (\ConduitM () [PersistValue] IO ()
    src -> ConduitT
      ()
      Void
      IO
      [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT
       ()
       Void
       IO
       [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
     -> IO
          [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))])
    -> ConduitT
         ()
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall a b. (a -> b) -> a -> b
    $ ConduitM () [PersistValue] IO ()
    src ConduitM () [PersistValue] IO ()
    -> ConduitT
         [PersistValue]
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> ConduitT
         ()
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT
      [PersistValue]
      (Either Text (Either Column (ConstraintNameDB, [FieldNameDB])))
      IO
      ()
    forall {b}.
    ConduitT [PersistValue] (Either Text (Either Column b)) IO ()
    processColumns ConduitT
      [PersistValue]
      (Either Text (Either Column (ConstraintNameDB, [FieldNameDB])))
      IO
      ()
    -> ConduitT
         (Either Text (Either Column (ConstraintNameDB, [FieldNameDB])))
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> ConduitT
         [PersistValue]
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT
      (Either Text (Either Column (ConstraintNameDB, [FieldNameDB])))
      Void
      IO
      [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    CL.consume)
        let
            sqlc =
                [Text] -> Text
    T.concat
                    [ Text
    "SELECT "
                    , Text
    "c.constraint_name, "
                    , Text
    "c.column_name "
                    , Text
    "FROM information_schema.key_column_usage AS c, "
                    , Text
    "information_schema.table_constraints AS k "
                    , Text
    "WHERE c.table_catalog=current_database() "
                    , Text
    "AND c.table_catalog=k.table_catalog "
                    , Text
    "AND c.table_schema=current_schema() "
                    , Text
    "AND c.table_schema=k.table_schema "
                    , Text
    "AND c.table_name=? "
                    , Text
    "AND c.table_name=k.table_name "
                    , Text
    "AND c.constraint_name=k.constraint_name "
                    , Text
    "AND NOT k.constraint_type IN ('PRIMARY KEY', 'FOREIGN KEY') "
                    , Text
    "ORDER BY c.constraint_name, c.column_name"
                    ]

        stmt' <- getter sqlc

        us <- with (stmtQuery stmt' vals) (\ConduitM () [PersistValue] IO ()
    src -> ConduitT
      ()
      Void
      IO
      [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT
       ()
       Void
       IO
       [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
     -> IO
          [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))])
    -> ConduitT
         ()
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall a b. (a -> b) -> a -> b
    $ ConduitM () [PersistValue] IO ()
    src ConduitM () [PersistValue] IO ()
    -> ConduitT
         [PersistValue]
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    -> ConduitT
         ()
         Void
         IO
         [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT
      [PersistValue]
      Void
      IO
      [Either Text (Either Column (ConstraintNameDB, [FieldNameDB]))]
    forall {c} {a} {a}.
    ConduitT
      [PersistValue]
      c
      IO
      [Either a (Either a (ConstraintNameDB, [FieldNameDB]))]
    helperU)
        return $ columns ++ us
      where
        refMap :: Map Text (EntityNameDB, ConstraintNameDB)
    refMap =
            (ColumnReference -> (EntityNameDB, ConstraintNameDB))
    -> Map Text ColumnReference
    -> Map Text (EntityNameDB, ConstraintNameDB)
    forall a b. (a -> b) -> Map Text a -> Map Text b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ColumnReference
    cr -> (ColumnReference -> EntityNameDB
    crTableName ColumnReference
    cr, ColumnReference -> ConstraintNameDB
    crConstraintName ColumnReference
    cr)) (Map Text ColumnReference
     -> Map Text (EntityNameDB, ConstraintNameDB))
    -> Map Text ColumnReference
    -> Map Text (EntityNameDB, ConstraintNameDB)
    forall a b. (a -> b) -> a -> b
    $
                [(Text, ColumnReference)] -> Map Text ColumnReference
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList ([(Text, ColumnReference)] -> Map Text ColumnReference)
    -> [(Text, ColumnReference)] -> Map Text ColumnReference
    forall a b. (a -> b) -> a -> b
    $
                    ([(Text, ColumnReference)] -> Column -> [(Text, ColumnReference)])
    -> [(Text, ColumnReference)]
    -> [Column]
    -> [(Text, ColumnReference)]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    List.foldl' [(Text, ColumnReference)] -> Column -> [(Text, ColumnReference)]
    ref [] [Column]
    cols
          where
            ref :: [(Text, ColumnReference)] -> Column -> [(Text, ColumnReference)]
    ref [(Text, ColumnReference)]
    rs Column
    c =
                [(Text, ColumnReference)]
    -> (ColumnReference -> [(Text, ColumnReference)])
    -> Maybe ColumnReference
    -> [(Text, ColumnReference)]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [(Text, ColumnReference)]
    rs (\ColumnReference
    r -> (FieldNameDB -> Text
    unFieldNameDB (FieldNameDB -> Text) -> FieldNameDB -> Text
    forall a b. (a -> b) -> a -> b
    $ Column -> FieldNameDB
    cName Column
    c, ColumnReference
    r) (Text, ColumnReference)
    -> [(Text, ColumnReference)] -> [(Text, ColumnReference)]
    forall a. a -> [a] -> [a]
    : [(Text, ColumnReference)]
    rs) (Column -> Maybe ColumnReference
    cReference Column
    c)
        getAll :: ConduitT [PersistValue] (Text, Text) IO ()
    getAll =
            ([PersistValue] -> IO (Text, Text))
    -> ConduitT [PersistValue] (Text, Text) IO ()
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConduitT a b m ()
    CL.mapM (([PersistValue] -> IO (Text, Text))
     -> ConduitT [PersistValue] (Text, Text) IO ())
    -> ([PersistValue] -> IO (Text, Text))
    -> ConduitT [PersistValue] (Text, Text) IO ()
    forall a b. (a -> b) -> a -> b
    $ \[PersistValue]
    x ->
                (Text, Text) -> IO (Text, Text)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Text, Text) -> IO (Text, Text))
    -> (Text, Text) -> IO (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ case [PersistValue]
    x of
                    [PersistText Text
    con, PersistText Text
    col] ->
                        (Text
    con, Text
    col)
                    [PersistByteString StrictByteString
    con, PersistByteString StrictByteString
    col] ->
                        (StrictByteString -> Text
    T.decodeUtf8 StrictByteString
    con, StrictByteString -> Text
    T.decodeUtf8 StrictByteString
    col)
                    [PersistValue]
    o ->
                        [Char] -> (Text, Text)
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (Text, Text)) -> [Char] -> (Text, Text)
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "unexpected datatype returned for postgres o=" [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [PersistValue] -> [Char]
    forall a. Show a => a -> [Char]
    show [PersistValue]
    o
        helperU :: ConduitT
      [PersistValue]
      c
      IO
      [Either a (Either a (ConstraintNameDB, [FieldNameDB]))]
    helperU = do
            rows <- ConduitT [PersistValue] (Text, Text) IO ()
    getAll ConduitT [PersistValue] (Text, Text) IO ()
    -> ConduitT (Text, Text) c IO [(Text, Text)]
    -> ConduitT [PersistValue] c IO [(Text, Text)]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT (Text, Text) c IO [(Text, Text)]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    CL.consume
            return
                $ map
                    (Right . Right . (ConstraintNameDB . fst . head &&& map (FieldNameDB . snd)))
                $ groupBy ((==) `on` fst) rows
        processColumns :: ConduitT [PersistValue] (Either Text (Either Column b)) IO ()
    processColumns =
            ([PersistValue] -> IO (Either Text (Either Column b)))
    -> ConduitT [PersistValue] (Either Text (Either Column b)) IO ()
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ConduitT a b m ()
    CL.mapM (([PersistValue] -> IO (Either Text (Either Column b)))
     -> ConduitT [PersistValue] (Either Text (Either Column b)) IO ())
    -> ([PersistValue] -> IO (Either Text (Either Column b)))
    -> ConduitT [PersistValue] (Either Text (Either Column b)) IO ()
    forall a b. (a -> b) -> a -> b
    $ \x' :: [PersistValue]
    x'@((PersistText Text
    cname) : [PersistValue]
    _) -> do
                col <-
                    IO (Either Text Column) -> IO (Either Text Column)
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either Text Column) -> IO (Either Text Column))
    -> IO (Either Text Column) -> IO (Either Text Column)
    forall a b. (a -> b) -> a -> b
    $ (Text -> IO Statement)
    -> EntityNameDB
    -> [PersistValue]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    -> IO (Either Text Column)
    getColumn Text -> IO Statement
    getter (EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    def) [PersistValue]
    x' (Text
    -> Map Text (EntityNameDB, ConstraintNameDB)
    -> Maybe (EntityNameDB, ConstraintNameDB)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Text
    cname Map Text (EntityNameDB, ConstraintNameDB)
    refMap)
                pure $ case col of
                    Left Text
    e -> Text -> Either Text (Either Column b)
    forall a b. a -> Either a b
    Left Text
    e
                    Right Column
    c -> Either Column b -> Either Text (Either Column b)
    forall a b. b -> Either a b
    Right (Either Column b -> Either Text (Either Column b))
    -> Either Column b -> Either Text (Either Column b)
    forall a b. (a -> b) -> a -> b
    $ Column -> Either Column b
    forall a b. a -> Either a b
    Left Column
    c

    getColumn
        :: (Text -> IO Statement)
        -> EntityNameDB
        -> [PersistValue]
        -> Maybe (EntityNameDB, ConstraintNameDB)
        -> IO (Either Text Column)
    getColumn :: (Text -> IO Statement)
    -> EntityNameDB
    -> [PersistValue]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    -> IO (Either Text Column)
    getColumn
        Text -> IO Statement
    getter
        EntityNameDB
    tableName'
        [ PersistText Text
    columnName
            , PersistText Text
    isNullable
            , PersistText Text
    typeName
            , PersistValue
    defaultValue
            , PersistValue
    generationExpression
            , PersistValue
    numericPrecision
            , PersistValue
    numericScale
            , PersistValue
    maxlen
            ]
        Maybe (EntityNameDB, ConstraintNameDB)
    refName_ = ExceptT Text IO Column -> IO (Either Text Column)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT Text IO Column -> IO (Either Text Column))
    -> ExceptT Text IO Column -> IO (Either Text Column)
    forall a b. (a -> b) -> a -> b
    $ do
            defaultValue' <-
                case PersistValue
    defaultValue of
                    PersistValue
    PersistNull ->
                        Maybe Text -> ExceptT Text IO (Maybe Text)
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Text
    forall a. Maybe a
    Nothing
                    PersistText Text
    t ->
                        Maybe Text -> ExceptT Text IO (Maybe Text)
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Text -> ExceptT Text IO (Maybe Text))
    -> Maybe Text -> ExceptT Text IO (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    t
                    PersistValue
    _ ->
                        Text -> ExceptT Text IO (Maybe Text)
    forall a. Text -> ExceptT Text IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ExceptT Text IO (Maybe Text))
    -> Text -> ExceptT Text IO (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid default column: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ PersistValue -> [Char]
    forall a. Show a => a -> [Char]
    show PersistValue
    defaultValue

            generationExpression' <-
                case generationExpression of
                    PersistValue
    PersistNull ->
                        Maybe Text -> ExceptT Text IO (Maybe Text)
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Text
    forall a. Maybe a
    Nothing
                    PersistText Text
    t ->
                        Maybe Text -> ExceptT Text IO (Maybe Text)
    forall a. a -> ExceptT Text IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Text -> ExceptT Text IO (Maybe Text))
    -> Maybe Text -> ExceptT Text IO (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    t
                    PersistValue
    _ ->
                        Text -> ExceptT Text IO (Maybe Text)
    forall a. Text -> ExceptT Text IO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> ExceptT Text IO (Maybe Text))
    -> Text -> ExceptT Text IO (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid generated column: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ PersistValue -> [Char]
    forall a. Show a => a -> [Char]
    show PersistValue
    generationExpression

            let
                typeStr =
                    case PersistValue
    maxlen of
                        PersistInt64 Int64
    n ->
                            [Text] -> Text
    T.concat [Text
    typeName, Text
    "(", [Char] -> Text
    T.pack (Int64 -> [Char]
    forall a. Show a => a -> [Char]
    show Int64
    n), Text
    ")"]
                        PersistValue
    _ ->
                            Text
    typeName

            t <- getType typeStr

            let
                cname = Text -> FieldNameDB
    FieldNameDB Text
    columnName

            ref <- lift $ fmap join $ traverse (getRef cname) refName_

            return
                Column
                    { cName = cname
                    , cNull = isNullable == "YES"
                    , cSqlType = t
                    , cDefault = fmap stripSuffixes defaultValue'
                    , cGenerated = fmap stripSuffixes generationExpression'
                    , cDefaultConstraintName = Nothing
                    , cMaxLen = Nothing
                    , cReference = fmap (\(EntityNameDB
    a, ConstraintNameDB
    b, Text
    c, Text
    d) -> EntityNameDB -> ConstraintNameDB -> FieldCascade -> ColumnReference
    ColumnReference EntityNameDB
    a ConstraintNameDB
    b (Text -> Text -> FieldCascade
    forall {a} {a}.
    (Eq a, Eq a, IsString a, IsString a, Show a, Show a) =>
    a -> a -> FieldCascade
    mkCascade Text
    c Text
    d)) ref
                    }
          where
            mkCascade :: a -> a -> FieldCascade
    mkCascade a
    updText a
    delText =
                FieldCascade
                    { fcOnUpdate :: Maybe CascadeAction
    fcOnUpdate = a -> Maybe CascadeAction
    forall {a}. (Eq a, IsString a, Show a) => a -> Maybe CascadeAction
    parseCascade a
    updText
                    , fcOnDelete :: Maybe CascadeAction
    fcOnDelete = a -> Maybe CascadeAction
    forall {a}. (Eq a, IsString a, Show a) => a -> Maybe CascadeAction
    parseCascade a
    delText
                    }

            parseCascade :: a -> Maybe CascadeAction
    parseCascade a
    txt =
                case a
    txt of
                    a
    "NO ACTION" ->
                        Maybe CascadeAction
    forall a. Maybe a
    Nothing
                    a
    "CASCADE" ->
                        CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    Cascade
                    a
    "SET NULL" ->
                        CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    SetNull
                    a
    "SET DEFAULT" ->
                        CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    SetDefault
                    a
    "RESTRICT" ->
                        CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    Restrict
                    a
    _ ->
                        [Char] -> Maybe CascadeAction
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe CascadeAction) -> [Char] -> Maybe CascadeAction
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unexpected value in parseCascade: " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    txt

            stripSuffixes :: Text -> Text
    stripSuffixes Text
    t =
                [Text] -> Text
    loop'
                    [ Text
    "::character varying"
                    , Text
    "::text"
                    ]
              where
                loop' :: [Text] -> Text
    loop' [] = Text
    t
                loop' (Text
    p : [Text]
    ps) =
                    case Text -> Text -> Maybe Text
    T.stripSuffix Text
    p Text
    t of
                        Maybe Text
    Nothing -> [Text] -> Text
    loop' [Text]
    ps
                        Just Text
    t' -> Text
    t'

            getRef :: FieldNameDB
    -> (a, ConstraintNameDB)
    -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text))
    getRef FieldNameDB
    cname (a
    _, ConstraintNameDB
    refName') = do
                let
                    sql :: Text
    sql =
                        [Text] -> Text
    T.concat
                            [ Text
    "SELECT DISTINCT "
                            , Text
    "ccu.table_name, "
                            , Text
    "tc.constraint_name, "
                            , Text
    "rc.update_rule, "
                            , Text
    "rc.delete_rule "
                            , Text
    "FROM information_schema.constraint_column_usage ccu "
                            , Text
    "INNER JOIN information_schema.key_column_usage kcu "
                            , Text
    "  ON ccu.constraint_name = kcu.constraint_name "
                            , Text
    "INNER JOIN information_schema.table_constraints tc "
                            , Text
    "  ON tc.constraint_name = kcu.constraint_name "
                            , Text
    "LEFT JOIN information_schema.referential_constraints AS rc"
                            , Text
    "  ON rc.constraint_name = ccu.constraint_name "
                            , Text
    "WHERE tc.constraint_type='FOREIGN KEY' "
                            , Text
    "AND kcu.ordinal_position=1 "
                            , Text
    "AND kcu.table_name=? "
                            , Text
    "AND kcu.column_name=? "
                            , Text
    "AND tc.constraint_name=?"
                            ]
                stmt <- Text -> IO Statement
    getter Text
    sql
                cntrs <-
                    with
                        ( stmtQuery
                            stmt
                            [ PersistText $ unEntityNameDB tableName'
                            , PersistText $ unFieldNameDB cname
                            , PersistText $ unConstraintNameDB refName'
                            ]
                        )
                        (\ConduitM () [PersistValue] IO ()
    src -> ConduitT () Void IO [[PersistValue]] -> IO [[PersistValue]]
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO [[PersistValue]] -> IO [[PersistValue]])
    -> ConduitT () Void IO [[PersistValue]] -> IO [[PersistValue]]
    forall a b. (a -> b) -> a -> b
    $ ConduitM () [PersistValue] IO ()
    src ConduitM () [PersistValue] IO ()
    -> ConduitT [PersistValue] Void IO [[PersistValue]]
    -> ConduitT () Void IO [[PersistValue]]
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT [PersistValue] Void IO [[PersistValue]]
    forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
    CL.consume)
                case cntrs of
                    [] ->
                        Maybe (EntityNameDB, ConstraintNameDB, Text, Text)
    -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (EntityNameDB, ConstraintNameDB, Text, Text)
    forall a. Maybe a
    Nothing
                    [ [ PersistText Text
    table
                            , PersistText Text
    constraint
                            , PersistText Text
    updRule
                            , PersistText Text
    delRule
                            ]
                        ] ->
                            Maybe (EntityNameDB, ConstraintNameDB, Text, Text)
    -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (EntityNameDB, ConstraintNameDB, Text, Text)
     -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text)))
    -> Maybe (EntityNameDB, ConstraintNameDB, Text, Text)
    -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text))
    forall a b. (a -> b) -> a -> b
    $
                                (EntityNameDB, ConstraintNameDB, Text, Text)
    -> Maybe (EntityNameDB, ConstraintNameDB, Text, Text)
    forall a. a -> Maybe a
    Just (Text -> EntityNameDB
    EntityNameDB Text
    table, Text -> ConstraintNameDB
    ConstraintNameDB Text
    constraint, Text
    updRule, Text
    delRule)
                    [[PersistValue]]
    xs ->
                        [Char] -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text))
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text)))
    -> [Char]
    -> IO (Maybe (EntityNameDB, ConstraintNameDB, Text, Text))
    forall a b. (a -> b) -> a -> b
    $
                            [[Char]] -> [Char]
    forall a. Monoid a => [a] -> a
    mconcat
                                [ [Char]
    "Postgresql.getColumn: error fetching constraints. Expected a single result for foreign key query for table: "
                                , Text -> [Char]
    T.unpack (EntityNameDB -> Text
    unEntityNameDB EntityNameDB
    tableName')
                                , [Char]
    " and column: "
                                , Text -> [Char]
    T.unpack (FieldNameDB -> Text
    unFieldNameDB FieldNameDB
    cname)
                                , [Char]
    " but got: "
                                , [[PersistValue]] -> [Char]
    forall a. Show a => a -> [Char]
    show [[PersistValue]]
    xs
                                ]

            getType :: Text -> f SqlType
    getType Text
    "int4" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlInt32
            getType Text
    "int8" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlInt64
            getType Text
    "varchar" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlString
            getType Text
    "text" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlString
            getType Text
    "date" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlDay
            getType Text
    "bool" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlBool
            getType Text
    "timestamptz" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlDayTime
            getType Text
    "float4" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlReal
            getType Text
    "float8" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlReal
            getType Text
    "bytea" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlBlob
            getType Text
    "time" = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure SqlType
    SqlTime
            getType Text
    "numeric" = PersistValue -> PersistValue -> f SqlType
    forall {f :: * -> *}.
    MonadError Text f =>
    PersistValue -> PersistValue -> f SqlType
    getNumeric PersistValue
    numericPrecision PersistValue
    numericScale
            getType Text
    a = SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SqlType -> f SqlType) -> SqlType -> f SqlType
    forall a b. (a -> b) -> a -> b
    $ Text -> SqlType
    SqlOther Text
    a

            getNumeric :: PersistValue -> PersistValue -> f SqlType
    getNumeric (PersistInt64 Int64
    a) (PersistInt64 Int64
    b) =
                SqlType -> f SqlType
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (SqlType -> f SqlType) -> SqlType -> f SqlType
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32 -> SqlType
    SqlNumeric (Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    a) (Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int64
    b)
            getNumeric PersistValue
    PersistNull PersistValue
    PersistNull =
                Text -> f SqlType
    forall a. Text -> f a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> f SqlType) -> Text -> f SqlType
    forall a b. (a -> b) -> a -> b
    $
                    [Text] -> Text
    T.concat
                        [ Text
    "No precision and scale were specified for the column: "
                        , Text
    columnName
                        , Text
    " in table: "
                        , EntityNameDB -> Text
    unEntityNameDB EntityNameDB
    tableName'
                        , Text
    ". Postgres defaults to a maximum scale of 147,455 and precision of 16383,"
                        , Text
    " which is probably not what you intended."
                        , Text
    " Specify the values as numeric(total_digits, digits_after_decimal_place)."
                        ]
            getNumeric PersistValue
    a PersistValue
    b =
                Text -> f SqlType
    forall a. Text -> f a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Text -> f SqlType) -> Text -> f SqlType
    forall a b. (a -> b) -> a -> b
    $
                    [Text] -> Text
    T.concat
                        [ Text
    "Can not get numeric field precision for the column: "
                        , Text
    columnName
                        , Text
    " in table: "
                        , EntityNameDB -> Text
    unEntityNameDB EntityNameDB
    tableName'
                        , Text
    ". Expected an integer for both precision and scale, "
                        , Text
    "got: "
                        , [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ PersistValue -> [Char]
    forall a. Show a => a -> [Char]
    show PersistValue
    a
                        , Text
    " and "
                        , [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $ PersistValue -> [Char]
    forall a. Show a => a -> [Char]
    show PersistValue
    b
                        , Text
    ", respectively."
                        , Text
    " Specify the values as numeric(total_digits, digits_after_decimal_place)."
                        ]
    getColumn Text -> IO Statement
    _ EntityNameDB
    _ [PersistValue]
    columnName Maybe (EntityNameDB, ConstraintNameDB)
    _ =
        Either Text Column -> IO (Either Text Column)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Text Column -> IO (Either Text Column))
    -> Either Text Column -> IO (Either Text Column)
    forall a b. (a -> b) -> a -> b
    $
            Text -> Either Text Column
    forall a b. a -> Either a b
    Left (Text -> Either Text Column) -> Text -> Either Text Column
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> Text
    T.pack ([Char] -> Text) -> [Char] -> Text
    forall a b. (a -> b) -> a -> b
    $
                    [Char]
    "Invalid result from information_schema: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [PersistValue] -> [Char]
    forall a. Show a => a -> [Char]
    show [PersistValue]
    columnName

    doesTableExist
        :: (Text -> IO Statement)
        -> EntityNameDB
        -> IO Bool
    doesTableExist :: (Text -> IO Statement) -> EntityNameDB -> IO Bool
    doesTableExist Text -> IO Statement
    getter (EntityNameDB Text
    name) = do
        stmt <- Text -> IO Statement
    getter Text
    sql
        with (stmtQuery stmt vals) (\ConduitM () [PersistValue] IO ()
    src -> ConduitT () Void IO Bool -> IO Bool
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void IO Bool -> IO Bool)
    -> ConduitT () Void IO Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ ConduitM () [PersistValue] IO ()
    src ConduitM () [PersistValue] IO ()
    -> ConduitT [PersistValue] Void IO Bool -> ConduitT () Void IO Bool
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitT [PersistValue] Void IO Bool
    forall {o}. ConduitT [PersistValue] o IO Bool
    start)
      where
        sql :: Text
    sql =
            Text
    "SELECT COUNT(*) FROM pg_catalog.pg_tables WHERE schemaname != 'pg_catalog'"
                Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " AND schemaname != 'information_schema' AND tablename=?"
        vals :: [PersistValue]
    vals = [Text -> PersistValue
    PersistText Text
    name]

        start :: ConduitT [PersistValue] o IO Bool
    start = ConduitT [PersistValue] o IO (Maybe [PersistValue])
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
    await ConduitT [PersistValue] o IO (Maybe [PersistValue])
    -> (Maybe [PersistValue] -> ConduitT [PersistValue] o IO Bool)
    -> ConduitT [PersistValue] o IO Bool
    forall a b.
    ConduitT [PersistValue] o IO a
    -> (a -> ConduitT [PersistValue] o IO b)
    -> ConduitT [PersistValue] o IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConduitT [PersistValue] o IO Bool
    -> ([PersistValue] -> ConduitT [PersistValue] o IO Bool)
    -> Maybe [PersistValue]
    -> ConduitT [PersistValue] o IO Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([Char] -> ConduitT [PersistValue] o IO Bool
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "No results when checking doesTableExist") [PersistValue] -> ConduitT [PersistValue] o IO Bool
    forall {m :: * -> *} {i} {o}.
    Monad m =>
    [PersistValue] -> ConduitT i o m Bool
    start'
        start' :: [PersistValue] -> ConduitT i o m Bool
    start' [PersistInt64 Int64
    0] = Bool -> ConduitT i o m Bool
    forall {m :: * -> *} {b} {i} {o}. Monad m => b -> ConduitT i o m b
    finish Bool
    False
        start' [PersistInt64 Int64
    1] = Bool -> ConduitT i o m Bool
    forall {m :: * -> *} {b} {i} {o}. Monad m => b -> ConduitT i o m b
    finish Bool
    True
        start' [PersistValue]
    res = [Char] -> ConduitT i o m Bool
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ConduitT i o m Bool) -> [Char] -> ConduitT i o m Bool
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "doesTableExist returned unexpected result: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [PersistValue] -> [Char]
    forall a. Show a => a -> [Char]
    show [PersistValue]
    res
        finish :: b -> ConduitT i o m b
    finish b
    x = ConduitT i o m (Maybe i)
    forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
    await ConduitT i o m (Maybe i)
    -> (Maybe i -> ConduitT i o m b) -> ConduitT i o m b
    forall a b.
    ConduitT i o m a -> (a -> ConduitT i o m b) -> ConduitT i o m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ConduitT i o m b
    -> (i -> ConduitT i o m b) -> Maybe i -> ConduitT i o m b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (b -> ConduitT i o m b
    forall a. a -> ConduitT i o m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    x) ([Char] -> i -> ConduitT i o m b
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Too many rows returned in doesTableExist")