    module Database.Persist.Quasi.PersistSettings.Internal where

    import Data.Char (isDigit, isLower, isSpace, isUpper, toLower)
    import Data.List.NonEmpty (NonEmpty (..))
    import Data.Text (Text)
    import qualified Data.Text as T
    import Data.Void (Void)
    import Database.Persist.Names
    import Database.Persist.Types
    import Text.Megaparsec
        ( ParseError
        , ParseErrorBundle (..)
        , PosState
        , SourcePos
        , errorBundlePretty
        , pstateSourcePos
        )

    data PersistSettings = PersistSettings
        { PersistSettings -> Text -> Text
    psToDBName :: !(Text -> Text)
        -- ^ Modify the Haskell-style name into a database-style name.
        , PersistSettings -> EntityNameHS -> ConstraintNameHS -> Text
    psToFKName :: !(EntityNameHS -> ConstraintNameHS -> Text)
        -- ^ A function for generating the constraint name, with access to
        -- the entity and constraint names. Default value: @mappend@
        --
        -- @since 2.13.0.0
        , PersistSettings -> Bool
    psStrictFields :: !Bool
        -- ^ Whether fields are by default strict. Default value: @True@.
        --
        -- @since 1.2
        , PersistSettings -> Text
    psIdName :: !Text
        -- ^ The name of the id column. Default value: @id@
        -- The name of the id column can also be changed on a per-model basis
        -- <https://github.com/yesodweb/persistent/wiki/Persistent-entity-syntax>
        --
        -- @since 2.0
        , PersistSettings -> Maybe ParserErrorLevel
    psTabErrorLevel :: Maybe ParserErrorLevel
        -- ^ Whether and with what severity to disallow tabs in entity source text.
        --
        -- @since 2.16.0.0
        , PersistSettings -> Maybe ParserErrorLevel
    psQuotedArgumentErrorLevel :: Maybe ParserErrorLevel
        -- ^ Whether and with what severity to disallow quoted entity field attributes
        -- and quoted directive arguments.
        --
        -- @since 2.17.1.0
        }

    defaultPersistSettings, upperCaseSettings, lowerCaseSettings :: PersistSettings
    defaultPersistSettings :: PersistSettings
    defaultPersistSettings =
        PersistSettings
            { psToDBName :: Text -> Text
    psToDBName = Text -> Text
    forall a. a -> a
    id
            , psToFKName :: EntityNameHS -> ConstraintNameHS -> Text
    psToFKName = \(EntityNameHS Text
    entName) (ConstraintNameHS Text
    conName) -> Text
    entName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    conName
            , psStrictFields :: Bool
    psStrictFields = Bool
    True
            , psIdName :: Text
    psIdName = Text
    "id"
            , psTabErrorLevel :: Maybe ParserErrorLevel
    psTabErrorLevel = ParserErrorLevel -> Maybe ParserErrorLevel
    forall a. a -> Maybe a
    Just ParserErrorLevel
    LevelWarning
            , psQuotedArgumentErrorLevel :: Maybe ParserErrorLevel
    psQuotedArgumentErrorLevel = ParserErrorLevel -> Maybe ParserErrorLevel
    forall a. a -> Maybe a
    Just ParserErrorLevel
    LevelWarning
            }
    upperCaseSettings :: PersistSettings
    upperCaseSettings = PersistSettings
    defaultPersistSettings
    lowerCaseSettings :: PersistSettings
    lowerCaseSettings =
        PersistSettings
    defaultPersistSettings
            { psToDBName =
                let
                    go Char
    c
                        | Char -> Bool
    isUpper Char
    c = String -> Text
    T.pack [Char
    '_', Char -> Char
    toLower Char
    c]
                        | Bool
    otherwise = Char -> Text
    T.singleton Char
    c
                 in
                    T.dropWhile (== '_') . T.concatMap go
            }

    -- |
    --
    -- @since 2.16.0.0
    data ParserErrorLevel = LevelError | LevelWarning deriving (ParserErrorLevel -> ParserErrorLevel -> Bool
    (ParserErrorLevel -> ParserErrorLevel -> Bool)
    -> (ParserErrorLevel -> ParserErrorLevel -> Bool)
    -> Eq ParserErrorLevel
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ParserErrorLevel -> ParserErrorLevel -> Bool
    == :: ParserErrorLevel -> ParserErrorLevel -> Bool
    $c/= :: ParserErrorLevel -> ParserErrorLevel -> Bool
    /= :: ParserErrorLevel -> ParserErrorLevel -> Bool
    Eq, Int -> ParserErrorLevel -> ShowS
    [ParserErrorLevel] -> ShowS
    ParserErrorLevel -> String
    (Int -> ParserErrorLevel -> ShowS)
    -> (ParserErrorLevel -> String)
    -> ([ParserErrorLevel] -> ShowS)
    -> Show ParserErrorLevel
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParserErrorLevel -> ShowS
    showsPrec :: Int -> ParserErrorLevel -> ShowS
    $cshow :: ParserErrorLevel -> String
    show :: ParserErrorLevel -> String
    $cshowList :: [ParserErrorLevel] -> ShowS
    showList :: [ParserErrorLevel] -> ShowS
    Show)

    -- |
    --
    -- @since 2.16.0.0
    data ParserWarning = ParserWarning
        { ParserWarning -> String
    parserWarningExtraMessage :: String
        , ParserWarning -> ParseError String Void
    parserWarningUnderlyingError :: ParseError String Void
        , ParserWarning -> PosState String
    parserWarningPosState :: PosState String
        }
        deriving (ParserWarning -> ParserWarning -> Bool
    (ParserWarning -> ParserWarning -> Bool)
    -> (ParserWarning -> ParserWarning -> Bool) -> Eq ParserWarning
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ParserWarning -> ParserWarning -> Bool
    == :: ParserWarning -> ParserWarning -> Bool
    $c/= :: ParserWarning -> ParserWarning -> Bool
    /= :: ParserWarning -> ParserWarning -> Bool
    Eq, Int -> ParserWarning -> ShowS
    [ParserWarning] -> ShowS
    ParserWarning -> String
    (Int -> ParserWarning -> ShowS)
    -> (ParserWarning -> String)
    -> ([ParserWarning] -> ShowS)
    -> Show ParserWarning
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParserWarning -> ShowS
    showsPrec :: Int -> ParserWarning -> ShowS
    $cshow :: ParserWarning -> String
    show :: ParserWarning -> String
    $cshowList :: [ParserWarning] -> ShowS
    showList :: [ParserWarning] -> ShowS
    Show)

    warningPos :: ParserWarning -> SourcePos
    warningPos :: ParserWarning -> SourcePos
    warningPos = PosState String -> SourcePos
    forall s. PosState s -> SourcePos
    pstateSourcePos (PosState String -> SourcePos)
    -> (ParserWarning -> PosState String) -> ParserWarning -> SourcePos
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParserWarning -> PosState String
    parserWarningPosState

    instance Ord ParserWarning where
        ParserWarning
    l <= :: ParserWarning -> ParserWarning -> Bool
    <= ParserWarning
    r =
            if ParserWarning -> SourcePos
    warningPos ParserWarning
    l SourcePos -> SourcePos -> Bool
    forall a. Eq a => a -> a -> Bool
    == ParserWarning -> SourcePos
    warningPos ParserWarning
    r
                then ParserWarning -> String
    parserWarningMessage ParserWarning
    l String -> String -> Bool
    forall a. Ord a => a -> a -> Bool
    <= ParserWarning -> String
    parserWarningMessage ParserWarning
    r
                else ParserWarning -> SourcePos
    warningPos ParserWarning
    l SourcePos -> SourcePos -> Bool
    forall a. Ord a => a -> a -> Bool
    <= ParserWarning -> SourcePos
    warningPos ParserWarning
    r

    -- | Uses @errorBundlePretty@ to render a parser warning.
    --
    -- @since 2.16.0.0
    parserWarningMessage :: ParserWarning -> String
    parserWarningMessage :: ParserWarning -> String
    parserWarningMessage ParserWarning
    pw =
        ParserWarning -> String
    parserWarningExtraMessage ParserWarning
    pw
            String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ( ParseErrorBundle String Void -> String
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> String
    errorBundlePretty (ParseErrorBundle String Void -> String)
    -> ParseErrorBundle String Void -> String
    forall a b. (a -> b) -> a -> b
    $
                    ParseErrorBundle
                        { bundleErrors :: NonEmpty (ParseError String Void)
    bundleErrors = ParserWarning -> ParseError String Void
    parserWarningUnderlyingError ParserWarning
    pw ParseError String Void
    -> [ParseError String Void] -> NonEmpty (ParseError String Void)
    forall a. a -> [a] -> NonEmpty a
    :| []
                        , bundlePosState :: PosState String
    bundlePosState = ParserWarning -> PosState String
    parserWarningPosState ParserWarning
    pw
                        }
               )

    toFKNameInfixed :: Text -> EntityNameHS -> ConstraintNameHS -> Text
    toFKNameInfixed :: Text -> EntityNameHS -> ConstraintNameHS -> Text
    toFKNameInfixed Text
    inf (EntityNameHS Text
    entName) (ConstraintNameHS Text
    conName) =
        Text
    entName Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    inf Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    conName

    -- | Retrieve the function in the 'PersistSettings' that modifies the names into
    -- database names.
    --
    -- @since 2.13.0.0
    getPsToDBName :: PersistSettings -> Text -> Text
    getPsToDBName :: PersistSettings -> Text -> Text
    getPsToDBName = PersistSettings -> Text -> Text
    psToDBName

    -- | Set the name modification function that translates the QuasiQuoted names
    -- for use in the database.
    --
    -- @since 2.13.0.0
    setPsToDBName :: (Text -> Text) -> PersistSettings -> PersistSettings
    setPsToDBName :: (Text -> Text) -> PersistSettings -> PersistSettings
    setPsToDBName Text -> Text
    f PersistSettings
    ps = PersistSettings
    ps{psToDBName = f}

    -- | Set a custom function used to create the constraint name
    -- for a foreign key.
    --
    -- @since 2.13.0.0
    setPsToFKName
        :: (EntityNameHS -> ConstraintNameHS -> Text) -> PersistSettings -> PersistSettings
    setPsToFKName :: (EntityNameHS -> ConstraintNameHS -> Text)
    -> PersistSettings -> PersistSettings
    setPsToFKName EntityNameHS -> ConstraintNameHS -> Text
    setter PersistSettings
    ps = PersistSettings
    ps{psToFKName = setter}

    -- | A preset configuration function that puts an underscore
    -- between the entity name and the constraint name when
    -- creating a foreign key constraint name
    --
    -- @since 2.14.2.0
    setPsUseSnakeCaseForeignKeys :: PersistSettings -> PersistSettings
    setPsUseSnakeCaseForeignKeys :: PersistSettings -> PersistSettings
    setPsUseSnakeCaseForeignKeys = (EntityNameHS -> ConstraintNameHS -> Text)
    -> PersistSettings -> PersistSettings
    setPsToFKName (Text -> EntityNameHS -> ConstraintNameHS -> Text
    toFKNameInfixed Text
    "_")

    -- | Equivalent to 'setPsUseSnakeCaseForeignKeys', but misspelled.
    --
    -- @since 2.13.0.0
    setPsUseSnakeCaseForiegnKeys :: PersistSettings -> PersistSettings
    setPsUseSnakeCaseForiegnKeys :: PersistSettings -> PersistSettings
    setPsUseSnakeCaseForiegnKeys = PersistSettings -> PersistSettings
    setPsUseSnakeCaseForeignKeys
    {-# DEPRECATED
        setPsUseSnakeCaseForiegnKeys
        "use the correctly spelled, equivalent, setPsUseSnakeCaseForeignKeys instead"
        #-}

    -- | Retrieve whether or not the 'PersistSettings' will generate code with
    -- strict fields.
    --
    -- @since 2.13.0.0
    getPsStrictFields :: PersistSettings -> Bool
    getPsStrictFields :: PersistSettings -> Bool
    getPsStrictFields = PersistSettings -> Bool
    psStrictFields

    -- | Set whether or not the 'PersistSettings' will make fields strict.
    --
    -- @since 2.13.0.0
    setPsStrictFields :: Bool -> PersistSettings -> PersistSettings
    setPsStrictFields :: Bool -> PersistSettings -> PersistSettings
    setPsStrictFields Bool
    a PersistSettings
    ps = PersistSettings
    ps{psStrictFields = a}

    -- | Retrieve the default name of the @id@ column.
    --
    -- @since 2.13.0.0
    getPsIdName :: PersistSettings -> Text
    getPsIdName :: PersistSettings -> Text
    getPsIdName = PersistSettings -> Text
    psIdName

    -- | Set the default name of the @id@ column.
    --
    -- @since 2.13.0.0
    setPsIdName :: Text -> PersistSettings -> PersistSettings
    setPsIdName :: Text -> PersistSettings -> PersistSettings
    setPsIdName Text
    n PersistSettings
    ps = PersistSettings
    ps{psIdName = n}

    -- | Retrieve the severity of the error generated when the parser encounters a tab.
    -- If it is @Nothing@, tabs are permitted in entity definitions.
    --
    -- @since 2.16.0.0
    getPsTabErrorLevel :: PersistSettings -> Maybe ParserErrorLevel
    getPsTabErrorLevel :: PersistSettings -> Maybe ParserErrorLevel
    getPsTabErrorLevel = PersistSettings -> Maybe ParserErrorLevel
    psTabErrorLevel

    -- | Set the severity of the error generated when the parser encounters a tab.
    -- If set to @Nothing@, tabs are permitted in entity definitions.
    --
    -- @since 2.16.0.0
    setPsTabErrorLevel
        :: Maybe ParserErrorLevel -> PersistSettings -> PersistSettings
    setPsTabErrorLevel :: Maybe ParserErrorLevel -> PersistSettings -> PersistSettings
    setPsTabErrorLevel Maybe ParserErrorLevel
    l PersistSettings
    ps = PersistSettings
    ps{psTabErrorLevel = l}

    -- | Retrieve the severity of the error generated when the parser encounters a
    -- quoted entity field attribute or quoted directive argument.
    -- If it is @Nothing@, quoted arguments are permitted in both entity field
    -- definitions and directives.
    --
    -- @since 2.17.1.0
    getPsQuotedArgumentErrorLevel :: PersistSettings -> Maybe ParserErrorLevel
    getPsQuotedArgumentErrorLevel :: PersistSettings -> Maybe ParserErrorLevel
    getPsQuotedArgumentErrorLevel = PersistSettings -> Maybe ParserErrorLevel
    psQuotedArgumentErrorLevel

    -- | Set the severity of the error generated when the parser encounters a
    -- quoted entity field attribute.
    -- If set to @Nothing@, quoted arguments are permitted in both entity field
    -- definitions and directives.
    --
    -- @since 2.17.1.0
    setPsQuotedArgumentErrorLevel
        :: Maybe ParserErrorLevel -> PersistSettings -> PersistSettings
    setPsQuotedArgumentErrorLevel :: Maybe ParserErrorLevel -> PersistSettings -> PersistSettings
    setPsQuotedArgumentErrorLevel Maybe ParserErrorLevel
    l PersistSettings
    ps = PersistSettings
    ps{psQuotedArgumentErrorLevel = l}