    {-# LANGUAGE DeriveLift #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE StrictData #-}
    {-# LANGUAGE UndecidableInstances #-}
    {-# LANGUAGE ViewPatterns #-}

    -- | This @Internal@ module may have breaking changes that will not be reflected
    -- in major version bumps. Please use "Database.Persist.Quasi" instead. If you
    -- need something in this module, please file an issue on GitHub.
    --
    -- @since 2.13.0.0
    module Database.Persist.Quasi.Internal
        ( parse
        , PersistSettings (..)
        , upperCaseSettings
        , lowerCaseSettings
        , Attribute (..)
        , SourceLoc (..)
        , sourceLocFromTHLoc
        , parseFieldType
        , takeColsEx
        , CumulativeParseResult
        , renderErrors
        , parserWarningMessage

          -- * UnboundEntityDef
        , UnboundEntityDef (..)
        , getUnboundEntityNameHS
        , unbindEntityDef
        , getUnboundFieldDefs
        , UnboundForeignDef (..)
        , getSqlNameOr
        , UnboundFieldDef (..)
        , UnboundCompositeDef (..)
        , UnboundIdDef (..)
        , unbindFieldDef
        , isUnboundFieldNullable
        , unboundIdDefToFieldDef
        , PrimarySpec (..)
        , mkAutoIdField'
        , UnboundForeignFieldList (..)
        , ForeignFieldReference (..)
        , mkKeyConType
        , isHaskellUnboundField
        , FieldTypeLit (..)
        ) where

    import Prelude hiding (lines)

    import Control.Applicative (Alternative ((<|>)))
    import Control.Monad
    import Data.Char (isDigit, isLower, isSpace, isUpper, toLower)
    import Data.Foldable (toList)
    import Data.List (find, foldl')
    import Data.List.NonEmpty (NonEmpty (..))
    import qualified Data.List.NonEmpty as NEL
    import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
    import Data.Monoid (mappend)
    import Data.Text (Text)
    import qualified Data.Text as T
    import Database.Persist.EntityDef.Internal
    import Database.Persist.Quasi.Internal.ModelParser
    import Database.Persist.Quasi.PersistSettings
    import Database.Persist.Quasi.PersistSettings.Internal
        ( psIdName
        , psStrictFields
        , psToDBName
        , psToFKName
        )
    import Database.Persist.Types
    import Database.Persist.Types.Base
    import Language.Haskell.TH.Syntax (Lift, Loc (..))
    import qualified Text.Read as R

    data ParseState a = PSDone | PSFail String | PSSuccess a Text deriving (Int -> ParseState a -> ShowS
    [ParseState a] -> ShowS
    ParseState a -> [Char]
    (Int -> ParseState a -> ShowS)
    -> (ParseState a -> [Char])
    -> ([ParseState a] -> ShowS)
    -> Show (ParseState a)
    forall a. Show a => Int -> ParseState a -> ShowS
    forall a. Show a => [ParseState a] -> ShowS
    forall a. Show a => ParseState a -> [Char]
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> ParseState a -> ShowS
    showsPrec :: Int -> ParseState a -> ShowS
    $cshow :: forall a. Show a => ParseState a -> [Char]
    show :: ParseState a -> [Char]
    $cshowList :: forall a. Show a => [ParseState a] -> ShowS
    showList :: [ParseState a] -> ShowS
    Show)

    parseFieldType :: Text -> Either String FieldType
    parseFieldType :: Text -> Either [Char] FieldType
    parseFieldType Text
    t0 =
        case Text -> ParseState FieldType
    parseApplyFT Text
    t0 of
            PSSuccess FieldType
    ft Text
    t'
                | (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isSpace Text
    t' -> FieldType -> Either [Char] FieldType
    forall a b. b -> Either a b
    Right FieldType
    ft
            PSFail [Char]
    err -> [Char] -> Either [Char] FieldType
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] FieldType)
    -> [Char] -> Either [Char] FieldType
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "PSFail " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    err
            ParseState FieldType
    other -> [Char] -> Either [Char] FieldType
    forall a b. a -> Either a b
    Left ([Char] -> Either [Char] FieldType)
    -> [Char] -> Either [Char] FieldType
    forall a b. (a -> b) -> a -> b
    $ ParseState FieldType -> [Char]
    forall a. Show a => a -> [Char]
    show ParseState FieldType
    other
      where
        parseApplyFT :: Text -> ParseState FieldType
        parseApplyFT :: Text -> ParseState FieldType
    parseApplyFT Text
    t =
            case ([FieldType] -> [FieldType]) -> Text -> ParseState [FieldType]
    forall a. ([FieldType] -> a) -> Text -> ParseState a
    goMany [FieldType] -> [FieldType]
    forall a. a -> a
    id Text
    t of
                PSSuccess (FieldType
    ft : [FieldType]
    fts) Text
    t' -> FieldType -> Text -> ParseState FieldType
    forall a. a -> Text -> ParseState a
    PSSuccess ((FieldType -> FieldType -> FieldType)
    -> FieldType -> [FieldType] -> FieldType
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' FieldType -> FieldType -> FieldType
    FTApp FieldType
    ft [FieldType]
    fts) Text
    t'
                PSSuccess [] Text
    _ -> [Char] -> ParseState FieldType
    forall a. [Char] -> ParseState a
    PSFail [Char]
    "empty"
                PSFail [Char]
    err -> [Char] -> ParseState FieldType
    forall a. [Char] -> ParseState a
    PSFail [Char]
    err
                ParseState [FieldType]
    PSDone -> ParseState FieldType
    forall a. ParseState a
    PSDone

        parseEnclosed
            :: Char -> (FieldType -> FieldType) -> Text -> ParseState FieldType
        parseEnclosed :: Char -> (FieldType -> FieldType) -> Text -> ParseState FieldType
    parseEnclosed Char
    end FieldType -> FieldType
    ftMod Text
    t =
            let
                (Text
    a, Text
    b) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    end) Text
    t
             in
                case Text -> ParseState FieldType
    parseApplyFT Text
    a of
                    PSSuccess FieldType
    ft Text
    t' -> case ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isSpace Text
    t', Text -> Maybe (Char, Text)
    T.uncons Text
    b) of
                        (Text
    "", Just (Char
    c, Text
    t'')) | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    end -> FieldType -> Text -> ParseState FieldType
    forall a. a -> Text -> ParseState a
    PSSuccess (FieldType -> FieldType
    ftMod FieldType
    ft) (Text
    t'' Text -> Text -> Text
    forall a. Monoid a => a -> a -> a
    `Data.Monoid.mappend` Text
    t')
                        (Text
    x, Maybe (Char, Text)
    y) -> [Char] -> ParseState FieldType
    forall a. [Char] -> ParseState a
    PSFail ([Char] -> ParseState FieldType) -> [Char] -> ParseState FieldType
    forall a b. (a -> b) -> a -> b
    $ (Text, Text, Maybe (Char, Text)) -> [Char]
    forall a. Show a => a -> [Char]
    show (Text
    b, Text
    x, Maybe (Char, Text)
    y)
                    ParseState FieldType
    x -> [Char] -> ParseState FieldType
    forall a. [Char] -> ParseState a
    PSFail ([Char] -> ParseState FieldType) -> [Char] -> ParseState FieldType
    forall a b. (a -> b) -> a -> b
    $ ParseState FieldType -> [Char]
    forall a. Show a => a -> [Char]
    show ParseState FieldType
    x

        parse1 :: Text -> ParseState FieldType
        parse1 :: Text -> ParseState FieldType
    parse1 Text
    t = ParseState FieldType
    -> Maybe (ParseState FieldType) -> ParseState FieldType
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> ParseState FieldType
    forall a. [Char] -> ParseState a
    PSFail (Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    t)) (Maybe (ParseState FieldType) -> ParseState FieldType)
    -> Maybe (ParseState FieldType) -> ParseState FieldType
    forall a b. (a -> b) -> a -> b
    $ do
            case Text -> Maybe (Char, Text)
    T.uncons Text
    t of
                Maybe (Char, Text)
    Nothing -> ParseState FieldType -> Maybe (ParseState FieldType)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ParseState FieldType
    forall a. ParseState a
    PSDone
                Just (Char
    x, Text
    xs) ->
                    Char -> Text -> Maybe (ParseState FieldType)
    parseSpace Char
    x Text
    xs
                        Maybe (ParseState FieldType)
    -> Maybe (ParseState FieldType) -> Maybe (ParseState FieldType)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Char -> Text -> Maybe (ParseState FieldType)
    forall {m :: * -> *}.
    (Monad m, Alternative m) =>
    Char -> Text -> m (ParseState FieldType)
    parseParenEnclosed Char
    x Text
    xs
                        Maybe (ParseState FieldType)
    -> Maybe (ParseState FieldType) -> Maybe (ParseState FieldType)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Char -> Text -> Maybe (ParseState FieldType)
    forall {m :: * -> *}.
    (Monad m, Alternative m) =>
    Char -> Text -> m (ParseState FieldType)
    parseList Char
    x Text
    xs
                        Maybe (ParseState FieldType)
    -> Maybe (ParseState FieldType) -> Maybe (ParseState FieldType)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Char -> Text -> Maybe (ParseState FieldType)
    parseNumericLit Char
    x Text
    xs
                        Maybe (ParseState FieldType)
    -> Maybe (ParseState FieldType) -> Maybe (ParseState FieldType)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Char -> Text -> Maybe (ParseState FieldType)
    parseTextLit Char
    x Text
    xs
                        Maybe (ParseState FieldType)
    -> Maybe (ParseState FieldType) -> Maybe (ParseState FieldType)
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Char -> Text -> Maybe (ParseState FieldType)
    forall {m :: * -> *}.
    (Monad m, Alternative m) =>
    Char -> Text -> m (ParseState FieldType)
    parseTypeCon Char
    x Text
    xs

        parseSpace :: Char -> Text -> Maybe (ParseState FieldType)
        parseSpace :: Char -> Text -> Maybe (ParseState FieldType)
    parseSpace Char
    c Text
    t = do
            Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Char -> Bool
    isSpace Char
    c)
            ParseState FieldType -> Maybe (ParseState FieldType)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ParseState FieldType -> Maybe (ParseState FieldType))
    -> ParseState FieldType -> Maybe (ParseState FieldType)
    forall a b. (a -> b) -> a -> b
    $ Text -> ParseState FieldType
    parse1 ((Char -> Bool) -> Text -> Text
    T.dropWhile Char -> Bool
    isSpace Text
    t)

        parseParenEnclosed :: Char -> Text -> m (ParseState FieldType)
    parseParenEnclosed Char
    c Text
    t = do
            Bool -> m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '(')
            ParseState FieldType -> m (ParseState FieldType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ParseState FieldType -> m (ParseState FieldType))
    -> ParseState FieldType -> m (ParseState FieldType)
    forall a b. (a -> b) -> a -> b
    $ Char -> (FieldType -> FieldType) -> Text -> ParseState FieldType
    parseEnclosed Char
    ')' FieldType -> FieldType
    forall a. a -> a
    id Text
    t

        parseList :: Char -> Text -> m (ParseState FieldType)
    parseList Char
    c Text
    t = do
            Bool -> m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '[')
            ParseState FieldType -> m (ParseState FieldType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ParseState FieldType -> m (ParseState FieldType))
    -> ParseState FieldType -> m (ParseState FieldType)
    forall a b. (a -> b) -> a -> b
    $ Char -> (FieldType -> FieldType) -> Text -> ParseState FieldType
    parseEnclosed Char
    ']' FieldType -> FieldType
    FTList Text
    t

        parseTextLit :: Char -> Text -> Maybe (ParseState FieldType)
        parseTextLit :: Char -> Text -> Maybe (ParseState FieldType)
    parseTextLit Char
    c Text
    t = do
            Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"')
            let
                (Text
    a, Text
    b) = (Char -> Bool) -> Text -> (Text, Text)
    T.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '"') Text
    t
                lit :: FieldType
    lit = FieldTypeLit -> FieldType
    FTLit (Text -> FieldTypeLit
    TextTypeLit Text
    a)
            ParseState FieldType -> Maybe (ParseState FieldType)
    forall a. a -> Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ParseState FieldType -> Maybe (ParseState FieldType))
    -> ParseState FieldType -> Maybe (ParseState FieldType)
    forall a b. (a -> b) -> a -> b
    $ FieldType -> Text -> ParseState FieldType
    forall a. a -> Text -> ParseState a
    PSSuccess FieldType
    lit (Int -> Text -> Text
    T.drop Int
    1 Text
    b)

        parseNumericLit :: Char -> Text -> Maybe (ParseState FieldType)
        parseNumericLit :: Char -> Text -> Maybe (ParseState FieldType)
    parseNumericLit Char
    c Text
    t = do
            Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Char -> Bool
    isDigit Char
    c Bool -> Bool -> Bool
    && (Char -> Bool) -> Text -> Bool
    T.all Char -> Bool
    isDigit Text
    t)
            let
                (Text
    a, Text
    b) = Text -> (Text, Text)
    breakAtNextSpace Text
    t
            lit <- FieldTypeLit -> FieldType
    FTLit (FieldTypeLit -> FieldType)
    -> (Integer -> FieldTypeLit) -> Integer -> FieldType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Integer -> FieldTypeLit
    IntTypeLit (Integer -> FieldType) -> Maybe Integer -> Maybe FieldType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Text -> Maybe Integer
    forall a. Read a => Text -> Maybe a
    readMaybe (Char -> Text -> Text
    T.cons Char
    c Text
    a)
            pure $ PSSuccess lit b

        parseTypeCon :: Char -> Text -> m (ParseState FieldType)
    parseTypeCon Char
    c Text
    t = do
            Bool -> m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Char -> Bool
    isUpper Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\'')
            let
                (Text
    a, Text
    b) = Text -> (Text, Text)
    breakAtNextSpace Text
    t
            ParseState FieldType -> m (ParseState FieldType)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ParseState FieldType -> m (ParseState FieldType))
    -> ParseState FieldType -> m (ParseState FieldType)
    forall a b. (a -> b) -> a -> b
    $ FieldType -> Text -> ParseState FieldType
    forall a. a -> Text -> ParseState a
    PSSuccess (Char -> Text -> FieldType
    parseFieldTypePiece Char
    c Text
    a) Text
    b

        goMany :: ([FieldType] -> a) -> Text -> ParseState a
        goMany :: forall a. ([FieldType] -> a) -> Text -> ParseState a
    goMany [FieldType] -> a
    front Text
    t =
            case Text -> ParseState FieldType
    parse1 Text
    t of
                PSSuccess FieldType
    x Text
    t' -> ([FieldType] -> a) -> Text -> ParseState a
    forall a. ([FieldType] -> a) -> Text -> ParseState a
    goMany ([FieldType] -> a
    front ([FieldType] -> a)
    -> ([FieldType] -> [FieldType]) -> [FieldType] -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FieldType
    x FieldType -> [FieldType] -> [FieldType]
    forall a. a -> [a] -> [a]
    :)) Text
    t'
                PSFail [Char]
    err -> [Char] -> ParseState a
    forall a. [Char] -> ParseState a
    PSFail [Char]
    err
                ParseState FieldType
    PSDone -> a -> Text -> ParseState a
    forall a. a -> Text -> ParseState a
    PSSuccess ([FieldType] -> a
    front []) Text
    t

    breakAtNextSpace :: Text -> (Text, Text)
    breakAtNextSpace :: Text -> (Text, Text)
    breakAtNextSpace =
        (Char -> Bool) -> Text -> (Text, Text)
    T.break Char -> Bool
    isSpace

    parseFieldTypePiece :: Char -> Text -> FieldType
    parseFieldTypePiece :: Char -> Text -> FieldType
    parseFieldTypePiece Char
    fstChar Text
    rest =
        case Char
    fstChar of
            Char
    '\'' ->
                Text -> FieldType
    FTTypePromoted Text
    rest
            Char
    _ ->
                let
                    t :: Text
    t = Char -> Text -> Text
    T.cons Char
    fstChar Text
    rest
                 in
                    case HasCallStack => Text -> Text -> (Text, Text)
    Text -> Text -> (Text, Text)
    T.breakOnEnd Text
    "." Text
    t of
                        (Text
    _, Text
    "") -> Maybe Text -> Text -> FieldType
    FTTypeCon Maybe Text
    forall a. Maybe a
    Nothing Text
    t
                        (Text
    "", Text
    _) -> Maybe Text -> Text -> FieldType
    FTTypeCon Maybe Text
    forall a. Maybe a
    Nothing Text
    t
                        (Text
    a, Text
    b) -> Maybe Text -> Text -> FieldType
    FTTypeCon (Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text
    Text -> Text
    T.init Text
    a) Text
    b

    sourceLocFromTHLoc :: Loc -> SourceLoc
    sourceLocFromTHLoc :: Loc -> SourceLoc
    sourceLocFromTHLoc Loc{loc_filename :: Loc -> [Char]
    loc_filename = [Char]
    filename, loc_start :: Loc -> CharPos
    loc_start = CharPos
    start} =
        SourceLoc
            { locFile :: Text
    locFile = [Char] -> Text
    T.pack [Char]
    filename
            , locStartLine :: Int
    locStartLine = CharPos -> Int
    forall a b. (a, b) -> a
    fst CharPos
    start
            , locStartCol :: Int
    locStartCol = CharPos -> Int
    forall a b. (a, b) -> b
    snd CharPos
    start
            }

    -- | Parses a quasi-quoted syntax into a list of entity definitions.
    parse
        :: PersistSettings
        -> [(Maybe SourceLoc, Text)]
        -> CumulativeParseResult [UnboundEntityDef]
    parse :: PersistSettings
    -> [(Maybe SourceLoc, Text)]
    -> CumulativeParseResult [UnboundEntityDef]
    parse PersistSettings
    ps [(Maybe SourceLoc, Text)]
    chunks = [ParseResult [UnboundEntityDef]]
    -> CumulativeParseResult [UnboundEntityDef]
    forall a. Monoid a => [ParseResult a] -> CumulativeParseResult a
    toCumulativeParseResult ([ParseResult [UnboundEntityDef]]
     -> CumulativeParseResult [UnboundEntityDef])
    -> [ParseResult [UnboundEntityDef]]
    -> CumulativeParseResult [UnboundEntityDef]
    forall a b. (a -> b) -> a -> b
    $ ((Maybe SourceLoc, Text) -> ParseResult [UnboundEntityDef])
    -> [(Maybe SourceLoc, Text)] -> [ParseResult [UnboundEntityDef]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe SourceLoc, Text) -> ParseResult [UnboundEntityDef]
    parseChunk [(Maybe SourceLoc, Text)]
    chunks
      where
        parseChunk :: (Maybe SourceLoc, Text) -> ParseResult [UnboundEntityDef]
        parseChunk :: (Maybe SourceLoc, Text) -> ParseResult [UnboundEntityDef]
    parseChunk (Maybe SourceLoc
    mSourceLoc, Text
    source) =
            (([ParsedEntityDef] -> [UnboundEntityDef])
    -> Either (ParseErrorBundle [Char] Void) [ParsedEntityDef]
    -> Either (ParseErrorBundle [Char] Void) [UnboundEntityDef]
    forall a b.
    (a -> b)
    -> Either (ParseErrorBundle [Char] Void) a
    -> Either (ParseErrorBundle [Char] Void) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([ParsedEntityDef] -> [UnboundEntityDef])
     -> Either (ParseErrorBundle [Char] Void) [ParsedEntityDef]
     -> Either (ParseErrorBundle [Char] Void) [UnboundEntityDef])
    -> ((ParsedEntityDef -> UnboundEntityDef)
        -> [ParsedEntityDef] -> [UnboundEntityDef])
    -> (ParsedEntityDef -> UnboundEntityDef)
    -> Either (ParseErrorBundle [Char] Void) [ParsedEntityDef]
    -> Either (ParseErrorBundle [Char] Void) [UnboundEntityDef]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ParsedEntityDef -> UnboundEntityDef)
    -> [ParsedEntityDef] -> [UnboundEntityDef]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap) (PersistSettings -> ParsedEntityDef -> UnboundEntityDef
    mkUnboundEntityDef PersistSettings
    ps) (Either (ParseErrorBundle [Char] Void) [ParsedEntityDef]
     -> Either (ParseErrorBundle [Char] Void) [UnboundEntityDef])
    -> (Set ParserWarning,
        Either (ParseErrorBundle [Char] Void) [ParsedEntityDef])
    -> ParseResult [UnboundEntityDef]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PersistSettings
    -> Maybe SourceLoc
    -> Text
    -> (Set ParserWarning,
        Either (ParseErrorBundle [Char] Void) [ParsedEntityDef])
    parseSource PersistSettings
    ps Maybe SourceLoc
    mSourceLoc Text
    source

    entityNamesFromParsedDef
        :: PersistSettings -> ParsedEntityDef -> (EntityNameHS, EntityNameDB)
    entityNamesFromParsedDef :: PersistSettings -> ParsedEntityDef -> (EntityNameHS, EntityNameDB)
    entityNamesFromParsedDef PersistSettings
    ps ParsedEntityDef
    parsedEntDef = (EntityNameHS
    entNameHS, EntityNameDB
    entNameDB)
      where
        entNameHS :: EntityNameHS
    entNameHS =
            ParsedEntityDef -> EntityNameHS
    parsedEntityDefEntityName ParsedEntityDef
    parsedEntDef

        entNameDB :: EntityNameDB
    entNameDB =
            Text -> EntityNameDB
    EntityNameDB (Text -> EntityNameDB) -> Text -> EntityNameDB
    forall a b. (a -> b) -> a -> b
    $
                PersistSettings -> Text -> [Text] -> Text
    getDbName
                    PersistSettings
    ps
                    (EntityNameHS -> Text
    unEntityNameHS EntityNameHS
    entNameHS)
                    (Attribute -> Text
    attributeContent (Attribute -> Text) -> [Attribute] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsedEntityDef -> [Attribute]
    parsedEntityDefEntityAttributes ParsedEntityDef
    parsedEntDef)

    -- | This type represents an @Id@ declaration in the QuasiQuoted syntax.
    --
    -- > Id
    --
    -- This uses the implied settings, and is equivalent to omitting the @Id@
    -- statement entirely.
    --
    -- > Id Text
    --
    -- This will set the field type of the ID to be 'Text'.
    --
    -- > Id Text sql=foo_id
    --
    -- This will set the field type of the Id to be 'Text' and the SQL DB name to be @foo_id@.
    --
    -- > Id FooId
    --
    -- This results in a shared primary key - the @FooId@ refers to a @Foo@ table.
    --
    -- > Id FooId OnDelete Cascade
    --
    -- You can set a cascade behavior on an ID column.
    --
    -- @since 2.13.0.0
    data UnboundIdDef = UnboundIdDef
        { UnboundIdDef -> EntityNameHS
    unboundIdEntityName :: EntityNameHS
        , UnboundIdDef -> FieldNameDB
    unboundIdDBName :: !FieldNameDB
        , UnboundIdDef -> [FieldAttr]
    unboundIdAttrs :: [FieldAttr]
        , UnboundIdDef -> FieldCascade
    unboundIdCascade :: FieldCascade
        , UnboundIdDef -> Maybe FieldType
    unboundIdType :: Maybe FieldType
        }
        deriving (UnboundIdDef -> UnboundIdDef -> Bool
    (UnboundIdDef -> UnboundIdDef -> Bool)
    -> (UnboundIdDef -> UnboundIdDef -> Bool) -> Eq UnboundIdDef
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnboundIdDef -> UnboundIdDef -> Bool
    == :: UnboundIdDef -> UnboundIdDef -> Bool
    $c/= :: UnboundIdDef -> UnboundIdDef -> Bool
    /= :: UnboundIdDef -> UnboundIdDef -> Bool
    Eq, Eq UnboundIdDef
    Eq UnboundIdDef =>
    (UnboundIdDef -> UnboundIdDef -> Ordering)
    -> (UnboundIdDef -> UnboundIdDef -> Bool)
    -> (UnboundIdDef -> UnboundIdDef -> Bool)
    -> (UnboundIdDef -> UnboundIdDef -> Bool)
    -> (UnboundIdDef -> UnboundIdDef -> Bool)
    -> (UnboundIdDef -> UnboundIdDef -> UnboundIdDef)
    -> (UnboundIdDef -> UnboundIdDef -> UnboundIdDef)
    -> Ord UnboundIdDef
    UnboundIdDef -> UnboundIdDef -> Bool
    UnboundIdDef -> UnboundIdDef -> Ordering
    UnboundIdDef -> UnboundIdDef -> UnboundIdDef
    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 :: UnboundIdDef -> UnboundIdDef -> Ordering
    compare :: UnboundIdDef -> UnboundIdDef -> Ordering
    $c< :: UnboundIdDef -> UnboundIdDef -> Bool
    < :: UnboundIdDef -> UnboundIdDef -> Bool
    $c<= :: UnboundIdDef -> UnboundIdDef -> Bool
    <= :: UnboundIdDef -> UnboundIdDef -> Bool
    $c> :: UnboundIdDef -> UnboundIdDef -> Bool
    > :: UnboundIdDef -> UnboundIdDef -> Bool
    $c>= :: UnboundIdDef -> UnboundIdDef -> Bool
    >= :: UnboundIdDef -> UnboundIdDef -> Bool
    $cmax :: UnboundIdDef -> UnboundIdDef -> UnboundIdDef
    max :: UnboundIdDef -> UnboundIdDef -> UnboundIdDef
    $cmin :: UnboundIdDef -> UnboundIdDef -> UnboundIdDef
    min :: UnboundIdDef -> UnboundIdDef -> UnboundIdDef
    Ord, Int -> UnboundIdDef -> ShowS
    [UnboundIdDef] -> ShowS
    UnboundIdDef -> [Char]
    (Int -> UnboundIdDef -> ShowS)
    -> (UnboundIdDef -> [Char])
    -> ([UnboundIdDef] -> ShowS)
    -> Show UnboundIdDef
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnboundIdDef -> ShowS
    showsPrec :: Int -> UnboundIdDef -> ShowS
    $cshow :: UnboundIdDef -> [Char]
    show :: UnboundIdDef -> [Char]
    $cshowList :: [UnboundIdDef] -> ShowS
    showList :: [UnboundIdDef] -> ShowS
    Show, (forall (m :: * -> *). Quote m => UnboundIdDef -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        UnboundIdDef -> Code m UnboundIdDef)
    -> Lift UnboundIdDef
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => UnboundIdDef -> m Exp
    forall (m :: * -> *).
    Quote m =>
    UnboundIdDef -> Code m UnboundIdDef
    $clift :: forall (m :: * -> *). Quote m => UnboundIdDef -> m Exp
    lift :: forall (m :: * -> *). Quote m => UnboundIdDef -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundIdDef -> Code m UnboundIdDef
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundIdDef -> Code m UnboundIdDef
    Lift)

    -- | An 'EntityDef' produced by the QuasiQuoter. It contains information that
    -- the QuasiQuoter is capable of knowing about the entities. It is inherently
    -- unfinished, though - there are many other @Unbound@ datatypes that also
    -- contain partial information.
    --
    -- The 'unboundEntityDef' is not complete or reliable - to know which fields are
    -- safe to use, consult the parsing code.
    --
    -- This type was completely internal until 2.13.0.0, when it was exposed as part
    -- of the "Database.Persist.Quasi.Internal" module.
    --
    -- TODO: refactor this so we can expose it for consumers.
    --
    -- @since 2.13.0.0
    data UnboundEntityDef
        = UnboundEntityDef
        { UnboundEntityDef -> [UnboundForeignDef]
    unboundForeignDefs :: [UnboundForeignDef]
        -- ^ A list of foreign definitions on the parsed entity.
        --
        -- @since 2.13.0.0
        , UnboundEntityDef -> PrimarySpec
    unboundPrimarySpec :: PrimarySpec
        -- ^ The specification for the primary key of the unbound entity.
        --
        -- @since 2.13.0.0
        , UnboundEntityDef -> EntityDef
    unboundEntityDef :: EntityDef
        -- ^ The incomplete and partial 'EntityDef' that we're defining. We re-use
        -- the type here to prevent duplication, but several of the fields are unset
        -- and left to defaults.
        --
        -- @since 2.13.0.0
        , UnboundEntityDef -> [UnboundFieldDef]
    unboundEntityFields :: [UnboundFieldDef]
        -- ^ The list of fields for the entity. We're not capable of knowing
        -- information like "is this a reference?" or "what's the underlying type of
        -- the field?" yet, so we defer those to the Template Haskell execution.
        --
        -- @since 2.13.0.0
        , UnboundEntityDef -> Maybe SourceSpan
    unboundEntityDefSpan :: Maybe SourceSpan
        -- ^ The source code span of this entity in the models file.
        --
        -- @since 2.15.0.0
        }
        deriving (UnboundEntityDef -> UnboundEntityDef -> Bool
    (UnboundEntityDef -> UnboundEntityDef -> Bool)
    -> (UnboundEntityDef -> UnboundEntityDef -> Bool)
    -> Eq UnboundEntityDef
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnboundEntityDef -> UnboundEntityDef -> Bool
    == :: UnboundEntityDef -> UnboundEntityDef -> Bool
    $c/= :: UnboundEntityDef -> UnboundEntityDef -> Bool
    /= :: UnboundEntityDef -> UnboundEntityDef -> Bool
    Eq, Eq UnboundEntityDef
    Eq UnboundEntityDef =>
    (UnboundEntityDef -> UnboundEntityDef -> Ordering)
    -> (UnboundEntityDef -> UnboundEntityDef -> Bool)
    -> (UnboundEntityDef -> UnboundEntityDef -> Bool)
    -> (UnboundEntityDef -> UnboundEntityDef -> Bool)
    -> (UnboundEntityDef -> UnboundEntityDef -> Bool)
    -> (UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef)
    -> (UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef)
    -> Ord UnboundEntityDef
    UnboundEntityDef -> UnboundEntityDef -> Bool
    UnboundEntityDef -> UnboundEntityDef -> Ordering
    UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef
    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 :: UnboundEntityDef -> UnboundEntityDef -> Ordering
    compare :: UnboundEntityDef -> UnboundEntityDef -> Ordering
    $c< :: UnboundEntityDef -> UnboundEntityDef -> Bool
    < :: UnboundEntityDef -> UnboundEntityDef -> Bool
    $c<= :: UnboundEntityDef -> UnboundEntityDef -> Bool
    <= :: UnboundEntityDef -> UnboundEntityDef -> Bool
    $c> :: UnboundEntityDef -> UnboundEntityDef -> Bool
    > :: UnboundEntityDef -> UnboundEntityDef -> Bool
    $c>= :: UnboundEntityDef -> UnboundEntityDef -> Bool
    >= :: UnboundEntityDef -> UnboundEntityDef -> Bool
    $cmax :: UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef
    max :: UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef
    $cmin :: UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef
    min :: UnboundEntityDef -> UnboundEntityDef -> UnboundEntityDef
    Ord, Int -> UnboundEntityDef -> ShowS
    [UnboundEntityDef] -> ShowS
    UnboundEntityDef -> [Char]
    (Int -> UnboundEntityDef -> ShowS)
    -> (UnboundEntityDef -> [Char])
    -> ([UnboundEntityDef] -> ShowS)
    -> Show UnboundEntityDef
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnboundEntityDef -> ShowS
    showsPrec :: Int -> UnboundEntityDef -> ShowS
    $cshow :: UnboundEntityDef -> [Char]
    show :: UnboundEntityDef -> [Char]
    $cshowList :: [UnboundEntityDef] -> ShowS
    showList :: [UnboundEntityDef] -> ShowS
    Show, (forall (m :: * -> *). Quote m => UnboundEntityDef -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        UnboundEntityDef -> Code m UnboundEntityDef)
    -> Lift UnboundEntityDef
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => UnboundEntityDef -> m Exp
    forall (m :: * -> *).
    Quote m =>
    UnboundEntityDef -> Code m UnboundEntityDef
    $clift :: forall (m :: * -> *). Quote m => UnboundEntityDef -> m Exp
    lift :: forall (m :: * -> *). Quote m => UnboundEntityDef -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundEntityDef -> Code m UnboundEntityDef
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundEntityDef -> Code m UnboundEntityDef
    Lift)

    -- | Convert an 'EntityDef' into an 'UnboundEntityDef'. This "forgets"
    -- information about the 'EntityDef', but it is all kept present on the
    -- 'unboundEntityDef' field if necessary.
    --
    -- @since 2.13.0.0
    unbindEntityDef :: EntityDef -> UnboundEntityDef
    unbindEntityDef :: EntityDef -> UnboundEntityDef
    unbindEntityDef EntityDef
    ed =
        UnboundEntityDef
            { unboundForeignDefs :: [UnboundForeignDef]
    unboundForeignDefs =
                (ForeignDef -> UnboundForeignDef)
    -> [ForeignDef] -> [UnboundForeignDef]
    forall a b. (a -> b) -> [a] -> [b]
    map ForeignDef -> UnboundForeignDef
    unbindForeignDef (EntityDef -> [ForeignDef]
    entityForeigns EntityDef
    ed)
            , unboundPrimarySpec :: PrimarySpec
    unboundPrimarySpec =
                case EntityDef -> EntityIdDef
    entityId EntityDef
    ed of
                    EntityIdField FieldDef
    fd ->
                        UnboundIdDef -> PrimarySpec
    SurrogateKey (EntityNameHS -> FieldDef -> UnboundIdDef
    unbindIdDef (EntityDef -> EntityNameHS
    entityHaskell EntityDef
    ed) FieldDef
    fd)
                    EntityIdNaturalKey CompositeDef
    cd ->
                        UnboundCompositeDef -> PrimarySpec
    NaturalKey (CompositeDef -> UnboundCompositeDef
    unbindCompositeDef CompositeDef
    cd)
            , unboundEntityDef :: EntityDef
    unboundEntityDef =
                EntityDef
    ed
            , unboundEntityFields :: [UnboundFieldDef]
    unboundEntityFields =
                (FieldDef -> UnboundFieldDef) -> [FieldDef] -> [UnboundFieldDef]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldDef -> UnboundFieldDef
    unbindFieldDef (EntityDef -> [FieldDef]
    entityFields EntityDef
    ed)
            , unboundEntityDefSpan :: Maybe SourceSpan
    unboundEntityDefSpan = EntityDef -> Maybe SourceSpan
    entitySpan EntityDef
    ed
            }

    -- | Returns the @['UnboundFieldDef']@ for an 'UnboundEntityDef'. This returns
    -- all fields defined on the entity.
    --
    -- @since 2.13.0.0
    getUnboundFieldDefs :: UnboundEntityDef -> [UnboundFieldDef]
    getUnboundFieldDefs :: UnboundEntityDef -> [UnboundFieldDef]
    getUnboundFieldDefs = UnboundEntityDef -> [UnboundFieldDef]
    unboundEntityFields

    -- | This function forgets information about the 'CompositeDef' so that it can
    -- be remembered through Template Haskell.
    --
    -- @since 2.13.0.0
    unbindCompositeDef :: CompositeDef -> UnboundCompositeDef
    unbindCompositeDef :: CompositeDef -> UnboundCompositeDef
    unbindCompositeDef CompositeDef
    cd =
        UnboundCompositeDef
            { unboundCompositeCols :: NonEmpty FieldNameHS
    unboundCompositeCols =
                (FieldDef -> FieldNameHS)
    -> NonEmpty FieldDef -> NonEmpty FieldNameHS
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap FieldDef -> FieldNameHS
    fieldHaskell (CompositeDef -> NonEmpty FieldDef
    compositeFields CompositeDef
    cd)
            , unboundCompositeAttrs :: [Text]
    unboundCompositeAttrs =
                CompositeDef -> [Text]
    compositeAttrs CompositeDef
    cd
            }

    -- | A representation of a database column, with everything that can be known at
    -- parse time.
    --
    -- @since 2.13.0.0
    data UnboundFieldDef
        = UnboundFieldDef
        { UnboundFieldDef -> FieldNameHS
    unboundFieldNameHS :: FieldNameHS
        -- ^  The Haskell name of the field. This is parsed directly from the
        -- definition, and is used to generate the Haskell record field and the
        -- 'EntityField' definition.
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> FieldNameDB
    unboundFieldNameDB :: FieldNameDB
        -- ^ The database name of the field. By default, this is determined by the
        -- 'PersistSettings' record at parse time. You can customize this with
        -- a @sql=@ attribute:
        --
        -- @
        --     name Text  sql=foo_name
        -- @
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> [FieldAttr]
    unboundFieldAttrs :: [FieldAttr]
        -- ^ The attributes present on the field. For rules on parsing and utility,
        -- see the comments on the datatype.
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> Bool
    unboundFieldStrict :: Bool
        -- ^ Whether or not the field should be strict in the generated Haskell
        -- code.
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> FieldType
    unboundFieldType :: FieldType
        -- ^ The type of the field, as far as is known at parse time.
        --
        -- The TemplateHaskell code will reconstruct a 'Type' out of this, but the
        -- names will be imported as-is.
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> FieldCascade
    unboundFieldCascade :: FieldCascade
        -- ^ We parse if there's a 'FieldCascade' on the field. If the field is not
        -- a reference, this information is ignored.
        --
        -- @
        -- Post
        --    user UserId OnDeleteCascade
        -- @
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> Maybe Text
    unboundFieldGenerated :: Maybe Text
        -- ^ Contains an expression to generate the column. If this is present, then
        -- the column will not be written to the database, but generated by the
        -- expression every time.
        --
        -- @
        -- Item
        --     subtotal Int
        --     taxRate  Rational
        --     total    Int      generated="subtotal * tax_rate"
        -- @
        --
        -- @since 2.13.0.0
        , UnboundFieldDef -> Maybe Text
    unboundFieldComments :: Maybe Text
        -- ^ Any comments present on the field. Documentation comments use
        -- a Haskell-like syntax, and must be present before the field in question.
        --
        -- @
        -- Post
        --     -- | This is the blog post title.
        --     title Text
        --     -- | You can have multi-line comments.
        --     -- | But each line must have the pipe character.
        --     author UserId
        -- @
        --
        -- @since 2.13.0.0
        }
        deriving (UnboundFieldDef -> UnboundFieldDef -> Bool
    (UnboundFieldDef -> UnboundFieldDef -> Bool)
    -> (UnboundFieldDef -> UnboundFieldDef -> Bool)
    -> Eq UnboundFieldDef
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnboundFieldDef -> UnboundFieldDef -> Bool
    == :: UnboundFieldDef -> UnboundFieldDef -> Bool
    $c/= :: UnboundFieldDef -> UnboundFieldDef -> Bool
    /= :: UnboundFieldDef -> UnboundFieldDef -> Bool
    Eq, Eq UnboundFieldDef
    Eq UnboundFieldDef =>
    (UnboundFieldDef -> UnboundFieldDef -> Ordering)
    -> (UnboundFieldDef -> UnboundFieldDef -> Bool)
    -> (UnboundFieldDef -> UnboundFieldDef -> Bool)
    -> (UnboundFieldDef -> UnboundFieldDef -> Bool)
    -> (UnboundFieldDef -> UnboundFieldDef -> Bool)
    -> (UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef)
    -> (UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef)
    -> Ord UnboundFieldDef
    UnboundFieldDef -> UnboundFieldDef -> Bool
    UnboundFieldDef -> UnboundFieldDef -> Ordering
    UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef
    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 :: UnboundFieldDef -> UnboundFieldDef -> Ordering
    compare :: UnboundFieldDef -> UnboundFieldDef -> Ordering
    $c< :: UnboundFieldDef -> UnboundFieldDef -> Bool
    < :: UnboundFieldDef -> UnboundFieldDef -> Bool
    $c<= :: UnboundFieldDef -> UnboundFieldDef -> Bool
    <= :: UnboundFieldDef -> UnboundFieldDef -> Bool
    $c> :: UnboundFieldDef -> UnboundFieldDef -> Bool
    > :: UnboundFieldDef -> UnboundFieldDef -> Bool
    $c>= :: UnboundFieldDef -> UnboundFieldDef -> Bool
    >= :: UnboundFieldDef -> UnboundFieldDef -> Bool
    $cmax :: UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef
    max :: UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef
    $cmin :: UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef
    min :: UnboundFieldDef -> UnboundFieldDef -> UnboundFieldDef
    Ord, Int -> UnboundFieldDef -> ShowS
    [UnboundFieldDef] -> ShowS
    UnboundFieldDef -> [Char]
    (Int -> UnboundFieldDef -> ShowS)
    -> (UnboundFieldDef -> [Char])
    -> ([UnboundFieldDef] -> ShowS)
    -> Show UnboundFieldDef
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnboundFieldDef -> ShowS
    showsPrec :: Int -> UnboundFieldDef -> ShowS
    $cshow :: UnboundFieldDef -> [Char]
    show :: UnboundFieldDef -> [Char]
    $cshowList :: [UnboundFieldDef] -> ShowS
    showList :: [UnboundFieldDef] -> ShowS
    Show, (forall (m :: * -> *). Quote m => UnboundFieldDef -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        UnboundFieldDef -> Code m UnboundFieldDef)
    -> Lift UnboundFieldDef
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => UnboundFieldDef -> m Exp
    forall (m :: * -> *).
    Quote m =>
    UnboundFieldDef -> Code m UnboundFieldDef
    $clift :: forall (m :: * -> *). Quote m => UnboundFieldDef -> m Exp
    lift :: forall (m :: * -> *). Quote m => UnboundFieldDef -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundFieldDef -> Code m UnboundFieldDef
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundFieldDef -> Code m UnboundFieldDef
    Lift)

    -- | Forget innformation about a 'FieldDef' so it can beused as an
    -- 'UnboundFieldDef'.
    --
    -- @since 2.13.0.0
    unbindFieldDef :: FieldDef -> UnboundFieldDef
    unbindFieldDef :: FieldDef -> UnboundFieldDef
    unbindFieldDef FieldDef
    fd =
        UnboundFieldDef
            { unboundFieldNameHS :: FieldNameHS
    unboundFieldNameHS =
                FieldDef -> FieldNameHS
    fieldHaskell FieldDef
    fd
            , unboundFieldNameDB :: FieldNameDB
    unboundFieldNameDB =
                FieldDef -> FieldNameDB
    fieldDB FieldDef
    fd
            , unboundFieldAttrs :: [FieldAttr]
    unboundFieldAttrs =
                FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd
            , unboundFieldType :: FieldType
    unboundFieldType =
                FieldDef -> FieldType
    fieldType FieldDef
    fd
            , unboundFieldStrict :: Bool
    unboundFieldStrict =
                FieldDef -> Bool
    fieldStrict FieldDef
    fd
            , unboundFieldCascade :: FieldCascade
    unboundFieldCascade =
                FieldDef -> FieldCascade
    fieldCascade FieldDef
    fd
            , unboundFieldComments :: Maybe Text
    unboundFieldComments =
                FieldDef -> Maybe Text
    fieldComments FieldDef
    fd
            , unboundFieldGenerated :: Maybe Text
    unboundFieldGenerated =
                FieldDef -> Maybe Text
    fieldGenerated FieldDef
    fd
            }

    isUnboundFieldNullable :: UnboundFieldDef -> IsNullable
    isUnboundFieldNullable :: UnboundFieldDef -> IsNullable
    isUnboundFieldNullable =
        [FieldAttr] -> IsNullable
    fieldAttrsContainsNullable ([FieldAttr] -> IsNullable)
    -> (UnboundFieldDef -> [FieldAttr])
    -> UnboundFieldDef
    -> IsNullable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnboundFieldDef -> [FieldAttr]
    unboundFieldAttrs

    -- | The specification for how an entity's primary key should be formed.
    --
    -- Persistent requires that every table have a primary key. By default, an
    -- implied ID is assigned, based on the 'mpsImplicitIdDef' field on
    -- 'MkPersistSettings'. Because we can't access that type at parse-time, we
    -- defer that decision until later.
    --
    -- @since 2.13.0.0
    data PrimarySpec
        = -- | A 'NaturalKey' contains columns that are defined on the datatype
          -- itself. This is defined using the @Primary@ keyword and given a non-empty
          -- list of columns.
          --
          -- @
          -- User
          --     name    Text
          --     email   Text
          --
          --     Primary name email
          -- @
          --
          -- A natural key may also contain only a single column. A natural key with
          -- multiple columns is called a 'composite key'.
          --
          -- @since 2.13.0.0
          NaturalKey UnboundCompositeDef
        | -- | A surrogate key is not part of the domain model for a database table.
          -- You can specify a custom surro
          --
          -- You can specify a custom surrogate key using the @Id@ syntax.
          --
          -- @
          -- User
          --     Id    Text
          --     name  Text
          -- @
          --
          -- Note that you must provide a @default=@ expression when using this in
          -- order to use 'insert' or related functions. The 'insertKey' function can
          -- be used instead, as it allows you to specify a key directly. Fixing this
          -- issue is tracked in #1247 on GitHub.
          --
          -- @since 2.13.0.0
          SurrogateKey UnboundIdDef
        | -- | The default key for the entity using the settings in
          -- 'MkPersistSettings'.
          --
          -- This is implicit - a table without an @Id@ or @Primary@ declaration will
          -- have a 'DefaultKey'.
          --
          -- @since 2.13.0.0
          DefaultKey FieldNameDB
        deriving (PrimarySpec -> PrimarySpec -> Bool
    (PrimarySpec -> PrimarySpec -> Bool)
    -> (PrimarySpec -> PrimarySpec -> Bool) -> Eq PrimarySpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PrimarySpec -> PrimarySpec -> Bool
    == :: PrimarySpec -> PrimarySpec -> Bool
    $c/= :: PrimarySpec -> PrimarySpec -> Bool
    /= :: PrimarySpec -> PrimarySpec -> Bool
    Eq, Eq PrimarySpec
    Eq PrimarySpec =>
    (PrimarySpec -> PrimarySpec -> Ordering)
    -> (PrimarySpec -> PrimarySpec -> Bool)
    -> (PrimarySpec -> PrimarySpec -> Bool)
    -> (PrimarySpec -> PrimarySpec -> Bool)
    -> (PrimarySpec -> PrimarySpec -> Bool)
    -> (PrimarySpec -> PrimarySpec -> PrimarySpec)
    -> (PrimarySpec -> PrimarySpec -> PrimarySpec)
    -> Ord PrimarySpec
    PrimarySpec -> PrimarySpec -> Bool
    PrimarySpec -> PrimarySpec -> Ordering
    PrimarySpec -> PrimarySpec -> PrimarySpec
    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 :: PrimarySpec -> PrimarySpec -> Ordering
    compare :: PrimarySpec -> PrimarySpec -> Ordering
    $c< :: PrimarySpec -> PrimarySpec -> Bool
    < :: PrimarySpec -> PrimarySpec -> Bool
    $c<= :: PrimarySpec -> PrimarySpec -> Bool
    <= :: PrimarySpec -> PrimarySpec -> Bool
    $c> :: PrimarySpec -> PrimarySpec -> Bool
    > :: PrimarySpec -> PrimarySpec -> Bool
    $c>= :: PrimarySpec -> PrimarySpec -> Bool
    >= :: PrimarySpec -> PrimarySpec -> Bool
    $cmax :: PrimarySpec -> PrimarySpec -> PrimarySpec
    max :: PrimarySpec -> PrimarySpec -> PrimarySpec
    $cmin :: PrimarySpec -> PrimarySpec -> PrimarySpec
    min :: PrimarySpec -> PrimarySpec -> PrimarySpec
    Ord, Int -> PrimarySpec -> ShowS
    [PrimarySpec] -> ShowS
    PrimarySpec -> [Char]
    (Int -> PrimarySpec -> ShowS)
    -> (PrimarySpec -> [Char])
    -> ([PrimarySpec] -> ShowS)
    -> Show PrimarySpec
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PrimarySpec -> ShowS
    showsPrec :: Int -> PrimarySpec -> ShowS
    $cshow :: PrimarySpec -> [Char]
    show :: PrimarySpec -> [Char]
    $cshowList :: [PrimarySpec] -> ShowS
    showList :: [PrimarySpec] -> ShowS
    Show, (forall (m :: * -> *). Quote m => PrimarySpec -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        PrimarySpec -> Code m PrimarySpec)
    -> Lift PrimarySpec
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => PrimarySpec -> m Exp
    forall (m :: * -> *). Quote m => PrimarySpec -> Code m PrimarySpec
    $clift :: forall (m :: * -> *). Quote m => PrimarySpec -> m Exp
    lift :: forall (m :: * -> *). Quote m => PrimarySpec -> m Exp
    $cliftTyped :: forall (m :: * -> *). Quote m => PrimarySpec -> Code m PrimarySpec
    liftTyped :: forall (m :: * -> *). Quote m => PrimarySpec -> Code m PrimarySpec
    Lift)

    -- | Construct an entity definition.
    mkUnboundEntityDef
        :: PersistSettings
        -> ParsedEntityDef
        -- ^ parsed entity definition
        -> UnboundEntityDef
    mkUnboundEntityDef :: PersistSettings -> ParsedEntityDef -> UnboundEntityDef
    mkUnboundEntityDef PersistSettings
    ps ParsedEntityDef
    parsedEntDef =
        UnboundEntityDef
            { unboundForeignDefs :: [UnboundForeignDef]
    unboundForeignDefs =
                EntityConstraintDefs -> [UnboundForeignDef]
    entityConstraintDefsForeignsList EntityConstraintDefs
    entityConstraintDefs
            , unboundPrimarySpec :: PrimarySpec
    unboundPrimarySpec =
                case (Maybe UnboundIdDef
    idField, Maybe UnboundCompositeDef
    primaryComposite) of
                    (Just{}, Just{}) ->
                        [Char] -> PrimarySpec
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Specified both an ID field and a Primary field"
                    (Just UnboundIdDef
    a, Maybe UnboundCompositeDef
    Nothing) ->
                        if UnboundIdDef -> Maybe FieldType
    unboundIdType UnboundIdDef
    a Maybe FieldType -> Maybe FieldType -> Bool
    forall a. Eq a => a -> a -> Bool
    == FieldType -> Maybe FieldType
    forall a. a -> Maybe a
    Just (EntityNameHS -> FieldType
    mkKeyConType (UnboundIdDef -> EntityNameHS
    unboundIdEntityName UnboundIdDef
    a))
                            then
                                FieldNameDB -> PrimarySpec
    DefaultKey (Text -> FieldNameDB
    FieldNameDB (Text -> FieldNameDB) -> Text -> FieldNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text
    psIdName PersistSettings
    ps)
                            else
                                UnboundIdDef -> PrimarySpec
    SurrogateKey UnboundIdDef
    a
                    (Maybe UnboundIdDef
    Nothing, Just UnboundCompositeDef
    a) ->
                        UnboundCompositeDef -> PrimarySpec
    NaturalKey UnboundCompositeDef
    a
                    (Maybe UnboundIdDef
    Nothing, Maybe UnboundCompositeDef
    Nothing) ->
                        FieldNameDB -> PrimarySpec
    DefaultKey (Text -> FieldNameDB
    FieldNameDB (Text -> FieldNameDB) -> Text -> FieldNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text
    psIdName PersistSettings
    ps)
            , unboundEntityFields :: [UnboundFieldDef]
    unboundEntityFields =
                [UnboundFieldDef]
    cols
            , unboundEntityDefSpan :: Maybe SourceSpan
    unboundEntityDefSpan = ParsedEntityDef -> Maybe SourceSpan
    parsedEntityDefSpan ParsedEntityDef
    parsedEntDef
            , unboundEntityDef :: EntityDef
    unboundEntityDef =
                EntityDef
                    { entityHaskell :: EntityNameHS
    entityHaskell = EntityNameHS
    entNameHS
                    , entityDB :: EntityNameDB
    entityDB = EntityNameDB
    entNameDB
                    , -- idField is the user-specified Id
                      -- otherwise useAutoIdField
                      -- but, adjust it if the user specified a Primary
                      entityId :: EntityIdDef
    entityId =
                        FieldDef -> EntityIdDef
    EntityIdField (FieldDef -> EntityIdDef) -> FieldDef -> EntityIdDef
    forall a b. (a -> b) -> a -> b
    $
                            FieldDef
    -> (UnboundIdDef -> FieldDef) -> Maybe UnboundIdDef -> FieldDef
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FieldDef
    autoIdField (FieldNameDB -> EntityNameHS -> UnboundIdDef -> FieldDef
    unboundIdDefToFieldDef (PersistSettings -> FieldNameDB
    defaultIdName PersistSettings
    ps) EntityNameHS
    entNameHS) Maybe UnboundIdDef
    idField
                    , entityAttrs :: [Text]
    entityAttrs =
                        Attribute -> Text
    attributeContent (Attribute -> Text) -> [Attribute] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsedEntityDef -> [Attribute]
    parsedEntityDefEntityAttributes ParsedEntityDef
    parsedEntDef
                    , entityFields :: [FieldDef]
    entityFields = []
                    , entityUniques :: [UniqueDef]
    entityUniques = EntityConstraintDefs -> [UniqueDef]
    entityConstraintDefsUniquesList EntityConstraintDefs
    entityConstraintDefs
                    , entityForeigns :: [ForeignDef]
    entityForeigns = []
                    , entityDerives :: [Text]
    entityDerives = [[Text]] -> [Text]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ ([Text] -> Maybe [Text]) -> [[Text]] -> [[Text]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [Text] -> Maybe [Text]
    takeDerives ([[Text]]
    textFields [[Text]] -> [[Text]] -> [[Text]]
    forall a. [a] -> [a] -> [a]
    ++ [[Text]]
    textDirectives)
                    , entityExtra :: Map Text [[Text]]
    entityExtra = ParsedEntityDef -> Map Text [[Text]]
    parsedEntityDefExtras ParsedEntityDef
    parsedEntDef
                    , entitySum :: Bool
    entitySum = ParsedEntityDef -> Bool
    parsedEntityDefIsSum ParsedEntityDef
    parsedEntDef
                    , entityComments :: Maybe Text
    entityComments =
                        case ParsedEntityDef -> [Text]
    parsedEntityDefComments ParsedEntityDef
    parsedEntDef of
                            [] -> Maybe Text
    forall a. Maybe a
    Nothing
                            [Text]
    comments -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just ([Text] -> Text
    T.unlines [Text]
    comments)
                    , entitySpan :: Maybe SourceSpan
    entitySpan = ParsedEntityDef -> Maybe SourceSpan
    parsedEntityDefSpan ParsedEntityDef
    parsedEntDef
                    }
            }
      where
        (EntityNameHS
    entNameHS, EntityNameDB
    entNameDB) =
            PersistSettings -> ParsedEntityDef -> (EntityNameHS, EntityNameDB)
    entityNamesFromParsedDef PersistSettings
    ps ParsedEntityDef
    parsedEntDef

        fields :: [(EntityField, Maybe Text)]
    fields = ParsedEntityDef -> [(EntityField, Maybe Text)]
    parsedEntityDefFields ParsedEntityDef
    parsedEntDef
        directives :: [(Directive, Maybe Text)]
    directives = ParsedEntityDef -> [(Directive, Maybe Text)]
    parsedEntityDefDirectives ParsedEntityDef
    parsedEntDef

        cols :: [UnboundFieldDef]
        cols :: [UnboundFieldDef]
    cols = ((EntityField, Maybe Text) -> [UnboundFieldDef])
    -> [(EntityField, Maybe Text)] -> [UnboundFieldDef]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap (Maybe UnboundFieldDef -> [UnboundFieldDef]
    forall a. Maybe a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList (Maybe UnboundFieldDef -> [UnboundFieldDef])
    -> ((EntityField, Maybe Text) -> Maybe UnboundFieldDef)
    -> (EntityField, Maybe Text)
    -> [UnboundFieldDef]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PersistSettings
    -> (EntityField, Maybe Text) -> Maybe UnboundFieldDef
    commentedField PersistSettings
    ps) [(EntityField, Maybe Text)]
    fields

        textFields :: [[Text]]
        textFields :: [[Text]]
    textFields = EntityField -> [Text]
    entityFieldContent (EntityField -> [Text])
    -> ((EntityField, Maybe Text) -> EntityField)
    -> (EntityField, Maybe Text)
    -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EntityField, Maybe Text) -> EntityField
    forall a b. (a, b) -> a
    fst ((EntityField, Maybe Text) -> [Text])
    -> [(EntityField, Maybe Text)] -> [[Text]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(EntityField, Maybe Text)]
    fields

        textDirectives :: [[Text]]
        textDirectives :: [[Text]]
    textDirectives = Directive -> [Text]
    directiveContent (Directive -> [Text])
    -> ((Directive, Maybe Text) -> Directive)
    -> (Directive, Maybe Text)
    -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Directive, Maybe Text) -> Directive
    forall a b. (a, b) -> a
    fst ((Directive, Maybe Text) -> [Text])
    -> [(Directive, Maybe Text)] -> [[Text]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Directive, Maybe Text)]
    directives

        entityConstraintDefs :: EntityConstraintDefs
    entityConstraintDefs =
            ([Text] -> EntityConstraintDefs)
    -> [[Text]] -> EntityConstraintDefs
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap
                (EntityConstraintDefs
    -> (NonEmpty Text -> EntityConstraintDefs)
    -> Maybe (NonEmpty Text)
    -> EntityConstraintDefs
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe EntityConstraintDefs
    forall a. Monoid a => a
    mempty (PersistSettings
    -> EntityNameHS
    -> [UnboundFieldDef]
    -> NonEmpty Text
    -> EntityConstraintDefs
    takeConstraint PersistSettings
    ps EntityNameHS
    entNameHS [UnboundFieldDef]
    cols) (Maybe (NonEmpty Text) -> EntityConstraintDefs)
    -> ([Text] -> Maybe (NonEmpty Text))
    -> [Text]
    -> EntityConstraintDefs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Maybe (NonEmpty Text)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty)
                ([[Text]]
    textFields [[Text]] -> [[Text]] -> [[Text]]
    forall a. [a] -> [a] -> [a]
    ++ [[Text]]
    textDirectives)

        idField :: Maybe UnboundIdDef
    idField =
            case EntityConstraintDefs -> SetOnceAtMost UnboundIdDef
    entityConstraintDefsIdField EntityConstraintDefs
    entityConstraintDefs of
                SetOnceAtMost UnboundIdDef
    SetMoreThanOnce -> [Char] -> Maybe UnboundIdDef
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "expected only one Id declaration per entity"
                SetOnce UnboundIdDef
    a -> UnboundIdDef -> Maybe UnboundIdDef
    forall a. a -> Maybe a
    Just UnboundIdDef
    a
                SetOnceAtMost UnboundIdDef
    NotSet -> Maybe UnboundIdDef
    forall a. Maybe a
    Nothing

        primaryComposite :: Maybe UnboundCompositeDef
    primaryComposite =
            case EntityConstraintDefs -> SetOnceAtMost UnboundCompositeDef
    entityConstraintDefsPrimaryComposite EntityConstraintDefs
    entityConstraintDefs of
                SetOnceAtMost UnboundCompositeDef
    SetMoreThanOnce -> [Char] -> Maybe UnboundCompositeDef
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "expected only one Primary declaration per entity"
                SetOnce UnboundCompositeDef
    a -> UnboundCompositeDef -> Maybe UnboundCompositeDef
    forall a. a -> Maybe a
    Just UnboundCompositeDef
    a
                SetOnceAtMost UnboundCompositeDef
    NotSet -> Maybe UnboundCompositeDef
    forall a. Maybe a
    Nothing

        commentedField
            :: PersistSettings
            -> (EntityField, Maybe Text)
            -> Maybe UnboundFieldDef
        commentedField :: PersistSettings
    -> (EntityField, Maybe Text) -> Maybe UnboundFieldDef
    commentedField PersistSettings
    s (EntityField
    field, Maybe Text
    mCommentText) = do
            unb <- PersistSettings -> [Text] -> Maybe UnboundFieldDef
    takeColsEx PersistSettings
    s (EntityField -> [Text]
    entityFieldContent EntityField
    field)
            pure $ unb{unboundFieldComments = mCommentText}

        autoIdField :: FieldDef
        autoIdField :: FieldDef
    autoIdField =
            PersistSettings -> EntityNameHS -> SqlType -> FieldDef
    mkAutoIdField PersistSettings
    ps EntityNameHS
    entNameHS SqlType
    idSqlType

        idSqlType :: SqlType
        idSqlType :: SqlType
    idSqlType =
            SqlType
    -> (UnboundCompositeDef -> SqlType)
    -> Maybe UnboundCompositeDef
    -> SqlType
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe SqlType
    SqlInt64 (SqlType -> UnboundCompositeDef -> SqlType
    forall a b. a -> b -> a
    const (SqlType -> UnboundCompositeDef -> SqlType)
    -> SqlType -> UnboundCompositeDef -> SqlType
    forall a b. (a -> b) -> a -> b
    $ Text -> SqlType
    SqlOther Text
    "Primary Key") Maybe UnboundCompositeDef
    primaryComposite

    defaultIdName :: PersistSettings -> FieldNameDB
    defaultIdName :: PersistSettings -> FieldNameDB
    defaultIdName = Text -> FieldNameDB
    FieldNameDB (Text -> FieldNameDB)
    -> (PersistSettings -> Text) -> PersistSettings -> FieldNameDB
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PersistSettings -> Text
    psIdName

    -- | Convert an 'UnboundIdDef' into a 'FieldDef' suitable for use in the
    -- 'EntityIdField' constructor.
    --
    -- @since 2.13.0.0
    unboundIdDefToFieldDef
        :: FieldNameDB
        -> EntityNameHS
        -> UnboundIdDef
        -> FieldDef
    unboundIdDefToFieldDef :: FieldNameDB -> EntityNameHS -> UnboundIdDef -> FieldDef
    unboundIdDefToFieldDef FieldNameDB
    dbField EntityNameHS
    entNameHS UnboundIdDef
    uid =
        FieldDef
            { fieldHaskell :: FieldNameHS
    fieldHaskell =
                Text -> FieldNameHS
    FieldNameHS Text
    "Id"
            , fieldDB :: FieldNameDB
    fieldDB =
                FieldNameDB -> [FieldAttr] -> FieldNameDB
    getSqlNameOr FieldNameDB
    dbField (UnboundIdDef -> [FieldAttr]
    unboundIdAttrs UnboundIdDef
    uid)
            , fieldType :: FieldType
    fieldType =
                FieldType -> Maybe FieldType -> FieldType
    forall a. a -> Maybe a -> a
    fromMaybe (EntityNameHS -> FieldType
    mkKeyConType EntityNameHS
    entNameHS) (Maybe FieldType -> FieldType) -> Maybe FieldType -> FieldType
    forall a b. (a -> b) -> a -> b
    $ UnboundIdDef -> Maybe FieldType
    unboundIdType UnboundIdDef
    uid
            , fieldSqlType :: SqlType
    fieldSqlType =
                Text -> SqlType
    SqlOther Text
    "SqlType unset for Id"
            , fieldStrict :: Bool
    fieldStrict =
                Bool
    False
            , fieldReference :: ReferenceDef
    fieldReference =
                EntityNameHS -> ReferenceDef
    ForeignRef EntityNameHS
    entNameHS
            , fieldAttrs :: [FieldAttr]
    fieldAttrs =
                UnboundIdDef -> [FieldAttr]
    unboundIdAttrs UnboundIdDef
    uid
            , fieldComments :: Maybe Text
    fieldComments =
                Maybe Text
    forall a. Maybe a
    Nothing
            , fieldCascade :: FieldCascade
    fieldCascade = UnboundIdDef -> FieldCascade
    unboundIdCascade UnboundIdDef
    uid
            , fieldGenerated :: Maybe Text
    fieldGenerated = Maybe Text
    forall a. Maybe a
    Nothing
            , fieldIsImplicitIdColumn :: Bool
    fieldIsImplicitIdColumn = Bool
    True
            }

    -- | Convert an 'EntityNameHS' into 'FieldType' that will get parsed into the ID
    -- type for the entity.
    --
    -- @
    -- >>> mkKeyConType (EntityNameHS "Hello)
    -- FTTypeCon Nothing "HelloId"
    -- @
    --
    -- @since 2.13.0.0
    mkKeyConType :: EntityNameHS -> FieldType
    mkKeyConType :: EntityNameHS -> FieldType
    mkKeyConType EntityNameHS
    entNameHs =
        Maybe Text -> Text -> FieldType
    FTTypeCon Maybe Text
    forall a. Maybe a
    Nothing (EntityNameHS -> Text
    keyConName EntityNameHS
    entNameHs)

    -- | Assuming that the provided 'FieldDef' is an ID field, this converts it into
    -- an 'UnboundIdDef'.
    --
    -- @since 2.13.0.0
    unbindIdDef :: EntityNameHS -> FieldDef -> UnboundIdDef
    unbindIdDef :: EntityNameHS -> FieldDef -> UnboundIdDef
    unbindIdDef EntityNameHS
    entityName FieldDef
    fd =
        UnboundIdDef
            { unboundIdEntityName :: EntityNameHS
    unboundIdEntityName =
                EntityNameHS
    entityName
            , unboundIdDBName :: FieldNameDB
    unboundIdDBName =
                FieldDef -> FieldNameDB
    fieldDB FieldDef
    fd
            , unboundIdAttrs :: [FieldAttr]
    unboundIdAttrs =
                FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd
            , unboundIdCascade :: FieldCascade
    unboundIdCascade =
                FieldDef -> FieldCascade
    fieldCascade FieldDef
    fd
            , unboundIdType :: Maybe FieldType
    unboundIdType =
                FieldType -> Maybe FieldType
    forall a. a -> Maybe a
    Just (FieldType -> Maybe FieldType) -> FieldType -> Maybe FieldType
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> FieldType
    fieldType FieldDef
    fd
            }

    mkAutoIdField :: PersistSettings -> EntityNameHS -> SqlType -> FieldDef
    mkAutoIdField :: PersistSettings -> EntityNameHS -> SqlType -> FieldDef
    mkAutoIdField PersistSettings
    ps =
        FieldNameDB -> EntityNameHS -> SqlType -> FieldDef
    mkAutoIdField' (Text -> FieldNameDB
    FieldNameDB (Text -> FieldNameDB) -> Text -> FieldNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text
    psIdName PersistSettings
    ps)

    mkAutoIdField' :: FieldNameDB -> EntityNameHS -> SqlType -> FieldDef
    mkAutoIdField' :: FieldNameDB -> EntityNameHS -> SqlType -> FieldDef
    mkAutoIdField' FieldNameDB
    dbName EntityNameHS
    entName SqlType
    idSqlType =
        FieldDef
            { fieldHaskell :: FieldNameHS
    fieldHaskell = Text -> FieldNameHS
    FieldNameHS Text
    "Id"
            , fieldDB :: FieldNameDB
    fieldDB = FieldNameDB
    dbName
            , fieldType :: FieldType
    fieldType = Maybe Text -> Text -> FieldType
    FTTypeCon Maybe Text
    forall a. Maybe a
    Nothing (Text -> FieldType) -> Text -> FieldType
    forall a b. (a -> b) -> a -> b
    $ EntityNameHS -> Text
    keyConName EntityNameHS
    entName
            , fieldSqlType :: SqlType
    fieldSqlType = SqlType
    idSqlType
            , fieldReference :: ReferenceDef
    fieldReference = ReferenceDef
    NoReference
            , fieldAttrs :: [FieldAttr]
    fieldAttrs = []
            , fieldStrict :: Bool
    fieldStrict = Bool
    True
            , fieldComments :: Maybe Text
    fieldComments = Maybe Text
    forall a. Maybe a
    Nothing
            , fieldCascade :: FieldCascade
    fieldCascade = FieldCascade
    noCascade
            , fieldGenerated :: Maybe Text
    fieldGenerated = Maybe Text
    forall a. Maybe a
    Nothing
            , fieldIsImplicitIdColumn :: Bool
    fieldIsImplicitIdColumn = Bool
    True
            }

    keyConName :: EntityNameHS -> Text
    keyConName :: EntityNameHS -> Text
    keyConName EntityNameHS
    entName = EntityNameHS -> Text
    unEntityNameHS EntityNameHS
    entName Text -> Text -> Text
    forall a. Monoid a => a -> a -> a
    `mappend` Text
    "Id"

    isCapitalizedText :: Text -> Bool
    isCapitalizedText :: Text -> Bool
    isCapitalizedText Text
    t =
        Bool -> Bool
    not (Text -> Bool
    T.null Text
    t) Bool -> Bool -> Bool
    && Char -> Bool
    isUpper (HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    t)

    takeColsEx :: PersistSettings -> [Text] -> Maybe UnboundFieldDef
    takeColsEx :: PersistSettings -> [Text] -> Maybe UnboundFieldDef
    takeColsEx =
        (Text -> [Char] -> Maybe UnboundFieldDef)
    -> PersistSettings -> [Text] -> Maybe UnboundFieldDef
    takeCols
            (\Text
    ft [Char]
    perr -> [Char] -> Maybe UnboundFieldDef
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe UnboundFieldDef)
    -> [Char] -> Maybe UnboundFieldDef
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Invalid field type " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    ft [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    perr)

    takeCols
        :: (Text -> String -> Maybe UnboundFieldDef)
        -> PersistSettings
        -> [Text]
        -> Maybe UnboundFieldDef
    takeCols :: (Text -> [Char] -> Maybe UnboundFieldDef)
    -> PersistSettings -> [Text] -> Maybe UnboundFieldDef
    takeCols Text -> [Char] -> Maybe UnboundFieldDef
    _ PersistSettings
    _ (Text
    "deriving" : [Text]
    _) = Maybe UnboundFieldDef
    forall a. Maybe a
    Nothing
    takeCols Text -> [Char] -> Maybe UnboundFieldDef
    onErr PersistSettings
    ps (Text
    n' : Text
    typ : [Text]
    rest')
        | Bool -> Bool
    not (Text -> Bool
    T.null Text
    n) Bool -> Bool -> Bool
    && Char -> Bool
    isLower (HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    n) =
            case Text -> Either [Char] FieldType
    parseFieldType Text
    typ of
                Left [Char]
    err -> Text -> [Char] -> Maybe UnboundFieldDef
    onErr Text
    typ [Char]
    err
                Right FieldType
    ft ->
                    UnboundFieldDef -> Maybe UnboundFieldDef
    forall a. a -> Maybe a
    Just
                        UnboundFieldDef
                            { unboundFieldNameHS :: FieldNameHS
    unboundFieldNameHS =
                                Text -> FieldNameHS
    FieldNameHS Text
    n
                            , unboundFieldNameDB :: FieldNameDB
    unboundFieldNameDB =
                                PersistSettings -> Text -> [FieldAttr] -> FieldNameDB
    getDbName' PersistSettings
    ps Text
    n [FieldAttr]
    fieldAttrs_
                            , unboundFieldType :: FieldType
    unboundFieldType =
                                FieldType
    ft
                            , unboundFieldAttrs :: [FieldAttr]
    unboundFieldAttrs =
                                [FieldAttr]
    fieldAttrs_
                            , unboundFieldStrict :: Bool
    unboundFieldStrict =
                                Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe (PersistSettings -> Bool
    psStrictFields PersistSettings
    ps) Maybe Bool
    mstrict
                            , unboundFieldComments :: Maybe Text
    unboundFieldComments =
                                Maybe Text
    forall a. Maybe a
    Nothing
                            , unboundFieldCascade :: FieldCascade
    unboundFieldCascade =
                                FieldCascade
    cascade_
                            , unboundFieldGenerated :: Maybe Text
    unboundFieldGenerated =
                                Maybe Text
    generated_
                            }
      where
        fieldAttrs_ :: [FieldAttr]
    fieldAttrs_ = [Text] -> [FieldAttr]
    parseFieldAttrs [Text]
    attrs_
        generated_ :: Maybe Text
    generated_ = [Text] -> Maybe Text
    parseGenerated [Text]
    attrs_
        (FieldCascade
    cascade_, [Text]
    attrs_) = [Text] -> (FieldCascade, [Text])
    parseCascade [Text]
    rest'
        (Maybe Bool
    mstrict, Text
    n)
            | Just Text
    x <- Text -> Text -> Maybe Text
    T.stripPrefix Text
    "!" Text
    n' = (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True, Text
    x)
            | Just Text
    x <- Text -> Text -> Maybe Text
    T.stripPrefix Text
    "~" Text
    n' = (Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False, Text
    x)
            | Bool
    otherwise = (Maybe Bool
    forall a. Maybe a
    Nothing, Text
    n')
    takeCols Text -> [Char] -> Maybe UnboundFieldDef
    _ PersistSettings
    _ [Text]
    _ = Maybe UnboundFieldDef
    forall a. Maybe a
    Nothing

    parseGenerated :: [Text] -> Maybe Text
    parseGenerated :: [Text] -> Maybe Text
    parseGenerated = (Maybe Text -> Text -> Maybe Text)
    -> Maybe Text -> [Text] -> Maybe Text
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Maybe Text
    acc Text
    x -> Maybe Text
    acc Maybe Text -> Maybe Text -> Maybe Text
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Text -> Text -> Maybe Text
    T.stripPrefix Text
    "generated=" Text
    x) Maybe Text
    forall a. Maybe a
    Nothing

    getDbName :: PersistSettings -> Text -> [Text] -> Text
    getDbName :: PersistSettings -> Text -> [Text] -> Text
    getDbName PersistSettings
    ps Text
    n =
        Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe (PersistSettings -> Text -> Text
    psToDBName PersistSettings
    ps Text
    n) (Maybe Text -> Text) -> ([Text] -> Maybe Text) -> [Text] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Maybe Text
    forall a. [a] -> Maybe a
    listToMaybe ([Text] -> Maybe Text)
    -> ([Text] -> [Text]) -> [Text] -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Maybe Text) -> [Text] -> [Text]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Text -> Text -> Maybe Text
    T.stripPrefix Text
    "sql=")

    getDbName' :: PersistSettings -> Text -> [FieldAttr] -> FieldNameDB
    getDbName' :: PersistSettings -> Text -> [FieldAttr] -> FieldNameDB
    getDbName' PersistSettings
    ps Text
    n =
        FieldNameDB -> [FieldAttr] -> FieldNameDB
    getSqlNameOr (Text -> FieldNameDB
    FieldNameDB (Text -> FieldNameDB) -> Text -> FieldNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text -> Text
    psToDBName PersistSettings
    ps Text
    n)

    getSqlNameOr
        :: FieldNameDB
        -> [FieldAttr]
        -> FieldNameDB
    getSqlNameOr :: FieldNameDB -> [FieldAttr] -> FieldNameDB
    getSqlNameOr FieldNameDB
    def =
        FieldNameDB -> (Text -> FieldNameDB) -> Maybe Text -> FieldNameDB
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FieldNameDB
    def Text -> FieldNameDB
    FieldNameDB (Maybe Text -> FieldNameDB)
    -> ([FieldAttr] -> Maybe Text) -> [FieldAttr] -> FieldNameDB
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [FieldAttr] -> Maybe Text
    findAttrSql
      where
        findAttrSql :: [FieldAttr] -> Maybe Text
    findAttrSql =
            [Text] -> Maybe Text
    forall a. [a] -> Maybe a
    listToMaybe ([Text] -> Maybe Text)
    -> ([FieldAttr] -> [Text]) -> [FieldAttr] -> Maybe Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FieldAttr -> Maybe Text) -> [FieldAttr] -> [Text]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe FieldAttr -> Maybe Text
    isAttrSql
        isAttrSql :: FieldAttr -> Maybe Text
    isAttrSql FieldAttr
    attr =
            case FieldAttr
    attr of
                FieldAttrSql Text
    t ->
                    Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    t
                FieldAttr
    _ ->
                    Maybe Text
    forall a. Maybe a
    Nothing

    data SetOnceAtMost a
        = NotSet
        | SetOnce a
        | SetMoreThanOnce

    instance Semigroup (SetOnceAtMost a) where
        SetOnceAtMost a
    a <> :: SetOnceAtMost a -> SetOnceAtMost a -> SetOnceAtMost a
    <> SetOnceAtMost a
    b =
            case (SetOnceAtMost a
    a, SetOnceAtMost a
    b) of
                (SetOnceAtMost a
    _, SetOnceAtMost a
    NotSet) -> SetOnceAtMost a
    a
                (SetOnceAtMost a
    NotSet, SetOnceAtMost a
    _) -> SetOnceAtMost a
    b
                (SetOnce a
    _, SetOnce a
    _) -> SetOnceAtMost a
    forall a. SetOnceAtMost a
    SetMoreThanOnce
                (SetOnceAtMost a, SetOnceAtMost a)
    _ -> SetOnceAtMost a
    a

    instance Monoid (SetOnceAtMost a) where
        mempty :: SetOnceAtMost a
    mempty =
            SetOnceAtMost a
    forall a. SetOnceAtMost a
    NotSet

    data EntityConstraintDefs = EntityConstraintDefs
        { EntityConstraintDefs -> SetOnceAtMost UnboundIdDef
    entityConstraintDefsIdField :: SetOnceAtMost UnboundIdDef
        , EntityConstraintDefs -> SetOnceAtMost UnboundCompositeDef
    entityConstraintDefsPrimaryComposite :: SetOnceAtMost UnboundCompositeDef
        , EntityConstraintDefs -> Maybe (NonEmpty UniqueDef)
    entityConstraintDefsUniques :: Maybe (NonEmpty UniqueDef)
        , EntityConstraintDefs -> Maybe (NonEmpty UnboundForeignDef)
    entityConstraintDefsForeigns :: Maybe (NonEmpty UnboundForeignDef)
        }

    instance Semigroup EntityConstraintDefs where
        EntityConstraintDefs
    a <> :: EntityConstraintDefs
    -> EntityConstraintDefs -> EntityConstraintDefs
    <> EntityConstraintDefs
    b =
            EntityConstraintDefs
                { entityConstraintDefsIdField :: SetOnceAtMost UnboundIdDef
    entityConstraintDefsIdField =
                    EntityConstraintDefs -> SetOnceAtMost UnboundIdDef
    entityConstraintDefsIdField EntityConstraintDefs
    a SetOnceAtMost UnboundIdDef
    -> SetOnceAtMost UnboundIdDef -> SetOnceAtMost UnboundIdDef
    forall a. Semigroup a => a -> a -> a
    <> EntityConstraintDefs -> SetOnceAtMost UnboundIdDef
    entityConstraintDefsIdField EntityConstraintDefs
    b
                , entityConstraintDefsPrimaryComposite :: SetOnceAtMost UnboundCompositeDef
    entityConstraintDefsPrimaryComposite =
                    EntityConstraintDefs -> SetOnceAtMost UnboundCompositeDef
    entityConstraintDefsPrimaryComposite EntityConstraintDefs
    a SetOnceAtMost UnboundCompositeDef
    -> SetOnceAtMost UnboundCompositeDef
    -> SetOnceAtMost UnboundCompositeDef
    forall a. Semigroup a => a -> a -> a
    <> EntityConstraintDefs -> SetOnceAtMost UnboundCompositeDef
    entityConstraintDefsPrimaryComposite EntityConstraintDefs
    b
                , entityConstraintDefsUniques :: Maybe (NonEmpty UniqueDef)
    entityConstraintDefsUniques =
                    EntityConstraintDefs -> Maybe (NonEmpty UniqueDef)
    entityConstraintDefsUniques EntityConstraintDefs
    a Maybe (NonEmpty UniqueDef)
    -> Maybe (NonEmpty UniqueDef) -> Maybe (NonEmpty UniqueDef)
    forall a. Semigroup a => a -> a -> a
    <> EntityConstraintDefs -> Maybe (NonEmpty UniqueDef)
    entityConstraintDefsUniques EntityConstraintDefs
    b
                , entityConstraintDefsForeigns :: Maybe (NonEmpty UnboundForeignDef)
    entityConstraintDefsForeigns =
                    EntityConstraintDefs -> Maybe (NonEmpty UnboundForeignDef)
    entityConstraintDefsForeigns EntityConstraintDefs
    a Maybe (NonEmpty UnboundForeignDef)
    -> Maybe (NonEmpty UnboundForeignDef)
    -> Maybe (NonEmpty UnboundForeignDef)
    forall a. Semigroup a => a -> a -> a
    <> EntityConstraintDefs -> Maybe (NonEmpty UnboundForeignDef)
    entityConstraintDefsForeigns EntityConstraintDefs
    b
                }

    instance Monoid EntityConstraintDefs where
        mempty :: EntityConstraintDefs
    mempty =
            SetOnceAtMost UnboundIdDef
    -> SetOnceAtMost UnboundCompositeDef
    -> Maybe (NonEmpty UniqueDef)
    -> Maybe (NonEmpty UnboundForeignDef)
    -> EntityConstraintDefs
    EntityConstraintDefs SetOnceAtMost UnboundIdDef
    forall a. Monoid a => a
    mempty SetOnceAtMost UnboundCompositeDef
    forall a. Monoid a => a
    mempty Maybe (NonEmpty UniqueDef)
    forall a. Maybe a
    Nothing Maybe (NonEmpty UnboundForeignDef)
    forall a. Maybe a
    Nothing

    entityConstraintDefsUniquesList :: EntityConstraintDefs -> [UniqueDef]
    entityConstraintDefsUniquesList :: EntityConstraintDefs -> [UniqueDef]
    entityConstraintDefsUniquesList = (NonEmpty UniqueDef -> [UniqueDef])
    -> Maybe (NonEmpty UniqueDef) -> [UniqueDef]
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap NonEmpty UniqueDef -> [UniqueDef]
    forall a. NonEmpty a -> [a]
    NEL.toList (Maybe (NonEmpty UniqueDef) -> [UniqueDef])
    -> (EntityConstraintDefs -> Maybe (NonEmpty UniqueDef))
    -> EntityConstraintDefs
    -> [UniqueDef]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityConstraintDefs -> Maybe (NonEmpty UniqueDef)
    entityConstraintDefsUniques

    entityConstraintDefsForeignsList :: EntityConstraintDefs -> [UnboundForeignDef]
    entityConstraintDefsForeignsList :: EntityConstraintDefs -> [UnboundForeignDef]
    entityConstraintDefsForeignsList = (NonEmpty UnboundForeignDef -> [UnboundForeignDef])
    -> Maybe (NonEmpty UnboundForeignDef) -> [UnboundForeignDef]
    forall m a. Monoid m => (a -> m) -> Maybe a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap NonEmpty UnboundForeignDef -> [UnboundForeignDef]
    forall a. NonEmpty a -> [a]
    NEL.toList (Maybe (NonEmpty UnboundForeignDef) -> [UnboundForeignDef])
    -> (EntityConstraintDefs -> Maybe (NonEmpty UnboundForeignDef))
    -> EntityConstraintDefs
    -> [UnboundForeignDef]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityConstraintDefs -> Maybe (NonEmpty UnboundForeignDef)
    entityConstraintDefsForeigns

    takeConstraint
        :: PersistSettings
        -> EntityNameHS
        -> [UnboundFieldDef]
        -> NonEmpty Text
        -> EntityConstraintDefs
    takeConstraint :: PersistSettings
    -> EntityNameHS
    -> [UnboundFieldDef]
    -> NonEmpty Text
    -> EntityConstraintDefs
    takeConstraint PersistSettings
    ps EntityNameHS
    entityName [UnboundFieldDef]
    defs (Text
    n :| [Text]
    rest) =
        case Text
    n of
            Text
    "Unique" ->
                EntityConstraintDefs
    forall a. Monoid a => a
    mempty
                    { entityConstraintDefsUniques =
                        pure <$> takeUniq ps (unEntityNameHS entityName) defs rest
                    }
            Text
    "Foreign" ->
                EntityConstraintDefs
    forall a. Monoid a => a
    mempty
                    { entityConstraintDefsForeigns =
                        Just $ pure (takeForeign ps entityName rest)
                    }
            Text
    "Primary" ->
                let
                    unboundComposite :: UnboundCompositeDef
    unboundComposite =
                        [FieldNameHS] -> [Text] -> UnboundCompositeDef
    takeComposite (UnboundFieldDef -> FieldNameHS
    unboundFieldNameHS (UnboundFieldDef -> FieldNameHS)
    -> [UnboundFieldDef] -> [FieldNameHS]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [UnboundFieldDef]
    defs) [Text]
    rest
                 in
                    EntityConstraintDefs
    forall a. Monoid a => a
    mempty
                        { entityConstraintDefsPrimaryComposite =
                            SetOnce unboundComposite
                        , entityConstraintDefsUniques =
                            Just $ pure $ compositeToUniqueDef entityName defs unboundComposite
                        }
            Text
    "Id" ->
                EntityConstraintDefs
    forall a. Monoid a => a
    mempty
                    { entityConstraintDefsIdField =
                        SetOnce (takeId ps entityName rest)
                    }
            Text
    _
                | Text -> Bool
    isCapitalizedText Text
    n ->
                    EntityConstraintDefs
    forall a. Monoid a => a
    mempty
                        { entityConstraintDefsUniques =
                            pure <$> takeUniq ps "" defs (n : rest)
                        }
            Text
    _ ->
                EntityConstraintDefs
    forall a. Monoid a => a
    mempty

    -- TODO: this is hacky (the double takeCols, the setFieldDef stuff, and setIdName.
    -- need to re-work takeCols function
    takeId :: PersistSettings -> EntityNameHS -> [Text] -> UnboundIdDef
    takeId :: PersistSettings -> EntityNameHS -> [Text] -> UnboundIdDef
    takeId PersistSettings
    ps EntityNameHS
    entityName [Text]
    texts =
        UnboundIdDef
            { unboundIdDBName :: FieldNameDB
    unboundIdDBName =
                Text -> FieldNameDB
    FieldNameDB (Text -> FieldNameDB) -> Text -> FieldNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text
    psIdName PersistSettings
    ps
            , unboundIdEntityName :: EntityNameHS
    unboundIdEntityName =
                EntityNameHS
    entityName
            , unboundIdCascade :: FieldCascade
    unboundIdCascade =
                FieldCascade
    cascade_
            , unboundIdAttrs :: [FieldAttr]
    unboundIdAttrs =
                [Text] -> [FieldAttr]
    parseFieldAttrs [Text]
    attrs_
            , unboundIdType :: Maybe FieldType
    unboundIdType =
                Maybe FieldType
    typ
            }
      where
        typ :: Maybe FieldType
    typ =
            case [Text]
    texts of
                [] ->
                    Maybe FieldType
    forall a. Maybe a
    Nothing
                (Text
    t : [Text]
    _) ->
                    case Text -> Either [Char] FieldType
    parseFieldType Text
    t of
                        Left [Char]
    _ ->
                            Maybe FieldType
    forall a. Maybe a
    Nothing
                        Right FieldType
    ft ->
                            FieldType -> Maybe FieldType
    forall a. a -> Maybe a
    Just FieldType
    ft
        (FieldCascade
    cascade_, [Text]
    attrs_) = [Text] -> (FieldCascade, [Text])
    parseCascade [Text]
    texts

    -- | A definition for a composite primary key.
    --
    -- @since.2.13.0.0
    data UnboundCompositeDef = UnboundCompositeDef
        { UnboundCompositeDef -> NonEmpty FieldNameHS
    unboundCompositeCols :: NonEmpty FieldNameHS
        -- ^ The field names for the primary key.
        --
        -- @since 2.13.0.0
        , UnboundCompositeDef -> [Text]
    unboundCompositeAttrs :: [Attr]
        -- ^ A list of attributes defined on the primary key. This is anything that
        -- occurs after a @!@ character.
        --
        -- @since 2.13.0.0
        }
        deriving (UnboundCompositeDef -> UnboundCompositeDef -> Bool
    (UnboundCompositeDef -> UnboundCompositeDef -> Bool)
    -> (UnboundCompositeDef -> UnboundCompositeDef -> Bool)
    -> Eq UnboundCompositeDef
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    == :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    $c/= :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    /= :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    Eq, Eq UnboundCompositeDef
    Eq UnboundCompositeDef =>
    (UnboundCompositeDef -> UnboundCompositeDef -> Ordering)
    -> (UnboundCompositeDef -> UnboundCompositeDef -> Bool)
    -> (UnboundCompositeDef -> UnboundCompositeDef -> Bool)
    -> (UnboundCompositeDef -> UnboundCompositeDef -> Bool)
    -> (UnboundCompositeDef -> UnboundCompositeDef -> Bool)
    -> (UnboundCompositeDef
        -> UnboundCompositeDef -> UnboundCompositeDef)
    -> (UnboundCompositeDef
        -> UnboundCompositeDef -> UnboundCompositeDef)
    -> Ord UnboundCompositeDef
    UnboundCompositeDef -> UnboundCompositeDef -> Bool
    UnboundCompositeDef -> UnboundCompositeDef -> Ordering
    UnboundCompositeDef -> UnboundCompositeDef -> UnboundCompositeDef
    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 :: UnboundCompositeDef -> UnboundCompositeDef -> Ordering
    compare :: UnboundCompositeDef -> UnboundCompositeDef -> Ordering
    $c< :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    < :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    $c<= :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    <= :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    $c> :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    > :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    $c>= :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    >= :: UnboundCompositeDef -> UnboundCompositeDef -> Bool
    $cmax :: UnboundCompositeDef -> UnboundCompositeDef -> UnboundCompositeDef
    max :: UnboundCompositeDef -> UnboundCompositeDef -> UnboundCompositeDef
    $cmin :: UnboundCompositeDef -> UnboundCompositeDef -> UnboundCompositeDef
    min :: UnboundCompositeDef -> UnboundCompositeDef -> UnboundCompositeDef
    Ord, Int -> UnboundCompositeDef -> ShowS
    [UnboundCompositeDef] -> ShowS
    UnboundCompositeDef -> [Char]
    (Int -> UnboundCompositeDef -> ShowS)
    -> (UnboundCompositeDef -> [Char])
    -> ([UnboundCompositeDef] -> ShowS)
    -> Show UnboundCompositeDef
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnboundCompositeDef -> ShowS
    showsPrec :: Int -> UnboundCompositeDef -> ShowS
    $cshow :: UnboundCompositeDef -> [Char]
    show :: UnboundCompositeDef -> [Char]
    $cshowList :: [UnboundCompositeDef] -> ShowS
    showList :: [UnboundCompositeDef] -> ShowS
    Show, (forall (m :: * -> *). Quote m => UnboundCompositeDef -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        UnboundCompositeDef -> Code m UnboundCompositeDef)
    -> Lift UnboundCompositeDef
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => UnboundCompositeDef -> m Exp
    forall (m :: * -> *).
    Quote m =>
    UnboundCompositeDef -> Code m UnboundCompositeDef
    $clift :: forall (m :: * -> *). Quote m => UnboundCompositeDef -> m Exp
    lift :: forall (m :: * -> *). Quote m => UnboundCompositeDef -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundCompositeDef -> Code m UnboundCompositeDef
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundCompositeDef -> Code m UnboundCompositeDef
    Lift)

    compositeToUniqueDef
        :: EntityNameHS -> [UnboundFieldDef] -> UnboundCompositeDef -> UniqueDef
    compositeToUniqueDef :: EntityNameHS
    -> [UnboundFieldDef] -> UnboundCompositeDef -> UniqueDef
    compositeToUniqueDef EntityNameHS
    entityName [UnboundFieldDef]
    fields UnboundCompositeDef{[Text]
    NonEmpty FieldNameHS
    unboundCompositeCols :: UnboundCompositeDef -> NonEmpty FieldNameHS
    unboundCompositeAttrs :: UnboundCompositeDef -> [Text]
    unboundCompositeCols :: NonEmpty FieldNameHS
    unboundCompositeAttrs :: [Text]
    ..} =
        UniqueDef
            { uniqueHaskell :: ConstraintNameHS
    uniqueHaskell =
                Text -> ConstraintNameHS
    ConstraintNameHS (EntityNameHS -> Text
    unEntityNameHS EntityNameHS
    entityName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "PrimaryKey")
            , uniqueDBName :: ConstraintNameDB
    uniqueDBName =
                Text -> ConstraintNameDB
    ConstraintNameDB Text
    "primary_key"
            , uniqueFields :: NonEmpty (FieldNameHS, FieldNameDB)
    uniqueFields =
                (FieldNameHS -> (FieldNameHS, FieldNameDB))
    -> NonEmpty FieldNameHS -> NonEmpty (FieldNameHS, FieldNameDB)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\FieldNameHS
    hsName -> (FieldNameHS
    hsName, FieldNameHS -> FieldNameDB
    getDbNameFor FieldNameHS
    hsName)) NonEmpty FieldNameHS
    unboundCompositeCols
            , uniqueAttrs :: [Text]
    uniqueAttrs =
                [Text]
    unboundCompositeAttrs
            }
      where
        getDbNameFor :: FieldNameHS -> FieldNameDB
    getDbNameFor FieldNameHS
    hsName =
            case (UnboundFieldDef -> Maybe FieldNameDB)
    -> [UnboundFieldDef] -> [FieldNameDB]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (FieldNameHS -> UnboundFieldDef -> Maybe FieldNameDB
    forall {m :: * -> *}.
    (Monad m, Alternative m) =>
    FieldNameHS -> UnboundFieldDef -> m FieldNameDB
    matchHsName FieldNameHS
    hsName) [UnboundFieldDef]
    fields of
                [] ->
                    [Char] -> FieldNameDB
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Unable to find `hsName` in fields"
                (FieldNameDB
    a : [FieldNameDB]
    _) ->
                    FieldNameDB
    a
        matchHsName :: FieldNameHS -> UnboundFieldDef -> m FieldNameDB
    matchHsName FieldNameHS
    hsName UnboundFieldDef{Bool
    [FieldAttr]
    Maybe Text
    FieldNameHS
    FieldNameDB
    FieldCascade
    FieldType
    unboundFieldNameHS :: UnboundFieldDef -> FieldNameHS
    unboundFieldNameDB :: UnboundFieldDef -> FieldNameDB
    unboundFieldAttrs :: UnboundFieldDef -> [FieldAttr]
    unboundFieldStrict :: UnboundFieldDef -> Bool
    unboundFieldType :: UnboundFieldDef -> FieldType
    unboundFieldCascade :: UnboundFieldDef -> FieldCascade
    unboundFieldGenerated :: UnboundFieldDef -> Maybe Text
    unboundFieldComments :: UnboundFieldDef -> Maybe Text
    unboundFieldNameHS :: FieldNameHS
    unboundFieldNameDB :: FieldNameDB
    unboundFieldAttrs :: [FieldAttr]
    unboundFieldStrict :: Bool
    unboundFieldType :: FieldType
    unboundFieldCascade :: FieldCascade
    unboundFieldGenerated :: Maybe Text
    unboundFieldComments :: Maybe Text
    ..} = do
            Bool -> m ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> m ()) -> Bool -> m ()
    forall a b. (a -> b) -> a -> b
    $ FieldNameHS
    unboundFieldNameHS FieldNameHS -> FieldNameHS -> Bool
    forall a. Eq a => a -> a -> Bool
    == FieldNameHS
    hsName
            FieldNameDB -> m FieldNameDB
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FieldNameDB
    unboundFieldNameDB

    takeComposite
        :: [FieldNameHS]
        -> [Text]
        -> UnboundCompositeDef
    takeComposite :: [FieldNameHS] -> [Text] -> UnboundCompositeDef
    takeComposite [FieldNameHS]
    fields [Text]
    pkcols =
        UnboundCompositeDef
            { unboundCompositeCols :: NonEmpty FieldNameHS
    unboundCompositeCols =
                (Text -> FieldNameHS) -> NonEmpty Text -> NonEmpty FieldNameHS
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([FieldNameHS] -> Text -> FieldNameHS
    getDef [FieldNameHS]
    fields) NonEmpty Text
    neCols
            , unboundCompositeAttrs :: [Text]
    unboundCompositeAttrs =
                [Text]
    attrs
            }
      where
        neCols :: NonEmpty Text
    neCols =
            case [Text] -> Maybe (NonEmpty Text)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [Text]
    cols of
                Maybe (NonEmpty Text)
    Nothing ->
                    [Char] -> NonEmpty Text
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "No fields provided for primary key"
                Just NonEmpty Text
    xs ->
                    NonEmpty Text
    xs
        ([Text]
    cols, [Text]
    attrs) = (Text -> Bool) -> [Text] -> ([Text], [Text])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Text
    "!" Text -> Text -> Bool
    `T.isPrefixOf`) [Text]
    pkcols
        getDef :: [FieldNameHS] -> Text -> FieldNameHS
    getDef [] Text
    t = [Char] -> FieldNameHS
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> FieldNameHS) -> [Char] -> FieldNameHS
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Unknown column in primary key constraint: " [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    t
        getDef (FieldNameHS
    d : [FieldNameHS]
    ds) Text
    t
            | FieldNameHS
    d FieldNameHS -> FieldNameHS -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> FieldNameHS
    FieldNameHS Text
    t =
                -- TODO: check for nullability in later step
                -- if nullable (fieldAttrs d) /= NotNullable
                --     then error $ "primary key column cannot be nullable: " ++ show t ++ show fields
                FieldNameHS
    d
            | Bool
    otherwise =
                [FieldNameHS] -> Text -> FieldNameHS
    getDef [FieldNameHS]
    ds Text
    t

    -- Unique UppercaseConstraintName list of lowercasefields terminated
    -- by ! or sql= such that a unique constraint can look like:
    -- `UniqueTestNull fieldA fieldB sql=ConstraintNameInDatabase !force`
    -- Here using sql= sets the name of the constraint.
    takeUniq
        :: PersistSettings
        -> Text
        -> [UnboundFieldDef]
        -> [Text]
        -> Maybe UniqueDef
    takeUniq :: PersistSettings
    -> Text -> [UnboundFieldDef] -> [Text] -> Maybe UniqueDef
    takeUniq PersistSettings
    ps Text
    tableName [UnboundFieldDef]
    defs (Text
    n : [Text]
    rest)
        | Text -> Bool
    isCapitalizedText Text
    n = do
            fields <- Maybe (NonEmpty Text)
    mfields
            pure
                UniqueDef
                    { uniqueHaskell =
                        ConstraintNameHS n
                    , uniqueDBName =
                        dbName
                    , uniqueFields =
                        fmap (\Text
    a -> (Text -> FieldNameHS
    FieldNameHS Text
    a, [UnboundFieldDef] -> Text -> FieldNameDB
    getDBName [UnboundFieldDef]
    defs Text
    a)) fields
                    , uniqueAttrs =
                        attrs
                    }
      where
        isAttr :: Text -> Bool
    isAttr Text
    a =
            Text
    "!" Text -> Text -> Bool
    `T.isPrefixOf` Text
    a
        isSqlName :: Text -> Bool
    isSqlName Text
    a =
            Text
    "sql=" Text -> Text -> Bool
    `T.isPrefixOf` Text
    a
        isNonField :: Text -> Bool
    isNonField Text
    a =
            Text -> Bool
    isAttr Text
    a Bool -> Bool -> Bool
    || Text -> Bool
    isSqlName Text
    a
        ([Text]
    fieldsList, [Text]
    nonFields) =
            (Text -> Bool) -> [Text] -> ([Text], [Text])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break Text -> Bool
    isNonField [Text]
    rest
        mfields :: Maybe (NonEmpty Text)
    mfields =
            [Text] -> Maybe (NonEmpty Text)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [Text]
    fieldsList

        attrs :: [Text]
    attrs = (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Text -> Bool
    isAttr [Text]
    nonFields

        usualDbName :: ConstraintNameDB
    usualDbName =
            Text -> ConstraintNameDB
    ConstraintNameDB (Text -> ConstraintNameDB) -> Text -> ConstraintNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text -> Text
    psToDBName PersistSettings
    ps (Text
    tableName Text -> Text -> Text
    `T.append` Text
    n)
        sqlName :: Maybe ConstraintNameDB
        sqlName :: Maybe ConstraintNameDB
    sqlName =
            case (Text -> Bool) -> [Text] -> Maybe Text
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find Text -> Bool
    isSqlName [Text]
    nonFields of
                Maybe Text
    Nothing ->
                    Maybe ConstraintNameDB
    forall a. Maybe a
    Nothing
                (Just Text
    t) ->
                    case Int -> [Text] -> [Text]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HasCallStack => Text -> Text -> [Text]
    Text -> Text -> [Text]
    T.splitOn Text
    "=" Text
    t of
                        (Text
    x : [Text]
    _) -> ConstraintNameDB -> Maybe ConstraintNameDB
    forall a. a -> Maybe a
    Just (Text -> ConstraintNameDB
    ConstraintNameDB Text
    x)
                        [Text]
    _ -> Maybe ConstraintNameDB
    forall a. Maybe a
    Nothing
        dbName :: ConstraintNameDB
    dbName = ConstraintNameDB -> Maybe ConstraintNameDB -> ConstraintNameDB
    forall a. a -> Maybe a -> a
    fromMaybe ConstraintNameDB
    usualDbName Maybe ConstraintNameDB
    sqlName

        getDBName :: [UnboundFieldDef] -> Text -> FieldNameDB
    getDBName [] Text
    t = [Char] -> FieldNameDB
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> FieldNameDB) -> [Char] -> FieldNameDB
    forall a b. (a -> b) -> a -> b
    $ Text -> [Char]
    T.unpack (Text -> [UnboundFieldDef] -> Text -> Text
    unknownUniqueColumnError Text
    t [UnboundFieldDef]
    defs Text
    n)
        getDBName (UnboundFieldDef
    d : [UnboundFieldDef]
    ds) Text
    t
            | UnboundFieldDef -> FieldNameHS
    unboundFieldNameHS UnboundFieldDef
    d FieldNameHS -> FieldNameHS -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> FieldNameHS
    FieldNameHS Text
    t =
                UnboundFieldDef -> FieldNameDB
    unboundFieldNameDB UnboundFieldDef
    d
            | Bool
    otherwise =
                [UnboundFieldDef] -> Text -> FieldNameDB
    getDBName [UnboundFieldDef]
    ds Text
    t
    takeUniq PersistSettings
    _ Text
    tableName [UnboundFieldDef]
    _ [Text]
    xs =
        [Char] -> Maybe UniqueDef
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Maybe UniqueDef) -> [Char] -> Maybe UniqueDef
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    "invalid unique constraint on table["
                [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show Text
    tableName
                [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "] expecting an uppercase constraint name xs="
                [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Text] -> [Char]
    forall a. Show a => a -> [Char]
    show [Text]
    xs

    unknownUniqueColumnError :: Text -> [UnboundFieldDef] -> Text -> Text
    unknownUniqueColumnError :: Text -> [UnboundFieldDef] -> Text -> Text
    unknownUniqueColumnError Text
    t [UnboundFieldDef]
    defs Text
    n =
        Text
    "Unknown column in \""
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    n
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\" constraint: \""
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    t
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\""
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " possible fields: "
            Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Text
    T.pack ([Text] -> [Char]
    forall a. Show a => a -> [Char]
    show (UnboundFieldDef -> Text
    toFieldName (UnboundFieldDef -> Text) -> [UnboundFieldDef] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [UnboundFieldDef]
    defs))
      where
        toFieldName :: UnboundFieldDef -> Text
        toFieldName :: UnboundFieldDef -> Text
    toFieldName UnboundFieldDef
    fd =
            FieldNameHS -> Text
    unFieldNameHS (UnboundFieldDef -> FieldNameHS
    unboundFieldNameHS UnboundFieldDef
    fd)

    -- | Define an explicit foreign key reference.
    --
    -- @
    -- User
    --     name Text
    --     email Text
    --
    --     Primary name email
    --
    -- Dog
    --     ownerName Text
    --     ownerEmail Text
    --
    --     Foreign User fk_dog_user ownerName ownerEmail
    -- @
    --
    -- @since 2.13.0.0
    data UnboundForeignDef
        = UnboundForeignDef
        { UnboundForeignDef -> UnboundForeignFieldList
    unboundForeignFields :: UnboundForeignFieldList
        -- ^ Fields in the source entity.
        --
        -- @since 2.13.0.0
        , UnboundForeignDef -> ForeignDef
    unboundForeignDef :: ForeignDef
        -- ^ The 'ForeignDef' which needs information filled in.
        --
        -- This value is unreliable. See the parsing code to see what data is filled
        -- in here.
        --
        -- @since 2.13.0.0
        }
        deriving (UnboundForeignDef -> UnboundForeignDef -> Bool
    (UnboundForeignDef -> UnboundForeignDef -> Bool)
    -> (UnboundForeignDef -> UnboundForeignDef -> Bool)
    -> Eq UnboundForeignDef
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnboundForeignDef -> UnboundForeignDef -> Bool
    == :: UnboundForeignDef -> UnboundForeignDef -> Bool
    $c/= :: UnboundForeignDef -> UnboundForeignDef -> Bool
    /= :: UnboundForeignDef -> UnboundForeignDef -> Bool
    Eq, Eq UnboundForeignDef
    Eq UnboundForeignDef =>
    (UnboundForeignDef -> UnboundForeignDef -> Ordering)
    -> (UnboundForeignDef -> UnboundForeignDef -> Bool)
    -> (UnboundForeignDef -> UnboundForeignDef -> Bool)
    -> (UnboundForeignDef -> UnboundForeignDef -> Bool)
    -> (UnboundForeignDef -> UnboundForeignDef -> Bool)
    -> (UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef)
    -> (UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef)
    -> Ord UnboundForeignDef
    UnboundForeignDef -> UnboundForeignDef -> Bool
    UnboundForeignDef -> UnboundForeignDef -> Ordering
    UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef
    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 :: UnboundForeignDef -> UnboundForeignDef -> Ordering
    compare :: UnboundForeignDef -> UnboundForeignDef -> Ordering
    $c< :: UnboundForeignDef -> UnboundForeignDef -> Bool
    < :: UnboundForeignDef -> UnboundForeignDef -> Bool
    $c<= :: UnboundForeignDef -> UnboundForeignDef -> Bool
    <= :: UnboundForeignDef -> UnboundForeignDef -> Bool
    $c> :: UnboundForeignDef -> UnboundForeignDef -> Bool
    > :: UnboundForeignDef -> UnboundForeignDef -> Bool
    $c>= :: UnboundForeignDef -> UnboundForeignDef -> Bool
    >= :: UnboundForeignDef -> UnboundForeignDef -> Bool
    $cmax :: UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef
    max :: UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef
    $cmin :: UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef
    min :: UnboundForeignDef -> UnboundForeignDef -> UnboundForeignDef
    Ord, Int -> UnboundForeignDef -> ShowS
    [UnboundForeignDef] -> ShowS
    UnboundForeignDef -> [Char]
    (Int -> UnboundForeignDef -> ShowS)
    -> (UnboundForeignDef -> [Char])
    -> ([UnboundForeignDef] -> ShowS)
    -> Show UnboundForeignDef
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnboundForeignDef -> ShowS
    showsPrec :: Int -> UnboundForeignDef -> ShowS
    $cshow :: UnboundForeignDef -> [Char]
    show :: UnboundForeignDef -> [Char]
    $cshowList :: [UnboundForeignDef] -> ShowS
    showList :: [UnboundForeignDef] -> ShowS
    Show, (forall (m :: * -> *). Quote m => UnboundForeignDef -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        UnboundForeignDef -> Code m UnboundForeignDef)
    -> Lift UnboundForeignDef
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => UnboundForeignDef -> m Exp
    forall (m :: * -> *).
    Quote m =>
    UnboundForeignDef -> Code m UnboundForeignDef
    $clift :: forall (m :: * -> *). Quote m => UnboundForeignDef -> m Exp
    lift :: forall (m :: * -> *). Quote m => UnboundForeignDef -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundForeignDef -> Code m UnboundForeignDef
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundForeignDef -> Code m UnboundForeignDef
    Lift)

    -- | A list of fields present on the foreign reference.
    data UnboundForeignFieldList
        = -- | If no @References@ keyword is supplied, then it is assumed that you are
          -- referring to the @Primary@ key or @Id@ of the target entity.
          --
          -- @since 2.13.0.0
          FieldListImpliedId (NonEmpty FieldNameHS)
        | -- | You can specify the exact columns you're referring to here, if they
          -- aren't part of a primary key. Most databases expect a unique index on the
          -- columns you refer to, but Persistent doesnt' check that.
          --
          -- @
          -- User
          --     Id           UUID default="uuid_generate_v1mc()"
          --     name         Text
          --
          --     UniqueName name
          --
          -- Dog
          --     ownerName    Text
          --
          --     Foreign User fk_dog_user ownerName References name
          -- @
          --
          -- @since 2.13.0.0
          FieldListHasReferences (NonEmpty ForeignFieldReference)
        deriving (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool)
    -> (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool)
    -> Eq UnboundForeignFieldList
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    == :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    $c/= :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    /= :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    Eq, Eq UnboundForeignFieldList
    Eq UnboundForeignFieldList =>
    (UnboundForeignFieldList -> UnboundForeignFieldList -> Ordering)
    -> (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool)
    -> (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool)
    -> (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool)
    -> (UnboundForeignFieldList -> UnboundForeignFieldList -> Bool)
    -> (UnboundForeignFieldList
        -> UnboundForeignFieldList -> UnboundForeignFieldList)
    -> (UnboundForeignFieldList
        -> UnboundForeignFieldList -> UnboundForeignFieldList)
    -> Ord UnboundForeignFieldList
    UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    UnboundForeignFieldList -> UnboundForeignFieldList -> Ordering
    UnboundForeignFieldList
    -> UnboundForeignFieldList -> UnboundForeignFieldList
    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 :: UnboundForeignFieldList -> UnboundForeignFieldList -> Ordering
    compare :: UnboundForeignFieldList -> UnboundForeignFieldList -> Ordering
    $c< :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    < :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    $c<= :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    <= :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    $c> :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    > :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    $c>= :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    >= :: UnboundForeignFieldList -> UnboundForeignFieldList -> Bool
    $cmax :: UnboundForeignFieldList
    -> UnboundForeignFieldList -> UnboundForeignFieldList
    max :: UnboundForeignFieldList
    -> UnboundForeignFieldList -> UnboundForeignFieldList
    $cmin :: UnboundForeignFieldList
    -> UnboundForeignFieldList -> UnboundForeignFieldList
    min :: UnboundForeignFieldList
    -> UnboundForeignFieldList -> UnboundForeignFieldList
    Ord, Int -> UnboundForeignFieldList -> ShowS
    [UnboundForeignFieldList] -> ShowS
    UnboundForeignFieldList -> [Char]
    (Int -> UnboundForeignFieldList -> ShowS)
    -> (UnboundForeignFieldList -> [Char])
    -> ([UnboundForeignFieldList] -> ShowS)
    -> Show UnboundForeignFieldList
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnboundForeignFieldList -> ShowS
    showsPrec :: Int -> UnboundForeignFieldList -> ShowS
    $cshow :: UnboundForeignFieldList -> [Char]
    show :: UnboundForeignFieldList -> [Char]
    $cshowList :: [UnboundForeignFieldList] -> ShowS
    showList :: [UnboundForeignFieldList] -> ShowS
    Show, (forall (m :: * -> *). Quote m => UnboundForeignFieldList -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        UnboundForeignFieldList -> Code m UnboundForeignFieldList)
    -> Lift UnboundForeignFieldList
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => UnboundForeignFieldList -> m Exp
    forall (m :: * -> *).
    Quote m =>
    UnboundForeignFieldList -> Code m UnboundForeignFieldList
    $clift :: forall (m :: * -> *). Quote m => UnboundForeignFieldList -> m Exp
    lift :: forall (m :: * -> *). Quote m => UnboundForeignFieldList -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundForeignFieldList -> Code m UnboundForeignFieldList
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    UnboundForeignFieldList -> Code m UnboundForeignFieldList
    Lift)

    -- | A pairing of the 'FieldNameHS' for the source table to the 'FieldNameHS'
    -- for the target table.
    --
    -- @since 2.13.0.0
    data ForeignFieldReference
        = ForeignFieldReference
        { ForeignFieldReference -> FieldNameHS
    ffrSourceField :: FieldNameHS
        -- ^ The column on the source table.
        --
        -- @since 2.13.0.0
        , ForeignFieldReference -> FieldNameHS
    ffrTargetField :: FieldNameHS
        -- ^ The column on the target table.
        --
        -- @since 2.13.0.0
        }
        deriving (ForeignFieldReference -> ForeignFieldReference -> Bool
    (ForeignFieldReference -> ForeignFieldReference -> Bool)
    -> (ForeignFieldReference -> ForeignFieldReference -> Bool)
    -> Eq ForeignFieldReference
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ForeignFieldReference -> ForeignFieldReference -> Bool
    == :: ForeignFieldReference -> ForeignFieldReference -> Bool
    $c/= :: ForeignFieldReference -> ForeignFieldReference -> Bool
    /= :: ForeignFieldReference -> ForeignFieldReference -> Bool
    Eq, Eq ForeignFieldReference
    Eq ForeignFieldReference =>
    (ForeignFieldReference -> ForeignFieldReference -> Ordering)
    -> (ForeignFieldReference -> ForeignFieldReference -> Bool)
    -> (ForeignFieldReference -> ForeignFieldReference -> Bool)
    -> (ForeignFieldReference -> ForeignFieldReference -> Bool)
    -> (ForeignFieldReference -> ForeignFieldReference -> Bool)
    -> (ForeignFieldReference
        -> ForeignFieldReference -> ForeignFieldReference)
    -> (ForeignFieldReference
        -> ForeignFieldReference -> ForeignFieldReference)
    -> Ord ForeignFieldReference
    ForeignFieldReference -> ForeignFieldReference -> Bool
    ForeignFieldReference -> ForeignFieldReference -> Ordering
    ForeignFieldReference
    -> ForeignFieldReference -> ForeignFieldReference
    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 :: ForeignFieldReference -> ForeignFieldReference -> Ordering
    compare :: ForeignFieldReference -> ForeignFieldReference -> Ordering
    $c< :: ForeignFieldReference -> ForeignFieldReference -> Bool
    < :: ForeignFieldReference -> ForeignFieldReference -> Bool
    $c<= :: ForeignFieldReference -> ForeignFieldReference -> Bool
    <= :: ForeignFieldReference -> ForeignFieldReference -> Bool
    $c> :: ForeignFieldReference -> ForeignFieldReference -> Bool
    > :: ForeignFieldReference -> ForeignFieldReference -> Bool
    $c>= :: ForeignFieldReference -> ForeignFieldReference -> Bool
    >= :: ForeignFieldReference -> ForeignFieldReference -> Bool
    $cmax :: ForeignFieldReference
    -> ForeignFieldReference -> ForeignFieldReference
    max :: ForeignFieldReference
    -> ForeignFieldReference -> ForeignFieldReference
    $cmin :: ForeignFieldReference
    -> ForeignFieldReference -> ForeignFieldReference
    min :: ForeignFieldReference
    -> ForeignFieldReference -> ForeignFieldReference
    Ord, Int -> ForeignFieldReference -> ShowS
    [ForeignFieldReference] -> ShowS
    ForeignFieldReference -> [Char]
    (Int -> ForeignFieldReference -> ShowS)
    -> (ForeignFieldReference -> [Char])
    -> ([ForeignFieldReference] -> ShowS)
    -> Show ForeignFieldReference
    forall a.
    (Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ForeignFieldReference -> ShowS
    showsPrec :: Int -> ForeignFieldReference -> ShowS
    $cshow :: ForeignFieldReference -> [Char]
    show :: ForeignFieldReference -> [Char]
    $cshowList :: [ForeignFieldReference] -> ShowS
    showList :: [ForeignFieldReference] -> ShowS
    Show, (forall (m :: * -> *). Quote m => ForeignFieldReference -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        ForeignFieldReference -> Code m ForeignFieldReference)
    -> Lift ForeignFieldReference
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => ForeignFieldReference -> m Exp
    forall (m :: * -> *).
    Quote m =>
    ForeignFieldReference -> Code m ForeignFieldReference
    $clift :: forall (m :: * -> *). Quote m => ForeignFieldReference -> m Exp
    lift :: forall (m :: * -> *). Quote m => ForeignFieldReference -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    ForeignFieldReference -> Code m ForeignFieldReference
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    ForeignFieldReference -> Code m ForeignFieldReference
    Lift)

    unbindForeignDef :: ForeignDef -> UnboundForeignDef
    unbindForeignDef :: ForeignDef -> UnboundForeignDef
    unbindForeignDef ForeignDef
    fd =
        UnboundForeignDef
            { unboundForeignFields :: UnboundForeignFieldList
    unboundForeignFields =
                NonEmpty ForeignFieldReference -> UnboundForeignFieldList
    FieldListHasReferences (NonEmpty ForeignFieldReference -> UnboundForeignFieldList)
    -> NonEmpty ForeignFieldReference -> UnboundForeignFieldList
    forall a b. (a -> b) -> a -> b
    $ [ForeignFieldReference] -> NonEmpty ForeignFieldReference
    forall a. HasCallStack => [a] -> NonEmpty a
    NEL.fromList ([ForeignFieldReference] -> NonEmpty ForeignFieldReference)
    -> [ForeignFieldReference] -> NonEmpty ForeignFieldReference
    forall a b. (a -> b) -> a -> b
    $ (((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))
     -> ForeignFieldReference)
    -> [((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))]
    -> [ForeignFieldReference]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))
    -> ForeignFieldReference
    forall {b} {b}.
    ((FieldNameHS, b), (FieldNameHS, b)) -> ForeignFieldReference
    mk (ForeignDef
    -> [((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))]
    foreignFields ForeignDef
    fd)
            , unboundForeignDef :: ForeignDef
    unboundForeignDef =
                ForeignDef
    fd
            }
      where
        mk :: ((FieldNameHS, b), (FieldNameHS, b)) -> ForeignFieldReference
    mk ((FieldNameHS
    fH, b
    _), (FieldNameHS
    pH, b
    _)) =
            ForeignFieldReference
                { ffrSourceField :: FieldNameHS
    ffrSourceField = FieldNameHS
    fH
                , ffrTargetField :: FieldNameHS
    ffrTargetField = FieldNameHS
    pH
                }

    mkUnboundForeignFieldList
        :: [Text]
        -> [Text]
        -> Either String UnboundForeignFieldList
    mkUnboundForeignFieldList :: [Text] -> [Text] -> Either [Char] UnboundForeignFieldList
    mkUnboundForeignFieldList ((Text -> FieldNameHS) -> [Text] -> [FieldNameHS]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> FieldNameHS
    FieldNameHS -> [FieldNameHS]
    source) ((Text -> FieldNameHS) -> [Text] -> [FieldNameHS]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> FieldNameHS
    FieldNameHS -> [FieldNameHS]
    target) =
        case [FieldNameHS] -> Maybe (NonEmpty FieldNameHS)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [FieldNameHS]
    source of
            Maybe (NonEmpty FieldNameHS)
    Nothing ->
                [Char] -> Either [Char] UnboundForeignFieldList
    forall a b. a -> Either a b
    Left [Char]
    "No fields on foreign reference."
            Just NonEmpty FieldNameHS
    sources ->
                case [FieldNameHS] -> Maybe (NonEmpty FieldNameHS)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [FieldNameHS]
    target of
                    Maybe (NonEmpty FieldNameHS)
    Nothing ->
                        UnboundForeignFieldList -> Either [Char] UnboundForeignFieldList
    forall a b. b -> Either a b
    Right (UnboundForeignFieldList -> Either [Char] UnboundForeignFieldList)
    -> UnboundForeignFieldList -> Either [Char] UnboundForeignFieldList
    forall a b. (a -> b) -> a -> b
    $ NonEmpty FieldNameHS -> UnboundForeignFieldList
    FieldListImpliedId NonEmpty FieldNameHS
    sources
                    Just NonEmpty FieldNameHS
    targets ->
                        if NonEmpty FieldNameHS -> Int
    forall a. NonEmpty a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty FieldNameHS
    targets Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= NonEmpty FieldNameHS -> Int
    forall a. NonEmpty a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty FieldNameHS
    sources
                            then
                                [Char] -> Either [Char] UnboundForeignFieldList
    forall a b. a -> Either a b
    Left [Char]
    "Target and source length differe on foreign reference."
                            else
                                UnboundForeignFieldList -> Either [Char] UnboundForeignFieldList
    forall a b. b -> Either a b
    Right (UnboundForeignFieldList -> Either [Char] UnboundForeignFieldList)
    -> UnboundForeignFieldList -> Either [Char] UnboundForeignFieldList
    forall a b. (a -> b) -> a -> b
    $
                                    NonEmpty ForeignFieldReference -> UnboundForeignFieldList
    FieldListHasReferences (NonEmpty ForeignFieldReference -> UnboundForeignFieldList)
    -> NonEmpty ForeignFieldReference -> UnboundForeignFieldList
    forall a b. (a -> b) -> a -> b
    $
                                        (FieldNameHS -> FieldNameHS -> ForeignFieldReference)
    -> NonEmpty FieldNameHS
    -> NonEmpty FieldNameHS
    -> NonEmpty ForeignFieldReference
    forall a b c.
    (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
    NEL.zipWith FieldNameHS -> FieldNameHS -> ForeignFieldReference
    ForeignFieldReference NonEmpty FieldNameHS
    sources NonEmpty FieldNameHS
    targets

    takeForeign
        :: PersistSettings
        -> EntityNameHS
        -> [Text]
        -> UnboundForeignDef
    takeForeign :: PersistSettings -> EntityNameHS -> [Text] -> UnboundForeignDef
    takeForeign PersistSettings
    ps EntityNameHS
    entityName = [Text] -> UnboundForeignDef
    takeRefTable
      where
        errorPrefix :: String
        errorPrefix :: [Char]
    errorPrefix =
            [Char]
    "invalid foreign key constraint on table["
                [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Text -> [Char]
    forall a. Show a => a -> [Char]
    show (EntityNameHS -> Text
    unEntityNameHS EntityNameHS
    entityName)
                [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "] "

        takeRefTable :: [Text] -> UnboundForeignDef
        takeRefTable :: [Text] -> UnboundForeignDef
    takeRefTable [] =
            [Char] -> UnboundForeignDef
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> UnboundForeignDef) -> [Char] -> UnboundForeignDef
    forall a b. (a -> b) -> a -> b
    $ [Char]
    errorPrefix [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " expecting foreign table name"
        takeRefTable (Text
    refTableName : [Text]
    restLine) =
            [Text]
    -> Maybe CascadeAction -> Maybe CascadeAction -> UnboundForeignDef
    go [Text]
    restLine Maybe CascadeAction
    forall a. Maybe a
    Nothing Maybe CascadeAction
    forall a. Maybe a
    Nothing
          where
            go :: [Text] -> Maybe CascadeAction -> Maybe CascadeAction -> UnboundForeignDef
            go :: [Text]
    -> Maybe CascadeAction -> Maybe CascadeAction -> UnboundForeignDef
    go (Text
    constraintNameText : [Text]
    rest) Maybe CascadeAction
    onDelete Maybe CascadeAction
    onUpdate
                | Bool -> Bool
    not (Text -> Bool
    T.null Text
    constraintNameText) Bool -> Bool -> Bool
    && Char -> Bool
    isLower (HasCallStack => Text -> Char
    Text -> Char
    T.head Text
    constraintNameText) =
                    UnboundForeignDef
                        { unboundForeignFields :: UnboundForeignFieldList
    unboundForeignFields =
                            ([Char] -> UnboundForeignFieldList)
    -> (UnboundForeignFieldList -> UnboundForeignFieldList)
    -> Either [Char] UnboundForeignFieldList
    -> UnboundForeignFieldList
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either [Char] -> UnboundForeignFieldList
    forall a. HasCallStack => [Char] -> a
    error UnboundForeignFieldList -> UnboundForeignFieldList
    forall a. a -> a
    id (Either [Char] UnboundForeignFieldList -> UnboundForeignFieldList)
    -> Either [Char] UnboundForeignFieldList -> UnboundForeignFieldList
    forall a b. (a -> b) -> a -> b
    $ [Text] -> [Text] -> Either [Char] UnboundForeignFieldList
    mkUnboundForeignFieldList [Text]
    foreignFields [Text]
    parentFields
                        , unboundForeignDef :: ForeignDef
    unboundForeignDef =
                            ForeignDef
                                { foreignRefTableHaskell :: EntityNameHS
    foreignRefTableHaskell =
                                    Text -> EntityNameHS
    EntityNameHS Text
    refTableName
                                , foreignRefTableDBName :: EntityNameDB
    foreignRefTableDBName =
                                    Text -> EntityNameDB
    EntityNameDB (Text -> EntityNameDB) -> Text -> EntityNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text -> Text
    psToDBName PersistSettings
    ps Text
    refTableName
                                , foreignConstraintNameHaskell :: ConstraintNameHS
    foreignConstraintNameHaskell =
                                    ConstraintNameHS
    constraintName
                                , foreignConstraintNameDBName :: ConstraintNameDB
    foreignConstraintNameDBName =
                                    PersistSettings
    -> EntityNameHS -> ConstraintNameHS -> ConstraintNameDB
    toFKConstraintNameDB PersistSettings
    ps EntityNameHS
    entityName ConstraintNameHS
    constraintName
                                , foreignFieldCascade :: FieldCascade
    foreignFieldCascade =
                                    FieldCascade
                                        { fcOnDelete :: Maybe CascadeAction
    fcOnDelete = Maybe CascadeAction
    onDelete
                                        , fcOnUpdate :: Maybe CascadeAction
    fcOnUpdate = Maybe CascadeAction
    onUpdate
                                        }
                                , foreignAttrs :: [Text]
    foreignAttrs =
                                    [Text]
    attrs
                                , foreignFields :: [((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))]
    foreignFields =
                                    []
                                , foreignNullable :: Bool
    foreignNullable =
                                    Bool
    False
                                , foreignToPrimary :: Bool
    foreignToPrimary =
                                    [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    parentFields
                                }
                        }
              where
                constraintName :: ConstraintNameHS
    constraintName =
                    Text -> ConstraintNameHS
    ConstraintNameHS Text
    constraintNameText

                ([Text]
    fields, [Text]
    attrs) =
                    (Text -> Bool) -> [Text] -> ([Text], [Text])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Text
    "!" Text -> Text -> Bool
    `T.isPrefixOf`) [Text]
    rest
                ([Text]
    foreignFields, [Text]
    parentFields) =
                    case (Text -> Bool) -> [Text] -> ([Text], [Text])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "References") [Text]
    fields of
                        ([Text]
    ffs, []) ->
                            ([Text]
    ffs, [])
                        ([Text]
    ffs, Text
    _ : [Text]
    pfs) ->
                            case ([Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    ffs, [Text] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Text]
    pfs) of
                                (Int
    flen, Int
    plen)
                                    | Int
    flen Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    plen ->
                                        ([Text]
    ffs, [Text]
    pfs)
                                (Int
    flen, Int
    plen) ->
                                    [Char] -> ([Text], [Text])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> ([Text], [Text])) -> [Char] -> ([Text], [Text])
    forall a b. (a -> b) -> a -> b
    $
                                        [Char]
    errorPrefix
                                            [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                                                [ [Char]
    "Found "
                                                , Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    flen
                                                , [Char]
    " foreign fields but "
                                                , Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    plen
                                                , [Char]
    " parent fields"
                                                ]
            go ((CascadePrefix -> Text -> Maybe CascadeAction
    parseCascadeAction CascadePrefix
    CascadeDelete -> Just CascadeAction
    cascadingAction) : [Text]
    rest) Maybe CascadeAction
    onDelete' Maybe CascadeAction
    onUpdate =
                case Maybe CascadeAction
    onDelete' of
                    Maybe CascadeAction
    Nothing ->
                        [Text]
    -> Maybe CascadeAction -> Maybe CascadeAction -> UnboundForeignDef
    go [Text]
    rest (CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    cascadingAction) Maybe CascadeAction
    onUpdate
                    Just CascadeAction
    _ ->
                        [Char] -> UnboundForeignDef
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> UnboundForeignDef) -> [Char] -> UnboundForeignDef
    forall a b. (a -> b) -> a -> b
    $ [Char]
    errorPrefix [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "found more than one OnDelete actions"
            go ((CascadePrefix -> Text -> Maybe CascadeAction
    parseCascadeAction CascadePrefix
    CascadeUpdate -> Just CascadeAction
    cascadingAction) : [Text]
    rest) Maybe CascadeAction
    onDelete Maybe CascadeAction
    onUpdate' =
                case Maybe CascadeAction
    onUpdate' of
                    Maybe CascadeAction
    Nothing ->
                        [Text]
    -> Maybe CascadeAction -> Maybe CascadeAction -> UnboundForeignDef
    go [Text]
    rest Maybe CascadeAction
    onDelete (CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    cascadingAction)
                    Just CascadeAction
    _ ->
                        [Char] -> UnboundForeignDef
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> UnboundForeignDef) -> [Char] -> UnboundForeignDef
    forall a b. (a -> b) -> a -> b
    $ [Char]
    errorPrefix [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "found more than one OnUpdate actions"
            go [Text]
    xs Maybe CascadeAction
    _ Maybe CascadeAction
    _ =
                [Char] -> UnboundForeignDef
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> UnboundForeignDef) -> [Char] -> UnboundForeignDef
    forall a b. (a -> b) -> a -> b
    $
                    [Char]
    errorPrefix
                        [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "expecting a lower case constraint name or a cascading action xs="
                        [Char] -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Text] -> [Char]
    forall a. Show a => a -> [Char]
    show [Text]
    xs

    toFKConstraintNameDB
        :: PersistSettings -> EntityNameHS -> ConstraintNameHS -> ConstraintNameDB
    toFKConstraintNameDB :: PersistSettings
    -> EntityNameHS -> ConstraintNameHS -> ConstraintNameDB
    toFKConstraintNameDB PersistSettings
    ps EntityNameHS
    entityName ConstraintNameHS
    constraintName =
        Text -> ConstraintNameDB
    ConstraintNameDB (Text -> ConstraintNameDB) -> Text -> ConstraintNameDB
    forall a b. (a -> b) -> a -> b
    $ PersistSettings -> Text -> Text
    psToDBName PersistSettings
    ps (PersistSettings -> EntityNameHS -> ConstraintNameHS -> Text
    psToFKName PersistSettings
    ps EntityNameHS
    entityName ConstraintNameHS
    constraintName)
    data CascadePrefix = CascadeUpdate | CascadeDelete

    parseCascade :: [Text] -> (FieldCascade, [Text])
    parseCascade :: [Text] -> (FieldCascade, [Text])
    parseCascade [Text]
    allTokens =
        [Text]
    -> Maybe CascadeAction
    -> Maybe CascadeAction
    -> [Text]
    -> (FieldCascade, [Text])
    go [] Maybe CascadeAction
    forall a. Maybe a
    Nothing Maybe CascadeAction
    forall a. Maybe a
    Nothing [Text]
    allTokens
      where
        go :: [Text]
    -> Maybe CascadeAction
    -> Maybe CascadeAction
    -> [Text]
    -> (FieldCascade, [Text])
    go [Text]
    acc Maybe CascadeAction
    mupd Maybe CascadeAction
    mdel [Text]
    tokens_ =
            case [Text]
    tokens_ of
                [] ->
                    ( FieldCascade
                        { fcOnDelete :: Maybe CascadeAction
    fcOnDelete = Maybe CascadeAction
    mdel
                        , fcOnUpdate :: Maybe CascadeAction
    fcOnUpdate = Maybe CascadeAction
    mupd
                        }
                    , [Text]
    acc
                    )
                Text
    this : [Text]
    rest ->
                    case CascadePrefix -> Text -> Maybe CascadeAction
    parseCascadeAction CascadePrefix
    CascadeUpdate Text
    this of
                        Just CascadeAction
    cascUpd ->
                            case Maybe CascadeAction
    mupd of
                                Maybe CascadeAction
    Nothing ->
                                    [Text]
    -> Maybe CascadeAction
    -> Maybe CascadeAction
    -> [Text]
    -> (FieldCascade, [Text])
    go [Text]
    acc (CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    cascUpd) Maybe CascadeAction
    mdel [Text]
    rest
                                Just CascadeAction
    _ ->
                                    [Char] -> (FieldCascade, [Text])
    nope [Char]
    "found more than one OnUpdate action"
                        Maybe CascadeAction
    Nothing ->
                            case CascadePrefix -> Text -> Maybe CascadeAction
    parseCascadeAction CascadePrefix
    CascadeDelete Text
    this of
                                Just CascadeAction
    cascDel ->
                                    case Maybe CascadeAction
    mdel of
                                        Maybe CascadeAction
    Nothing ->
                                            [Text]
    -> Maybe CascadeAction
    -> Maybe CascadeAction
    -> [Text]
    -> (FieldCascade, [Text])
    go [Text]
    acc Maybe CascadeAction
    mupd (CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    cascDel) [Text]
    rest
                                        Just CascadeAction
    _ ->
                                            [Char] -> (FieldCascade, [Text])
    nope [Char]
    "found more than one OnDelete action"
                                Maybe CascadeAction
    Nothing ->
                                    [Text]
    -> Maybe CascadeAction
    -> Maybe CascadeAction
    -> [Text]
    -> (FieldCascade, [Text])
    go (Text
    this Text -> [Text] -> [Text]
    forall a. a -> [a] -> [a]
    : [Text]
    acc) Maybe CascadeAction
    mupd Maybe CascadeAction
    mdel [Text]
    rest
        nope :: [Char] -> (FieldCascade, [Text])
    nope [Char]
    msg =
            [Char] -> (FieldCascade, [Text])
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> (FieldCascade, [Text]))
    -> [Char] -> (FieldCascade, [Text])
    forall a b. (a -> b) -> a -> b
    $ [Char]
    msg [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    ", tokens: " [Char] -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> [Char]
    forall a. Show a => a -> [Char]
    show [Text]
    allTokens

    parseCascadeAction
        :: CascadePrefix
        -> Text
        -> Maybe CascadeAction
    parseCascadeAction :: CascadePrefix -> Text -> Maybe CascadeAction
    parseCascadeAction CascadePrefix
    prfx Text
    text = do
        cascadeStr <- Text -> Text -> Maybe Text
    T.stripPrefix (Text
    "On" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> CascadePrefix -> Text
    forall {a}. IsString a => CascadePrefix -> a
    toPrefix CascadePrefix
    prfx) Text
    text
        readMaybe cascadeStr
      where
        toPrefix :: CascadePrefix -> a
    toPrefix CascadePrefix
    cp =
            case CascadePrefix
    cp of
                CascadePrefix
    CascadeUpdate -> a
    "Update"
                CascadePrefix
    CascadeDelete -> a
    "Delete"

    takeDerives :: [Text] -> Maybe [Text]
    takeDerives :: [Text] -> Maybe [Text]
    takeDerives (Text
    "deriving" : [Text]
    rest) = [Text] -> Maybe [Text]
    forall a. a -> Maybe a
    Just [Text]
    rest
    takeDerives [Text]
    _ = Maybe [Text]
    forall a. Maybe a
    Nothing

    -- | Returns 'True' if the 'UnboundFieldDef' does not have a 'MigrationOnly' or
    -- 'SafeToRemove' flag from the QuasiQuoter.
    --
    -- @since 2.13.0.0
    isHaskellUnboundField :: UnboundFieldDef -> Bool
    isHaskellUnboundField :: UnboundFieldDef -> Bool
    isHaskellUnboundField UnboundFieldDef
    fd =
        FieldAttr
    FieldAttrMigrationOnly FieldAttr -> [FieldAttr] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` UnboundFieldDef -> [FieldAttr]
    unboundFieldAttrs UnboundFieldDef
    fd
            Bool -> Bool -> Bool
    && FieldAttr
    FieldAttrSafeToRemove FieldAttr -> [FieldAttr] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` UnboundFieldDef -> [FieldAttr]
    unboundFieldAttrs UnboundFieldDef
    fd

    -- |  Return the 'EntityNameHS' for an 'UnboundEntityDef'.
    --
    -- @since 2.13.0.0
    getUnboundEntityNameHS :: UnboundEntityDef -> EntityNameHS
    getUnboundEntityNameHS :: UnboundEntityDef -> EntityNameHS
    getUnboundEntityNameHS = EntityDef -> EntityNameHS
    entityHaskell (EntityDef -> EntityNameHS)
    -> (UnboundEntityDef -> EntityDef)
    -> UnboundEntityDef
    -> EntityNameHS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnboundEntityDef -> EntityDef
    unboundEntityDef

    readMaybe :: (Read a) => Text -> Maybe a
    readMaybe :: forall a. Read a => Text -> Maybe a
    readMaybe = [Char] -> Maybe a
    forall a. Read a => [Char] -> Maybe a
    R.readMaybe ([Char] -> Maybe a) -> (Text -> [Char]) -> Text -> Maybe a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> [Char]
    T.unpack