    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TupleSections #-}

    -- | Intended for creating new backends.
    module Database.Persist.Sql.Internal
        ( mkColumns
        , defaultAttribute
        , BackendSpecificOverrides(..)
        , getBackendSpecificForeignKeyName
        , setBackendSpecificForeignKeyName
        , emptyBackendSpecificOverrides
        ) where

    import Control.Applicative ((<|>))
    import Data.Monoid (mappend, mconcat)
    import Data.Text (Text)
    import qualified Data.Text as T

    import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
    import Database.Persist.EntityDef
    import Database.Persist.Sql.Types
    import Database.Persist.Types

    -- | Record of functions to override the default behavior in 'mkColumns'.  It is
    -- recommended you initialize this with 'emptyBackendSpecificOverrides' and
    -- override the default values, so that as new fields are added, your code still
    -- compiles.
    --
    -- For added safety, use the @getBackendSpecific*@ and @setBackendSpecific*@
    -- functions, as a breaking change to the record field labels won't be reflected
    -- in a major version bump of the library.
    --
    -- @since 2.11
    data BackendSpecificOverrides = BackendSpecificOverrides
        { BackendSpecificOverrides
    -> Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    backendSpecificForeignKeyName :: Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
        }

    -- | If the override is defined, then this returns a function that accepts an
    -- entity name and field name and provides the 'ConstraintNameDB' for the
    -- foreign key constraint.
    --
    -- An abstract accessor for the 'BackendSpecificOverrides'
    --
    -- @since 2.13.0.0
    getBackendSpecificForeignKeyName
        :: BackendSpecificOverrides
        -> Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    getBackendSpecificForeignKeyName :: BackendSpecificOverrides
    -> Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    getBackendSpecificForeignKeyName =
        BackendSpecificOverrides
    -> Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    backendSpecificForeignKeyName

    -- | Set the backend's foreign key generation function to this value.
    --
    -- @since 2.13.0.0
    setBackendSpecificForeignKeyName
        :: (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
        -> BackendSpecificOverrides
        -> BackendSpecificOverrides
    setBackendSpecificForeignKeyName :: (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    -> BackendSpecificOverrides -> BackendSpecificOverrides
    setBackendSpecificForeignKeyName EntityNameDB -> FieldNameDB -> ConstraintNameDB
    func BackendSpecificOverrides
    bso =
        BackendSpecificOverrides
    bso { backendSpecificForeignKeyName = Just func }

    findMaybe :: (a -> Maybe b) -> [a] -> Maybe b
    findMaybe :: forall a b. (a -> Maybe b) -> [a] -> Maybe b
    findMaybe a -> Maybe b
    p = [b] -> Maybe b
    forall a. [a] -> Maybe a
    listToMaybe ([b] -> Maybe b) -> ([a] -> [b]) -> [a] -> Maybe b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Maybe b) -> [a] -> [b]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe a -> Maybe b
    p

    -- | Creates an empty 'BackendSpecificOverrides' (i.e. use the default behavior; no overrides)
    --
    -- @since 2.11
    emptyBackendSpecificOverrides :: BackendSpecificOverrides
    emptyBackendSpecificOverrides :: BackendSpecificOverrides
    emptyBackendSpecificOverrides = Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    -> BackendSpecificOverrides
    BackendSpecificOverrides Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    forall a. Maybe a
    Nothing

    defaultAttribute :: [FieldAttr] -> Maybe Text
    defaultAttribute :: [FieldAttr] -> Maybe Text
    defaultAttribute = (FieldAttr -> Maybe Text) -> [FieldAttr] -> Maybe Text
    forall a b. (a -> Maybe b) -> [a] -> Maybe b
    findMaybe ((FieldAttr -> Maybe Text) -> [FieldAttr] -> Maybe Text)
    -> (FieldAttr -> Maybe Text) -> [FieldAttr] -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ \case
        FieldAttrDefault Text
    x -> Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    x
        FieldAttr
    _ -> Maybe Text
    forall a. Maybe a
    Nothing

    -- | Create the list of columns for the given entity.
    mkColumns
        :: [EntityDef]
        -> EntityDef
        -> BackendSpecificOverrides
        -> ([Column], [UniqueDef], [ForeignDef])
    mkColumns :: [EntityDef]
    -> EntityDef
    -> BackendSpecificOverrides
    -> ([Column], [UniqueDef], [ForeignDef])
    mkColumns [EntityDef]
    allDefs EntityDef
    t BackendSpecificOverrides
    overrides =
        ([Column]
    cols, EntityDef -> [UniqueDef]
    getEntityUniquesNoPrimaryKey EntityDef
    t, EntityDef -> [ForeignDef]
    getEntityForeignDefs EntityDef
    t)
      where
        cols :: [Column]
        cols :: [Column]
    cols = (FieldDef -> Column) -> [FieldDef] -> [Column]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldDef -> Column
    goId [FieldDef]
    idCol [Column] -> [Column] -> [Column]
    forall a. Monoid a => a -> a -> a
    `mappend` (FieldDef -> Column) -> [FieldDef] -> [Column]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldDef -> Column
    go (EntityDef -> [FieldDef]
    getEntityFieldsDatabase EntityDef
    t)

        idCol :: [FieldDef]
        idCol :: [FieldDef]
    idCol =
            case EntityDef -> EntityIdDef
    getEntityId EntityDef
    t of
                EntityIdNaturalKey CompositeDef
    _ ->
                    []
                EntityIdField FieldDef
    fd ->
                    [FieldDef
    fd]

        goId :: FieldDef -> Column
        goId :: FieldDef -> Column
    goId FieldDef
    fd =
            Column
                { cName :: FieldNameDB
    cName = FieldDef -> FieldNameDB
    fieldDB FieldDef
    fd
                , cNull :: Bool
    cNull = Bool
    False
                , cSqlType :: SqlType
    cSqlType = FieldDef -> SqlType
    fieldSqlType FieldDef
    fd
                , cDefault :: Maybe Text
    cDefault =
                    case [FieldAttr] -> Maybe Text
    defaultAttribute ([FieldAttr] -> Maybe Text) -> [FieldAttr] -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd of
                        Maybe Text
    Nothing ->
                            -- So this is not necessarily a problem...
                            -- because you can use eg `inserKey` to insert
                            -- a value into the database without ever asking
                            -- for a default attribute.
                            Maybe Text
    forall a. Maybe a
    Nothing
                            -- But we need to be able to say "Hey, if this is
                            -- an *auto generated ID column*, then I need to
                            -- specify that it has the default serial picking
                            -- behavior for whatever SQL backend this is using.
                            -- Because naturally MySQL, Postgres, MSSQL, etc
                            -- all do ths differently, sigh.
                            -- Really, this should be something like,
                            --
                            -- > data ColumnDefault
                            -- >     = Custom Text
                            -- >     | AutogenerateId
                            -- >     | NoDefault
                            --
                            -- where Autogenerated is determined by the
                            -- MkPersistSettings.
                        Just Text
    def ->
                            Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    def

                , cGenerated :: Maybe Text
    cGenerated = FieldDef -> Maybe Text
    fieldGenerated FieldDef
    fd
                , cDefaultConstraintName :: Maybe ConstraintNameDB
    cDefaultConstraintName =  Maybe ConstraintNameDB
    forall a. Maybe a
    Nothing
                , cMaxLen :: Maybe Integer
    cMaxLen = [FieldAttr] -> Maybe Integer
    maxLen ([FieldAttr] -> Maybe Integer) -> [FieldAttr] -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd
                , cReference :: Maybe ColumnReference
    cReference = FieldDef -> Maybe ColumnReference
    mkColumnReference FieldDef
    fd
                }

        tableName :: EntityNameDB
        tableName :: EntityNameDB
    tableName = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    t

        go :: FieldDef -> Column
        go :: FieldDef -> Column
    go FieldDef
    fd =
            Column
                { cName :: FieldNameDB
    cName = FieldDef -> FieldNameDB
    fieldDB FieldDef
    fd
                , cNull :: Bool
    cNull =
                    case FieldDef -> IsNullable
    isFieldNullable FieldDef
    fd of
                        Nullable WhyNullable
    _ -> Bool
    True
                        IsNullable
    NotNullable -> FieldDef -> Bool
    isFieldMaybe FieldDef
    fd Bool -> Bool -> Bool
    || EntityDef -> Bool
    isEntitySum EntityDef
    t
                , cSqlType :: SqlType
    cSqlType = FieldDef -> SqlType
    fieldSqlType FieldDef
    fd
                , cDefault :: Maybe Text
    cDefault = [FieldAttr] -> Maybe Text
    defaultAttribute ([FieldAttr] -> Maybe Text) -> [FieldAttr] -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd
                , cGenerated :: Maybe Text
    cGenerated = FieldDef -> Maybe Text
    fieldGenerated FieldDef
    fd
                , cDefaultConstraintName :: Maybe ConstraintNameDB
    cDefaultConstraintName =  Maybe ConstraintNameDB
    forall a. Maybe a
    Nothing
                , cMaxLen :: Maybe Integer
    cMaxLen = [FieldAttr] -> Maybe Integer
    maxLen ([FieldAttr] -> Maybe Integer) -> [FieldAttr] -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd
                , cReference :: Maybe ColumnReference
    cReference = FieldDef -> Maybe ColumnReference
    mkColumnReference FieldDef
    fd
                }

        maxLen :: [FieldAttr] -> Maybe Integer
        maxLen :: [FieldAttr] -> Maybe Integer
    maxLen = (FieldAttr -> Maybe Integer) -> [FieldAttr] -> Maybe Integer
    forall a b. (a -> Maybe b) -> [a] -> Maybe b
    findMaybe ((FieldAttr -> Maybe Integer) -> [FieldAttr] -> Maybe Integer)
    -> (FieldAttr -> Maybe Integer) -> [FieldAttr] -> Maybe Integer
    forall a b. (a -> b) -> a -> b
    $ \case
            FieldAttrMaxlen Integer
    n -> Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    n
            FieldAttr
    _ -> Maybe Integer
    forall a. Maybe a
    Nothing

        refNameFn :: EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refNameFn = (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    -> Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    -> EntityNameDB
    -> FieldNameDB
    -> ConstraintNameDB
    forall a. a -> Maybe a -> a
    fromMaybe EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refName (BackendSpecificOverrides
    -> Maybe (EntityNameDB -> FieldNameDB -> ConstraintNameDB)
    backendSpecificForeignKeyName BackendSpecificOverrides
    overrides)

        mkColumnReference :: FieldDef -> Maybe ColumnReference
        mkColumnReference :: FieldDef -> Maybe ColumnReference
    mkColumnReference FieldDef
    fd =
            ((EntityNameDB, ConstraintNameDB) -> ColumnReference)
    -> Maybe (EntityNameDB, ConstraintNameDB) -> Maybe ColumnReference
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap
                (\(EntityNameDB
    tName, ConstraintNameDB
    cName) ->
                    EntityNameDB -> ConstraintNameDB -> FieldCascade -> ColumnReference
    ColumnReference EntityNameDB
    tName ConstraintNameDB
    cName (FieldCascade -> ColumnReference)
    -> FieldCascade -> ColumnReference
    forall a b. (a -> b) -> a -> b
    $ FieldCascade -> FieldCascade
    overrideNothings (FieldCascade -> FieldCascade) -> FieldCascade -> FieldCascade
    forall a b. (a -> b) -> a -> b
    $ FieldDef -> FieldCascade
    fieldCascade FieldDef
    fd
                )
            (Maybe (EntityNameDB, ConstraintNameDB) -> Maybe ColumnReference)
    -> Maybe (EntityNameDB, ConstraintNameDB) -> Maybe ColumnReference
    forall a b. (a -> b) -> a -> b
    $ FieldNameDB
    -> ReferenceDef
    -> [FieldAttr]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    ref (FieldDef -> FieldNameDB
    fieldDB FieldDef
    fd) (FieldDef -> ReferenceDef
    fieldReference FieldDef
    fd) (FieldDef -> [FieldAttr]
    fieldAttrs FieldDef
    fd)

        -- a 'Nothing' in the definition means that the QQ migration doesn't
        -- specify behavior. the default is RESTRICT. setting this here
        -- explicitly makes migrations run smoother.
        overrideNothings :: FieldCascade -> FieldCascade
    overrideNothings (FieldCascade { fcOnUpdate :: FieldCascade -> Maybe CascadeAction
    fcOnUpdate = Maybe CascadeAction
    upd, fcOnDelete :: FieldCascade -> Maybe CascadeAction
    fcOnDelete = Maybe CascadeAction
    del }) =
            FieldCascade
                { fcOnUpdate :: Maybe CascadeAction
    fcOnUpdate = Maybe CascadeAction
    upd Maybe CascadeAction -> Maybe CascadeAction -> Maybe CascadeAction
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    Restrict
                , fcOnDelete :: Maybe CascadeAction
    fcOnDelete = Maybe CascadeAction
    del Maybe CascadeAction -> Maybe CascadeAction -> Maybe CascadeAction
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> CascadeAction -> Maybe CascadeAction
    forall a. a -> Maybe a
    Just CascadeAction
    Restrict
                }

        ref :: FieldNameDB
            -> ReferenceDef
            -> [FieldAttr]
            -> Maybe (EntityNameDB, ConstraintNameDB) -- table name, constraint name
        ref :: FieldNameDB
    -> ReferenceDef
    -> [FieldAttr]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    ref FieldNameDB
    c ReferenceDef
    fe []
            | ForeignRef EntityNameHS
    f <- ReferenceDef
    fe =
                (EntityNameDB, ConstraintNameDB)
    -> Maybe (EntityNameDB, ConstraintNameDB)
    forall a. a -> Maybe a
    Just ([EntityDef] -> EntityNameHS -> EntityNameDB
    resolveTableName [EntityDef]
    allDefs EntityNameHS
    f, EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refNameFn EntityNameDB
    tableName FieldNameDB
    c)
            | Bool
    otherwise = Maybe (EntityNameDB, ConstraintNameDB)
    forall a. Maybe a
    Nothing
        ref FieldNameDB
    _ ReferenceDef
    _ (FieldAttr
    FieldAttrNoreference:[FieldAttr]
    _) = Maybe (EntityNameDB, ConstraintNameDB)
    forall a. Maybe a
    Nothing
        ref FieldNameDB
    c ReferenceDef
    fe (FieldAttr
    a:[FieldAttr]
    as) = case FieldAttr
    a of
            FieldAttrReference Text
    x -> do
                (_, constraintName) <- FieldNameDB
    -> ReferenceDef
    -> [FieldAttr]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    ref FieldNameDB
    c ReferenceDef
    fe [FieldAttr]
    as
                pure (EntityNameDB  x, constraintName)
            FieldAttrConstraint Text
    x -> do
                (tableName_, _) <- FieldNameDB
    -> ReferenceDef
    -> [FieldAttr]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    ref FieldNameDB
    c ReferenceDef
    fe [FieldAttr]
    as
                pure (tableName_, ConstraintNameDB x)
            FieldAttr
    _ -> FieldNameDB
    -> ReferenceDef
    -> [FieldAttr]
    -> Maybe (EntityNameDB, ConstraintNameDB)
    ref FieldNameDB
    c ReferenceDef
    fe [FieldAttr]
    as

    refName :: EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refName :: EntityNameDB -> FieldNameDB -> ConstraintNameDB
    refName (EntityNameDB Text
    table) (FieldNameDB Text
    column) =
        Text -> ConstraintNameDB
    ConstraintNameDB (Text -> ConstraintNameDB) -> Text -> ConstraintNameDB
    forall a b. (a -> b) -> a -> b
    $ [Text] -> Text
    forall a. Monoid a => [a] -> a
    Data.Monoid.mconcat [Text
    table, Text
    "_", Text
    column, Text
    "_fkey"]

    resolveTableName :: [EntityDef] -> EntityNameHS -> EntityNameDB
    resolveTableName :: [EntityDef] -> EntityNameHS -> EntityNameDB
    resolveTableName [] (EntityNameHS Text
    t) = [Char] -> EntityNameDB
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> EntityNameDB) -> [Char] -> EntityNameDB
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Table not found: " [Char] -> [Char] -> [Char]
    forall a. Monoid a => a -> a -> a
    `Data.Monoid.mappend` Text -> [Char]
    T.unpack Text
    t
    resolveTableName (EntityDef
    e:[EntityDef]
    es) EntityNameHS
    hn
        | EntityDef -> EntityNameHS
    getEntityHaskellName EntityDef
    e EntityNameHS -> EntityNameHS -> Bool
    forall a. Eq a => a -> a -> Bool
    == EntityNameHS
    hn = EntityDef -> EntityNameDB
    getEntityDBName EntityDef
    e
        | Bool
    otherwise = [EntityDef] -> EntityNameHS -> EntityNameDB
    resolveTableName [EntityDef]
    es EntityNameHS
    hn