    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveLift #-}
    {-# LANGUAGE DerivingStrategies #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TupleSections #-}

    module Database.Persist.Quasi.Internal.ModelParser
        ( SourceLoc (..)
        , Attribute (..)
        , attribute
        , attributeContent
        , Directive (..)
        , directiveContent
        , EntityField (..)
        , entityField
        , entityFieldContent
        , FieldName (..)
        , fieldName
        , ParsedEntityDef (..)
        , parseSource
        , memberEntityFields
        , ParserWarning
        , parserWarningMessage
        , ParseResult
        , CumulativeParseResult
        , toCumulativeParseResult
        , renderErrors
        , runConfiguredParser
        , ParserErrorLevel (..)
        , initialExtraState
        ) where

    import Control.Applicative (Alternative)
    import Control.Monad (MonadPlus, void)
    import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT)
    import Control.Monad.State
    import Control.Monad.Writer
    import Data.Char (isSpace)
    import Data.Either (partitionEithers)
    import Data.Foldable (fold)
    import Data.Functor.Identity
    import Data.List (intercalate)
    import Data.List.NonEmpty (NonEmpty (..))
    import qualified Data.List.NonEmpty as NEL
    import qualified Data.Map as M
    import Data.Maybe
    import Data.Set (Set)
    import qualified Data.Set as Set
    import Data.Text (Text)
    import qualified Data.Text as Text
    import Data.Void
    import Database.Persist.Quasi.Internal.TypeParser
    import Database.Persist.Quasi.PersistSettings.Internal
    import Database.Persist.Types
    import Database.Persist.Types.SourceSpan
    import Language.Haskell.TH.Syntax (Lift)
    import Text.Megaparsec
    import Text.Megaparsec.Char
    import qualified Text.Megaparsec.Char.Lexer as L
    import qualified Text.Megaparsec.Stream as TMS

    -- We'll augment the parser with extra state to accumulate comments seen during parsing.
    -- Comments are lexed as whitespace, but will be used to generate documentation later.
    data ExtraState = ExtraState
        { ExtraState -> [(SourcePos, CommentToken)]
    esPositionedCommentTokens :: [(SourcePos, CommentToken)]
        , ExtraState -> Maybe SourcePos
    esLastDocumentablePosition :: Maybe SourcePos
        }

    -- @since 2.16.0.0
    initialExtraState :: ExtraState
    initialExtraState :: ExtraState
    initialExtraState =
        ExtraState
            { esPositionedCommentTokens :: [(SourcePos, CommentToken)]
    esPositionedCommentTokens = []
            , esLastDocumentablePosition :: Maybe SourcePos
    esLastDocumentablePosition = Maybe SourcePos
    forall a. Maybe a
    Nothing
            }

    newtype Parser a = Parser
        { forall a.
    Parser a
    -> ReaderT
         PersistSettings
         (StateT
            ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
         a
    unParser
            :: ReaderT
                PersistSettings
                ( StateT
                    ExtraState
                    ( ParsecT
                        Void
                        String
                        ( Writer
                            (Set ParserWarning)
                        )
                    )
                )
                a
        }
        deriving newtype
            ( (forall a b. (a -> b) -> Parser a -> Parser b)
    -> (forall a b. a -> Parser b -> Parser a) -> Functor Parser
    forall a b. a -> Parser b -> Parser a
    forall a b. (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Parser a -> Parser b
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
    $c<$ :: forall a b. a -> Parser b -> Parser a
    <$ :: forall a b. a -> Parser b -> Parser a
    Functor
            , Functor Parser
    Functor Parser =>
    (forall a. a -> Parser a)
    -> (forall a b. Parser (a -> b) -> Parser a -> Parser b)
    -> (forall a b c.
        (a -> b -> c) -> Parser a -> Parser b -> Parser c)
    -> (forall a b. Parser a -> Parser b -> Parser b)
    -> (forall a b. Parser a -> Parser b -> Parser a)
    -> Applicative Parser
    forall a. a -> Parser a
    forall a b. Parser a -> Parser b -> Parser a
    forall a b. Parser a -> Parser b -> Parser b
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> Parser a
    pure :: forall a. a -> Parser a
    $c<*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
    <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
    $cliftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
    liftA2 :: forall a b c. (a -> b -> c) -> Parser a -> Parser b -> Parser c
    $c*> :: forall a b. Parser a -> Parser b -> Parser b
    *> :: forall a b. Parser a -> Parser b -> Parser b
    $c<* :: forall a b. Parser a -> Parser b -> Parser a
    <* :: forall a b. Parser a -> Parser b -> Parser a
    Applicative
            , Applicative Parser
    Applicative Parser =>
    (forall a b. Parser a -> (a -> Parser b) -> Parser b)
    -> (forall a b. Parser a -> Parser b -> Parser b)
    -> (forall a. a -> Parser a)
    -> Monad Parser
    forall a. a -> Parser a
    forall a b. Parser a -> Parser b -> Parser b
    forall a b. Parser a -> (a -> Parser b) -> Parser b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
    >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
    $c>> :: forall a b. Parser a -> Parser b -> Parser b
    >> :: forall a b. Parser a -> Parser b -> Parser b
    $creturn :: forall a. a -> Parser a
    return :: forall a. a -> Parser a
    Monad
            , Applicative Parser
    Applicative Parser =>
    (forall a. Parser a)
    -> (forall a. Parser a -> Parser a -> Parser a)
    -> (forall a. Parser a -> Parser [a])
    -> (forall a. Parser a -> Parser [a])
    -> Alternative Parser
    forall a. Parser a
    forall a. Parser a -> Parser [a]
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *).
    Applicative f =>
    (forall a. f a)
    -> (forall a. f a -> f a -> f a)
    -> (forall a. f a -> f [a])
    -> (forall a. f a -> f [a])
    -> Alternative f
    $cempty :: forall a. Parser a
    empty :: forall a. Parser a
    $c<|> :: forall a. Parser a -> Parser a -> Parser a
    <|> :: forall a. Parser a -> Parser a -> Parser a
    $csome :: forall a. Parser a -> Parser [a]
    some :: forall a. Parser a -> Parser [a]
    $cmany :: forall a. Parser a -> Parser [a]
    many :: forall a. Parser a -> Parser [a]
    Alternative
            , Monad Parser
    Alternative Parser
    (Alternative Parser, Monad Parser) =>
    (forall a. Parser a)
    -> (forall a. Parser a -> Parser a -> Parser a) -> MonadPlus Parser
    forall a. Parser a
    forall a. Parser a -> Parser a -> Parser a
    forall (m :: * -> *).
    (Alternative m, Monad m) =>
    (forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
    $cmzero :: forall a. Parser a
    mzero :: forall a. Parser a
    $cmplus :: forall a. Parser a -> Parser a -> Parser a
    mplus :: forall a. Parser a -> Parser a -> Parser a
    MonadPlus
            , MonadState ExtraState
            , MonadReader PersistSettings
            , MonadParsec Void String
            , Monad Parser
    Monad Parser => (forall a. String -> Parser a) -> MonadFail Parser
    forall a. String -> Parser a
    forall (m :: * -> *).
    Monad m =>
    (forall a. String -> m a) -> MonadFail m
    $cfail :: forall a. String -> Parser a
    fail :: forall a. String -> Parser a
    MonadFail
            )

    type EntityParseError = ParseErrorBundle String Void

    -- | Result of parsing a single source text.
    --
    -- @since 2.16.0.0
    type ParseResult a =
        (Set ParserWarning, Either (ParseErrorBundle String Void) a)

    type InternalParseResult a = ParseResult (a, ExtraState)

    -- | Cumulative result of parsing multiple source texts.
    --
    -- @since 2.16.0.0
    type CumulativeParseResult a = (Set ParserWarning, Either [EntityParseError] a)

    toCumulativeParseResult
        :: (Monoid a) => [ParseResult a] -> CumulativeParseResult a
    toCumulativeParseResult :: forall a. Monoid a => [ParseResult a] -> CumulativeParseResult a
    toCumulativeParseResult [ParseResult a]
    prs = do
        let
            (Set ParserWarning
    warnings, [Either (ParseErrorBundle String Void) a]
    eithers) = [ParseResult a]
    -> (Set ParserWarning, [Either (ParseErrorBundle String Void) a])
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [ParseResult a]
    prs
        case [Either (ParseErrorBundle String Void) a]
    -> ([ParseErrorBundle String Void], [a])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either (ParseErrorBundle String Void) a]
    eithers of
            ([], [a]
    results) -> (Set ParserWarning
    warnings, a -> Either [ParseErrorBundle String Void] a
    forall a b. b -> Either a b
    Right (a -> Either [ParseErrorBundle String Void] a)
    -> a -> Either [ParseErrorBundle String Void] a
    forall a b. (a -> b) -> a -> b
    $ [a] -> a
    forall m. Monoid m => [m] -> m
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold [a]
    results)
            ([ParseErrorBundle String Void]
    errs, [a]
    _) -> (Set ParserWarning
    warnings, [ParseErrorBundle String Void]
    -> Either [ParseErrorBundle String Void] a
    forall a b. a -> Either a b
    Left [ParseErrorBundle String Void]
    errs)

    -- | Run a parser using provided PersistSettings and ExtraState
    -- @since 2.16.0.0
    runConfiguredParser
        :: PersistSettings
        -> ExtraState
        -> Parser a
        -> String
        -> String
        -> InternalParseResult a
    runConfiguredParser :: forall a.
    PersistSettings
    -> ExtraState
    -> Parser a
    -> String
    -> String
    -> InternalParseResult a
    runConfiguredParser PersistSettings
    ps ExtraState
    acc Parser a
    parser String
    fp String
    s = (Set ParserWarning
    warnings, Either (ParseErrorBundle String Void) (a, ExtraState)
    either)
      where
        sm :: StateT
      ExtraState (ParsecT Void String (Writer (Set ParserWarning))) a
    sm = ReaderT
      PersistSettings
      (StateT
         ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
      a
    -> PersistSettings
    -> StateT
         ExtraState (ParsecT Void String (Writer (Set ParserWarning))) a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT (Parser a
    -> ReaderT
         PersistSettings
         (StateT
            ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
         a
    forall a.
    Parser a
    -> ReaderT
         PersistSettings
         (StateT
            ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
         a
    unParser Parser a
    parser) PersistSettings
    ps
        pm :: ParsecT Void String (Writer (Set ParserWarning)) (a, ExtraState)
    pm = StateT
      ExtraState (ParsecT Void String (Writer (Set ParserWarning))) a
    -> ExtraState
    -> ParsecT Void String (Writer (Set ParserWarning)) (a, ExtraState)
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT StateT
      ExtraState (ParsecT Void String (Writer (Set ParserWarning))) a
    sm ExtraState
    acc
        wm :: Writer
      (Set ParserWarning)
      (State String Void,
       Either (ParseErrorBundle String Void) (a, ExtraState))
    wm = ParsecT Void String (Writer (Set ParserWarning)) (a, ExtraState)
    -> State String Void
    -> Writer
         (Set ParserWarning)
         (State String Void,
          Either (ParseErrorBundle String Void) (a, ExtraState))
    forall (m :: * -> *) e s a.
    Monad m =>
    ParsecT e s m a
    -> State s e -> m (State s e, Either (ParseErrorBundle s e) a)
    runParserT' ParsecT Void String (Writer (Set ParserWarning)) (a, ExtraState)
    pm State String Void
    initialInternalState
        ((State String Void
    _is, Either (ParseErrorBundle String Void) (a, ExtraState)
    either), Set ParserWarning
    warnings) = Writer
      (Set ParserWarning)
      (State String Void,
       Either (ParseErrorBundle String Void) (a, ExtraState))
    -> ((State String Void,
         Either (ParseErrorBundle String Void) (a, ExtraState)),
        Set ParserWarning)
    forall w a. Writer w a -> (a, w)
    runWriter Writer
      (Set ParserWarning)
      (State String Void,
       Either (ParseErrorBundle String Void) (a, ExtraState))
    wm

        initialSourcePos :: SourcePos
    initialSourcePos =
            SourcePos
                { sourceName :: String
    sourceName = String
    fp
                , sourceLine :: Pos
    sourceLine = Pos
    pos1
                , sourceColumn :: Pos
    sourceColumn = Pos
    pos1
                }
        initialPosState :: PosState String
    initialPosState =
            PosState
                { pstateInput :: String
    pstateInput = String
    s
                , pstateOffset :: Int
    pstateOffset = Int
    0
                , pstateSourcePos :: SourcePos
    pstateSourcePos = SourcePos
    initialSourcePos
                , -- for legacy compatibility, we treat each tab as a single unit of whitespace
                  pstateTabWidth :: Pos
    pstateTabWidth = Pos
    pos1
                , pstateLinePrefix :: String
    pstateLinePrefix = String
    ""
                }
        initialInternalState :: State String Void
    initialInternalState =
            State
                { stateInput :: String
    stateInput = String
    s
                , stateOffset :: Int
    stateOffset = Int
    0
                , statePosState :: PosState String
    statePosState = PosState String
    initialPosState
                , stateParseErrors :: [ParseError String Void]
    stateParseErrors = []
                }

    reportWarnings :: Set ParserWarning -> Parser ()
    #if MIN_VERSION_megaparsec(9,5,0)
    reportWarnings :: Set ParserWarning -> Parser ()
    reportWarnings = ReaderT
      PersistSettings
      (StateT
         ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
      ()
    -> Parser ()
    forall a.
    ReaderT
      PersistSettings
      (StateT
         ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
      a
    -> Parser a
    Parser (ReaderT
       PersistSettings
       (StateT
          ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
       ()
     -> Parser ())
    -> (Set ParserWarning
        -> ReaderT
             PersistSettings
             (StateT
                ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
             ())
    -> Set ParserWarning
    -> Parser ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set ParserWarning
    -> ReaderT
         PersistSettings
         (StateT
            ExtraState (ParsecT Void String (Writer (Set ParserWarning))))
         ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell
    #else
    reportWarnings _pw = pure ()
    #endif

    -- | Renders a list of EntityParseErrors as a String using `errorBundlePretty`,
    -- separated by line breaks.
    -- @since 2.16.0.0
    renderErrors :: [EntityParseError] -> String
    renderErrors :: [ParseErrorBundle String Void] -> String
    renderErrors [ParseErrorBundle String Void]
    errs = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (ParseErrorBundle String Void -> String)
    -> [ParseErrorBundle String Void] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ParseErrorBundle String Void -> String
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> String
    errorBundlePretty [ParseErrorBundle String Void]
    errs

    -- | Attempts to parse with a provided parser. If it fails with an error matching
    -- the provided predicate, it registers a warning with the provided message and falls
    -- back to the second provided parser.
    tryOrWarn
        :: String
        -> (ParseError String Void -> Bool)
        -> Parser a
        -> Parser a
        -> Parser a
    tryOrWarn :: forall a.
    String
    -> (ParseError String Void -> Bool)
    -> Parser a
    -> Parser a
    -> Parser a
    tryOrWarn String
    msg ParseError String Void -> Bool
    p Parser a
    l Parser a
    r = do
        parserState <- Parser (State String Void)
    forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
    getParserState
        withRecovery (warnAndRetry $ statePosState parserState) l
      where
        warnAndRetry :: PosState String -> ParseError String Void -> Parser a
    warnAndRetry PosState String
    posState ParseError String Void
    err = do
            if ParseError String Void -> Bool
    p ParseError String Void
    err
                then do
                    let
                        ([(ParseError String Void, SourcePos)]
    pairs, PosState String
    _) = (ParseError String Void -> Int)
    -> [ParseError String Void]
    -> PosState String
    -> ([(ParseError String Void, SourcePos)], PosState String)
    forall (t :: * -> *) s a.
    (Traversable t, TraversableStream s) =>
    (a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
    attachSourcePos ParseError String Void -> Int
    forall s e. ParseError s e -> Int
    errorOffset [ParseError String Void
    err] PosState String
    posState
                    Set ParserWarning -> Parser ()
    reportWarnings (Set ParserWarning -> Parser ())
    -> ([ParserWarning] -> Set ParserWarning)
    -> [ParserWarning]
    -> Parser ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ParserWarning] -> Set ParserWarning
    forall a. Ord a => [a] -> Set a
    Set.fromList ([ParserWarning] -> Parser ()) -> [ParserWarning] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $
                        ((ParseError String Void, SourcePos) -> ParserWarning)
    -> [(ParseError String Void, SourcePos)] -> [ParserWarning]
    forall a b. (a -> b) -> [a] -> [b]
    map
                            ( \(ParseError String Void
    e, SourcePos
    _pos) ->
                                ParserWarning
                                    { parserWarningExtraMessage :: String
    parserWarningExtraMessage = String
    msg String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "\n"
                                    , parserWarningUnderlyingError :: ParseError String Void
    parserWarningUnderlyingError = ParseError String Void
    e
                                    , parserWarningPosState :: PosState String
    parserWarningPosState = PosState String
    posState
                                    }
                            )
                            [(ParseError String Void, SourcePos)]
    pairs
                    Parser a
    r
                else ParseError String Void -> Parser a
    forall a. ParseError String Void -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    ParseError s e -> m a
    parseError ParseError String Void
    err

    -- | Attempts to parse with a provided parser. If it fails with an error matching
    -- the provided predicate, it registers a delayed error and falls
    -- back to the second provided parser.
    --
    -- This is useful when registering errors in space consumers and other parsers that are called
    -- with `try`, since a non-delayed error in this context will cause backtracking and not
    -- get reported to the user.
    tryOrRegisterError
        :: (ParseError String Void -> Bool)
        -> Parser a
        -> Parser a
        -> Parser a
    tryOrRegisterError :: forall a.
    (ParseError String Void -> Bool)
    -> Parser a -> Parser a -> Parser a
    tryOrRegisterError ParseError String Void -> Bool
    p Parser a
    l Parser a
    r = do
        parserState <- Parser (State String Void)
    forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
    getParserState
        withRecovery (delayedError $ statePosState parserState) l
      where
        delayedError :: PosState String -> ParseError String Void -> Parser a
    delayedError PosState String
    posState ParseError String Void
    err = do
            if ParseError String Void -> Bool
    p ParseError String Void
    err
                then do
                    let
                        ([(ParseError String Void, SourcePos)]
    pairs, PosState String
    _) = (ParseError String Void -> Int)
    -> [ParseError String Void]
    -> PosState String
    -> ([(ParseError String Void, SourcePos)], PosState String)
    forall (t :: * -> *) s a.
    (Traversable t, TraversableStream s) =>
    (a -> Int) -> t a -> PosState s -> (t (a, SourcePos), PosState s)
    attachSourcePos ParseError String Void -> Int
    forall s e. ParseError s e -> Int
    errorOffset [ParseError String Void
    err] PosState String
    posState
                    ParseError String Void -> Parser ()
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    ParseError s e -> m ()
    registerParseError ParseError String Void
    err
                    Parser a
    r
                else ParseError String Void -> Parser a
    forall a. ParseError String Void -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    ParseError s e -> m a
    parseError ParseError String Void
    err

    tryOrReport
        :: Maybe ParserErrorLevel
        -> String
        -> (ParseError String Void -> Bool)
        -> Parser a
        -> Parser a
        -> Parser a
    tryOrReport :: forall a.
    Maybe ParserErrorLevel
    -> String
    -> (ParseError String Void -> Bool)
    -> Parser a
    -> Parser a
    -> Parser a
    tryOrReport Maybe ParserErrorLevel
    level String
    msg ParseError String Void -> Bool
    p Parser a
    l Parser a
    r = case Maybe ParserErrorLevel
    level of
        Just ParserErrorLevel
    LevelError -> (ParseError String Void -> Bool)
    -> Parser a -> Parser a -> Parser a
    forall a.
    (ParseError String Void -> Bool)
    -> Parser a -> Parser a -> Parser a
    tryOrRegisterError ParseError String Void -> Bool
    p Parser a
    l Parser a
    r
        Just ParserErrorLevel
    LevelWarning -> String
    -> (ParseError String Void -> Bool)
    -> Parser a
    -> Parser a
    -> Parser a
    forall a.
    String
    -> (ParseError String Void -> Bool)
    -> Parser a
    -> Parser a
    -> Parser a
    tryOrWarn String
    msg ParseError String Void -> Bool
    p Parser a
    l Parser a
    r
        Maybe ParserErrorLevel
    Nothing -> Parser a
    r

    -- | Source location: file and line/col information. This is half of a 'SourceSpan'.
    --
    -- @since 2.16.0.0
    data SourceLoc = SourceLoc
        { SourceLoc -> Text
    locFile :: Text
        , SourceLoc -> Int
    locStartLine :: Int
        , SourceLoc -> Int
    locStartCol :: Int
        }
        deriving (Int -> SourceLoc -> String -> String
    [SourceLoc] -> String -> String
    SourceLoc -> String
    (Int -> SourceLoc -> String -> String)
    -> (SourceLoc -> String)
    -> ([SourceLoc] -> String -> String)
    -> Show SourceLoc
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> SourceLoc -> String -> String
    showsPrec :: Int -> SourceLoc -> String -> String
    $cshow :: SourceLoc -> String
    show :: SourceLoc -> String
    $cshowList :: [SourceLoc] -> String -> String
    showList :: [SourceLoc] -> String -> String
    Show, (forall (m :: * -> *). Quote m => SourceLoc -> m Exp)
    -> (forall (m :: * -> *). Quote m => SourceLoc -> Code m SourceLoc)
    -> Lift SourceLoc
    forall t.
    (forall (m :: * -> *). Quote m => t -> m Exp)
    -> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
    forall (m :: * -> *). Quote m => SourceLoc -> m Exp
    forall (m :: * -> *). Quote m => SourceLoc -> Code m SourceLoc
    $clift :: forall (m :: * -> *). Quote m => SourceLoc -> m Exp
    lift :: forall (m :: * -> *). Quote m => SourceLoc -> m Exp
    $cliftTyped :: forall (m :: * -> *). Quote m => SourceLoc -> Code m SourceLoc
    liftTyped :: forall (m :: * -> *). Quote m => SourceLoc -> Code m SourceLoc
    Lift)

    -- | An attribute of an entity field definition or a directive.
    --
    -- @since 2.17.1.0
    data Attribute
        = Assignment Text Text
        | Parenthetical Text
        | PText Text
        | -- | Quoted field attributes are deprecated since 2.17.1.0.
          Quotation Text
        deriving (Attribute -> Attribute -> Bool
    (Attribute -> Attribute -> Bool)
    -> (Attribute -> Attribute -> Bool) -> Eq Attribute
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Attribute -> Attribute -> Bool
    == :: Attribute -> Attribute -> Bool
    $c/= :: Attribute -> Attribute -> Bool
    /= :: Attribute -> Attribute -> Bool
    Eq, Eq Attribute
    Eq Attribute =>
    (Attribute -> Attribute -> Ordering)
    -> (Attribute -> Attribute -> Bool)
    -> (Attribute -> Attribute -> Bool)
    -> (Attribute -> Attribute -> Bool)
    -> (Attribute -> Attribute -> Bool)
    -> (Attribute -> Attribute -> Attribute)
    -> (Attribute -> Attribute -> Attribute)
    -> Ord Attribute
    Attribute -> Attribute -> Bool
    Attribute -> Attribute -> Ordering
    Attribute -> Attribute -> Attribute
    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 :: Attribute -> Attribute -> Ordering
    compare :: Attribute -> Attribute -> Ordering
    $c< :: Attribute -> Attribute -> Bool
    < :: Attribute -> Attribute -> Bool
    $c<= :: Attribute -> Attribute -> Bool
    <= :: Attribute -> Attribute -> Bool
    $c> :: Attribute -> Attribute -> Bool
    > :: Attribute -> Attribute -> Bool
    $c>= :: Attribute -> Attribute -> Bool
    >= :: Attribute -> Attribute -> Bool
    $cmax :: Attribute -> Attribute -> Attribute
    max :: Attribute -> Attribute -> Attribute
    $cmin :: Attribute -> Attribute -> Attribute
    min :: Attribute -> Attribute -> Attribute
    Ord, Int -> Attribute -> String -> String
    [Attribute] -> String -> String
    Attribute -> String
    (Int -> Attribute -> String -> String)
    -> (Attribute -> String)
    -> ([Attribute] -> String -> String)
    -> Show Attribute
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Attribute -> String -> String
    showsPrec :: Int -> Attribute -> String -> String
    $cshow :: Attribute -> String
    show :: Attribute -> String
    $cshowList :: [Attribute] -> String -> String
    showList :: [Attribute] -> String -> String
    Show)

    -- | The name of an entity block or extra block.
    --
    -- @since 2.17.1.0
    newtype BlockKey = BlockKey Text
        deriving (Int -> BlockKey -> String -> String
    [BlockKey] -> String -> String
    BlockKey -> String
    (Int -> BlockKey -> String -> String)
    -> (BlockKey -> String)
    -> ([BlockKey] -> String -> String)
    -> Show BlockKey
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> BlockKey -> String -> String
    showsPrec :: Int -> BlockKey -> String -> String
    $cshow :: BlockKey -> String
    show :: BlockKey -> String
    $cshowList :: [BlockKey] -> String -> String
    showList :: [BlockKey] -> String -> String
    Show)

    -- | A parsed comment or doc comment.
    --
    -- @since 2.16.0.0
    data CommentToken
        = DocComment Text
        | Comment Text
        deriving (CommentToken -> CommentToken -> Bool
    (CommentToken -> CommentToken -> Bool)
    -> (CommentToken -> CommentToken -> Bool) -> Eq CommentToken
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: CommentToken -> CommentToken -> Bool
    == :: CommentToken -> CommentToken -> Bool
    $c/= :: CommentToken -> CommentToken -> Bool
    /= :: CommentToken -> CommentToken -> Bool
    Eq, Eq CommentToken
    Eq CommentToken =>
    (CommentToken -> CommentToken -> Ordering)
    -> (CommentToken -> CommentToken -> Bool)
    -> (CommentToken -> CommentToken -> Bool)
    -> (CommentToken -> CommentToken -> Bool)
    -> (CommentToken -> CommentToken -> Bool)
    -> (CommentToken -> CommentToken -> CommentToken)
    -> (CommentToken -> CommentToken -> CommentToken)
    -> Ord CommentToken
    CommentToken -> CommentToken -> Bool
    CommentToken -> CommentToken -> Ordering
    CommentToken -> CommentToken -> CommentToken
    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 :: CommentToken -> CommentToken -> Ordering
    compare :: CommentToken -> CommentToken -> Ordering
    $c< :: CommentToken -> CommentToken -> Bool
    < :: CommentToken -> CommentToken -> Bool
    $c<= :: CommentToken -> CommentToken -> Bool
    <= :: CommentToken -> CommentToken -> Bool
    $c> :: CommentToken -> CommentToken -> Bool
    > :: CommentToken -> CommentToken -> Bool
    $c>= :: CommentToken -> CommentToken -> Bool
    >= :: CommentToken -> CommentToken -> Bool
    $cmax :: CommentToken -> CommentToken -> CommentToken
    max :: CommentToken -> CommentToken -> CommentToken
    $cmin :: CommentToken -> CommentToken -> CommentToken
    min :: CommentToken -> CommentToken -> CommentToken
    Ord, Int -> CommentToken -> String -> String
    [CommentToken] -> String -> String
    CommentToken -> String
    (Int -> CommentToken -> String -> String)
    -> (CommentToken -> String)
    -> ([CommentToken] -> String -> String)
    -> Show CommentToken
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> CommentToken -> String -> String
    showsPrec :: Int -> CommentToken -> String -> String
    $cshow :: CommentToken -> String
    show :: CommentToken -> String
    $cshowList :: [CommentToken] -> String -> String
    showList :: [CommentToken] -> String -> String
    Show)

    -- | Converts an attribute into a Text representation for second-stage parsing or
    -- presentation to the user
    --
    -- @since 2.16.0.0
    attributeContent :: Attribute -> Text
    attributeContent :: Attribute -> Text
    attributeContent = \case
        Assignment Text
    l Text
    r -> [Text] -> Text
    forall m. Monoid m => [m] -> m
    mconcat [Text
    l, Text
    "=", Text
    r]
        Parenthetical Text
    s -> Text
    s
        PText Text
    s -> Text
    s
        Quotation Text
    s -> Text
    s

    -- | Converts a directive into a Text representation for second-stage parsing or
    -- presentation to the user
    --
    -- @since 2.17.1.0
    directiveContent :: Directive -> [Text]
    directiveContent :: Directive -> [Text]
    directiveContent Directive
    d =
        [DirectiveName -> Text
    directiveNameContent (DirectiveName -> Text) -> DirectiveName -> Text
    forall a b. (a -> b) -> a -> b
    $ Directive -> DirectiveName
    directiveName Directive
    d]
            [Text] -> [Text] -> [Text]
    forall a. Semigroup a => a -> a -> a
    <> (Attribute -> Text
    attributeContent (Attribute -> Text) -> [Attribute] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Directive -> [Attribute]
    directiveAttributes Directive
    d)

    entityFieldContent :: EntityField -> [Text]
    entityFieldContent :: EntityField -> [Text]
    entityFieldContent EntityField
    f =
        [ EntityField -> Text
    fieldNameAndStrictnessAsText EntityField
    f
        , (TypeExpr -> Text
    typeExprContent (TypeExpr -> Text)
    -> (EntityField -> TypeExpr) -> EntityField -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityField -> TypeExpr
    entityFieldType) EntityField
    f
        ]
            [Text] -> [Text] -> [Text]
    forall a. [a] -> [a] -> [a]
    ++ (Attribute -> Text) -> [Attribute] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Attribute -> Text
    attributeContent (EntityField -> [Attribute]
    entityFieldAttributes EntityField
    f)

    blockKeyContent :: BlockKey -> Text
    blockKeyContent :: BlockKey -> Text
    blockKeyContent (BlockKey Text
    t) = Text
    t

    directiveNameContent :: DirectiveName -> Text
    directiveNameContent :: DirectiveName -> Text
    directiveNameContent (DirectiveName Text
    t) = Text
    t

    -- | Generates the field name of an EntityField, accompanied by
    -- its strictness sigil, if one is present.
    -- This is only needed temporarily, and can eventually be refactored away.
    --
    -- @since 2.17.1.0
    fieldNameAndStrictnessAsText :: EntityField -> Text
    fieldNameAndStrictnessAsText :: EntityField -> Text
    fieldNameAndStrictnessAsText EntityField
    f =
        let
            s :: Text
    s = case EntityField -> Maybe FieldStrictness
    entityFieldStrictness EntityField
    f of
                Just FieldStrictness
    Strict -> Text
    "!"
                Just FieldStrictness
    Lazy -> Text
    "~"
                Maybe FieldStrictness
    Nothing -> Text
    ""
            (FieldName Text
    fn) = EntityField -> FieldName
    entityFieldName EntityField
    f
         in
            Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    fn

    commentContent :: CommentToken -> Text
    commentContent :: CommentToken -> Text
    commentContent = \case
        Comment Text
    s -> Text
    s
        DocComment Text
    s -> Text
    s

    quotedAttributeErrorMessage :: String
    quotedAttributeErrorMessage :: String
    quotedAttributeErrorMessage = String
    "Unexpected quotation mark in field or directive attribute"

    attribute :: Parser Attribute
    attribute :: Parser Attribute
    attribute = do
        quotedFieldAttributeErrorLevel <- (PersistSettings -> Maybe ParserErrorLevel)
    -> Parser (Maybe ParserErrorLevel)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks PersistSettings -> Maybe ParserErrorLevel
    psQuotedArgumentErrorLevel
        tryOrReport
            quotedFieldAttributeErrorLevel
            "Quoted field attributes are deprecated since 2.17.1.0, and will be removed in or after 2.18.0.0"
            isQuotedAttributeError
            attribute'
            (Quotation . Text.pack <$> quotation)
      where
        isQuotedAttributeError :: ParseError s e -> Bool
    isQuotedAttributeError (FancyError Int
    _ Set (ErrorFancy e)
    s) = Set (ErrorFancy e)
    s Set (ErrorFancy e) -> Set (ErrorFancy e) -> Bool
    forall a. Eq a => a -> a -> Bool
    == ErrorFancy e -> Set (ErrorFancy e)
    forall a. a -> Set a
    Set.singleton (String -> ErrorFancy e
    forall e. String -> ErrorFancy e
    ErrorFail String
    quotedAttributeErrorMessage)
        isQuotedAttributeError ParseError s e
    _ = Bool
    False

    attribute' :: Parser Attribute
    attribute' :: Parser Attribute
    attribute' = do
        q <- Parser (Maybe Char) -> Parser (Maybe Char)
    forall a. Parser a -> Parser a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    lookAhead (Parser Char -> Parser (Maybe Char)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser Char -> Parser (Maybe Char))
    -> Parser Char -> Parser (Maybe Char)
    forall a b. (a -> b) -> a -> b
    $ Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '"')
        case q of
            Just Char
    _ -> String -> Parser Attribute
    forall a. String -> Parser a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    quotedAttributeErrorMessage
            Maybe Char
    Nothing ->
                [Parser Attribute] -> Parser Attribute
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                    [ Parser Attribute -> Parser Attribute
    forall a. Parser a -> Parser a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try Parser Attribute
    assignment
                    , Parser Attribute
    parenthetical
                    , Parser Attribute
    ptext
                    ]

    docComment :: Parser (SourcePos, CommentToken)
    docComment :: Parser (SourcePos, CommentToken)
    docComment = do
        pos <- Parser SourcePos
    forall s e (m :: * -> *).
    (TraversableStream s, MonadParsec e s m) =>
    m SourcePos
    getSourcePos
        content <-
            string "-- |" *> validHSpace *> takeWhileP (Just "character") (/= '\n')
        pure (pos, DocComment (Text.pack content))

    comment :: Parser (SourcePos, CommentToken)
    comment :: Parser (SourcePos, CommentToken)
    comment = do
        pos <- Parser SourcePos
    forall s e (m :: * -> *).
    (TraversableStream s, MonadParsec e s m) =>
    m SourcePos
    getSourcePos
        content <-
            (string "--" <|> string "#")
                *> validHSpace
                *> takeWhileP (Just "character") (/= '\n')
        pure (pos, Comment (Text.pack content))

    skipComment :: Parser ()
    skipComment :: Parser ()
    skipComment = do
        content <- Parser (SourcePos, CommentToken)
    docComment Parser (SourcePos, CommentToken)
    -> Parser (SourcePos, CommentToken)
    -> Parser (SourcePos, CommentToken)
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser (SourcePos, CommentToken)
    comment
        void $ appendCommentToState content

    isValidHSpace :: Bool -> Char -> Bool
    isValidHSpace :: Bool -> Char -> Bool
    isValidHSpace Bool
    allowTabs Char
    c =
        if Bool
    allowTabs
            then Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n'
            else Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n' Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\t'

    isValidSpace :: Bool -> Char -> Bool
    isValidSpace :: Bool -> Char -> Bool
    isValidSpace Bool
    allowTabs Char
    c =
        if Bool
    allowTabs
            then Char -> Bool
    isSpace Char
    c
            else Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    && Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\t'

    validSpaceParser
        :: (Maybe String -> (TMS.Token String -> Bool) -> Parser (Tokens String))
        -> (Bool -> Char -> Bool)
        -> Parser ()
    validSpaceParser :: (Maybe String -> (Token String -> Bool) -> Parser (Tokens String))
    -> (Bool -> Char -> Bool) -> Parser ()
    validSpaceParser Maybe String -> (Token String -> Bool) -> Parser (Tokens String)
    taker Bool -> Char -> Bool
    validator = do
        tabErrorLevel <- (PersistSettings -> Maybe ParserErrorLevel)
    -> Parser (Maybe ParserErrorLevel)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks PersistSettings -> Maybe ParserErrorLevel
    psTabErrorLevel
        void $
            tryOrReport
                tabErrorLevel
                "use spaces instead of tabs"
                isUnexpectedTabError
                (taker (Just "valid whitespace") (validator False))
                (taker (Just "valid whitespace") (validator True))

    isUnexpectedTabError :: ParseError String Void -> Bool
    isUnexpectedTabError :: ParseError String Void -> Bool
    isUnexpectedTabError (TrivialError Int
    _ Maybe (ErrorItem (Token String))
    ue Set (ErrorItem (Token String))
    l) =
        Maybe (ErrorItem Char)
    Maybe (ErrorItem (Token String))
    ue Maybe (ErrorItem Char) -> Maybe (ErrorItem Char) -> Bool
    forall a. Eq a => a -> a -> Bool
    == ErrorItem Char -> Maybe (ErrorItem Char)
    forall a. a -> Maybe a
    Just (NonEmpty Char -> ErrorItem Char
    forall t. NonEmpty t -> ErrorItem t
    Tokens (Char
    '\t' Char -> String -> NonEmpty Char
    forall a. a -> [a] -> NonEmpty a
    :| String
    ""))
            Bool -> Bool -> Bool
    && Set (ErrorItem Char)
    Set (ErrorItem (Token String))
    l Set (ErrorItem Char) -> Set (ErrorItem Char) -> Bool
    forall a. Eq a => a -> a -> Bool
    == ErrorItem Char -> Set (ErrorItem Char)
    forall a. a -> Set a
    Set.singleton (NonEmpty Char -> ErrorItem Char
    forall t. NonEmpty Char -> ErrorItem t
    Label (Char
    'v' Char -> String -> NonEmpty Char
    forall a. a -> [a] -> NonEmpty a
    :| String
    "alid whitespace"))
    isUnexpectedTabError ParseError String Void
    _ = Bool
    False

    someValidHSpace :: Parser ()
    someValidHSpace :: Parser ()
    someValidHSpace = (Maybe String -> (Token String -> Bool) -> Parser (Tokens String))
    -> (Bool -> Char -> Bool) -> Parser ()
    validSpaceParser Maybe String -> (Token String -> Bool) -> Parser (Tokens String)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe String -> (Token s -> Bool) -> m (Tokens s)
    takeWhile1P Bool -> Char -> Bool
    isValidHSpace

    someValidSpace :: Parser ()
    someValidSpace :: Parser ()
    someValidSpace = (Maybe String -> (Token String -> Bool) -> Parser (Tokens String))
    -> (Bool -> Char -> Bool) -> Parser ()
    validSpaceParser Maybe String -> (Token String -> Bool) -> Parser (Tokens String)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe String -> (Token s -> Bool) -> m (Tokens s)
    takeWhile1P Bool -> Char -> Bool
    isValidSpace

    validHSpace :: Parser ()
    validHSpace :: Parser ()
    validHSpace = (Maybe String -> (Token String -> Bool) -> Parser (Tokens String))
    -> (Bool -> Char -> Bool) -> Parser ()
    validSpaceParser Maybe String -> (Token String -> Bool) -> Parser (Tokens String)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Maybe String -> (Token s -> Bool) -> m (Tokens s)
    takeWhileP Bool -> Char -> Bool
    isValidHSpace

    spaceConsumer :: Parser ()
    spaceConsumer :: Parser ()
    spaceConsumer =
        Parser () -> Parser () -> Parser () -> Parser ()
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    m () -> m () -> m () -> m ()
    L.space
            Parser ()
    someValidHSpace
            Parser ()
    skipComment
            Parser ()
    forall a. Parser a
    forall (f :: * -> *) a. Alternative f => f a
    empty

    spaceConsumerN :: Parser ()
    spaceConsumerN :: Parser ()
    spaceConsumerN =
        Parser () -> Parser () -> Parser () -> Parser ()
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    m () -> m () -> m () -> m ()
    L.space
            Parser ()
    someValidSpace
            Parser ()
    skipComment
            Parser ()
    forall a. Parser a
    forall (f :: * -> *) a. Alternative f => f a
    empty

    -- This catch-all character class is used in a variety of places, and includes characters
    -- which have syntactic function. As we continue to iterate on the parser, we may want to consider
    -- shrinking or eliminating `contentChar`.
    contentChar :: Parser Char
    contentChar :: Parser Char
    contentChar =
        [Parser Char] -> Parser Char
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ Parser Char
    Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    alphaNumChar
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '.'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '['
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    ']'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '_'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '\''
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '"'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '!'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '~'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '-'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    ':'
            , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    ','
            , do
                backslash <- Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '\\'
                nextChar <- lookAhead anySingle
                if nextChar == '(' || nextChar == ')'
                    then single nextChar
                    else pure backslash
            ]

    nonLineSpaceChar :: Parser Char
    nonLineSpaceChar :: Parser Char
    nonLineSpaceChar = [Parser Char] -> Parser Char
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    ' ', Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '\t']

    -- This is a replacement for `Text.Megaparsec.Char.Lexer.charLiteral`;
    -- it does nearly the same thing but additionally supports escaped parentheses.
    charLiteral :: Parser Char
    charLiteral :: Parser Char
    charLiteral = String -> Parser Char -> Parser Char
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "literal character" (Parser Char -> Parser Char) -> Parser Char -> Parser Char
    forall a b. (a -> b) -> a -> b
    $ do
        char1 <- Parser Char
    Parser (Token String)
    forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
    anySingle
        case char1 of
            Char
    '\\' -> do
                char2 <- Parser Char
    Parser (Token String)
    forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
    anySingle
                case char2 of
                    Char
    '(' -> Char -> Parser Char
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char
    '('
                    Char
    ')' -> Char -> Parser Char
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char
    ')'
                    Char
    '\\' -> Char -> Parser Char
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char
    '\\'
                    Char
    '\"' -> Char -> Parser Char
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char
    '\"'
                    Char
    '\'' -> Char -> Parser Char
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char
    '\''
                    Char
    _ -> ErrorItem (Token String) -> Parser Char
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    ErrorItem (Token s) -> m a
    unexpected (NonEmpty (Token String) -> ErrorItem (Token String)
    forall t. NonEmpty t -> ErrorItem t
    Tokens (NonEmpty (Token String) -> ErrorItem (Token String))
    -> NonEmpty (Token String) -> ErrorItem (Token String)
    forall a b. (a -> b) -> a -> b
    $ Char
    char2 Char -> String -> NonEmpty Char
    forall a. a -> [a] -> NonEmpty a
    :| [])
            Char
    _ -> Char -> Parser Char
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Char
    char1

    assignment :: Parser Attribute
    assignment :: Parser Attribute
    assignment = String -> Parser Attribute -> Parser Attribute
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "assignment expression" (Parser Attribute -> Parser Attribute)
    -> Parser Attribute -> Parser Attribute
    forall a b. (a -> b) -> a -> b
    $ do
        Parser () -> Parser Attribute -> Parser Attribute
    forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
    L.lexeme Parser ()
    spaceConsumer (Parser Attribute -> Parser Attribute)
    -> Parser Attribute -> Parser Attribute
    forall a b. (a -> b) -> a -> b
    $ do
            lhs <- Parser Char -> Parser String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some Parser Char
    contentChar
            _ <- char '='
            rhs <-
                choice
                    [ quotation
                    , sqlLiteral
                    , parentheticalInner
                    , try sqlFunctionApplication
                    , some $ contentChar <|> char '(' <|> char ')'
                    ]
            pure $ Assignment (Text.pack lhs) (Text.pack rhs)
      where
        parentheticalInner :: Parser String
    parentheticalInner = do
            str <- Parser String
    parenthetical'
            pure . init . drop 1 $ str
        sqlFunctionApplication :: Parser String
    sqlFunctionApplication = do
            fn <- Parser Char -> Parser String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some Parser Char
    contentChar
            argString <- parentheticalInner
            pure $ mconcat [fn, "(", argString, ")"]

    sqlTypeName :: Parser String
    sqlTypeName :: Parser String
    sqlTypeName =
        Parser Char -> Parser String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some (Parser Char -> Parser String) -> Parser Char -> Parser String
    forall a b. (a -> b) -> a -> b
    $
            [Parser Char] -> Parser Char
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                [ Parser Char
    Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    alphaNumChar
                , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '_'
                ]

    sqlLiteral :: Parser String
    sqlLiteral :: Parser String
    sqlLiteral = String -> Parser String -> Parser String
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "SQL literal" (Parser String -> Parser String) -> Parser String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ do
        quote <- Parser () -> Parser String -> Parser String
    forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
    L.lexeme Parser ()
    spaceConsumer (Parser String -> Parser String) -> Parser String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '\'' Parser Char -> Parser String -> Parser String
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser Char -> Parser Char -> Parser String
    forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
    manyTill Parser Char
    charLiteral (Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '\'')
        st <- optional $ do
            colons <- string "::"
            tn <- sqlTypeName
            pure $ colons <> tn
        pure $
            mconcat
                [ "'"
                , quote
                , "'"
                , fromMaybe "" st
                ]

    quotation :: Parser String
    quotation :: Parser String
    quotation = Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '"' Parser Char -> Parser String -> Parser String
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser Char -> Parser Char -> Parser String
    forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
    manyTill Parser Char
    charLiteral (Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '"')

    parenthetical :: Parser Attribute
    parenthetical :: Parser Attribute
    parenthetical = String -> Parser Attribute -> Parser Attribute
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "parenthetical" (Parser Attribute -> Parser Attribute)
    -> Parser Attribute -> Parser Attribute
    forall a b. (a -> b) -> a -> b
    $ do
        str <- Parser () -> Parser String -> Parser String
    forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
    L.lexeme Parser ()
    spaceConsumer Parser String
    parenthetical'
        pure . Parenthetical . Text.pack . init . drop 1 $ str

    parenthetical' :: Parser String
    parenthetical' :: Parser String
    parenthetical' = do
        str <- Parser Char -> Parser Char -> Parser String -> Parser String
    forall (m :: * -> *) open close a.
    Applicative m =>
    m open -> m close -> m a -> m a
    between (Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '(') (Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    ')') Parser String
    q
        pure $ "(" ++ str ++ ")"
      where
        q :: Parser String
    q = [String] -> String
    forall m. Monoid m => [m] -> m
    mconcat ([String] -> String) -> Parser [String] -> Parser String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser String -> Parser [String]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some (Parser String
    c Parser String -> Parser String -> Parser String
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser String
    parenthetical')
        c :: Parser String
    c = (Char -> String -> String
    forall a. a -> [a] -> [a]
    : []) (Char -> String) -> Parser Char -> Parser String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Parser Char] -> Parser Char
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice [Parser Char
    contentChar, Parser Char
    nonLineSpaceChar, Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '"']

    blockKey :: Parser BlockKey
    blockKey :: Parser BlockKey
    blockKey = String -> Parser BlockKey -> Parser BlockKey
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "block key" (Parser BlockKey -> Parser BlockKey)
    -> Parser BlockKey -> Parser BlockKey
    forall a b. (a -> b) -> a -> b
    $ do
        fl <- Parser Char
    Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    upperChar
        rl <- many alphaNumChar
        pure . BlockKey . Text.pack $ fl : rl

    fieldStrictness :: Parser FieldStrictness
    fieldStrictness :: Parser FieldStrictness
    fieldStrictness =
        String -> Parser FieldStrictness -> Parser FieldStrictness
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "strictness sigil" (Parser FieldStrictness -> Parser FieldStrictness)
    -> Parser FieldStrictness -> Parser FieldStrictness
    forall a b. (a -> b) -> a -> b
    $
            (FieldStrictness
    Strict FieldStrictness -> Parser Char -> Parser FieldStrictness
    forall a b. a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '!') Parser FieldStrictness
    -> Parser FieldStrictness -> Parser FieldStrictness
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (FieldStrictness
    Lazy FieldStrictness -> Parser Char -> Parser FieldStrictness
    forall a b. a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '~')

    fieldName :: Parser FieldName
    fieldName :: Parser FieldName
    fieldName = String -> Parser FieldName -> Parser FieldName
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "field name" (Parser FieldName -> Parser FieldName)
    -> Parser FieldName -> Parser FieldName
    forall a b. (a -> b) -> a -> b
    $ do
        fl <- Parser Char
    Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    lowerChar
        rl <- many fieldNameChar
        pure . FieldName . Text.pack $ fl : rl
      where
        fieldNameChar :: Parser Char
    fieldNameChar =
            [Parser Char] -> Parser Char
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                [ Parser Char
    Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    alphaNumChar
                , Token String -> Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    Token s -> m (Token s)
    char Char
    Token String
    '_'
                ]

    ptext :: Parser Attribute
    ptext :: Parser Attribute
    ptext = String -> Parser Attribute -> Parser Attribute
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "plain attribute" (Parser Attribute -> Parser Attribute)
    -> Parser Attribute -> Parser Attribute
    forall a b. (a -> b) -> a -> b
    $ do
        str <- Parser () -> Parser String -> Parser String
    forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
    L.lexeme Parser ()
    spaceConsumer (Parser String -> Parser String) -> Parser String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ Parser Char -> Parser String
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    some Parser Char
    contentChar
        pure . PText . Text.pack $ str

    data ParsedEntityDef = ParsedEntityDef
        { ParsedEntityDef -> [Text]
    parsedEntityDefComments :: [Text]
        , ParsedEntityDef -> EntityNameHS
    parsedEntityDefEntityName :: EntityNameHS
        , ParsedEntityDef -> Bool
    parsedEntityDefIsSum :: Bool
        , ParsedEntityDef -> [Attribute]
    parsedEntityDefEntityAttributes :: [Attribute]
        , ParsedEntityDef -> [(EntityField, Maybe Text)]
    parsedEntityDefFields :: [(EntityField, Maybe Text)]
        , ParsedEntityDef -> [(Directive, Maybe Text)]
    parsedEntityDefDirectives :: [(Directive, Maybe Text)]
        , ParsedEntityDef -> Map Text [[Text]]
    parsedEntityDefExtras :: M.Map Text [ExtraLine]
        , ParsedEntityDef -> Maybe SourceSpan
    parsedEntityDefSpan :: Maybe SourceSpan
        }
        deriving (Int -> ParsedEntityDef -> String -> String
    [ParsedEntityDef] -> String -> String
    ParsedEntityDef -> String
    (Int -> ParsedEntityDef -> String -> String)
    -> (ParsedEntityDef -> String)
    -> ([ParsedEntityDef] -> String -> String)
    -> Show ParsedEntityDef
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ParsedEntityDef -> String -> String
    showsPrec :: Int -> ParsedEntityDef -> String -> String
    $cshow :: ParsedEntityDef -> String
    show :: ParsedEntityDef -> String
    $cshowList :: [ParsedEntityDef] -> String -> String
    showList :: [ParsedEntityDef] -> String -> String
    Show)

    data DocCommentBlock = DocCommentBlock
        { DocCommentBlock -> [Text]
    docCommentBlockLines :: [Text]
        , DocCommentBlock -> SourcePos
    docCommentBlockPos :: SourcePos
        }
        deriving (Int -> DocCommentBlock -> String -> String
    [DocCommentBlock] -> String -> String
    DocCommentBlock -> String
    (Int -> DocCommentBlock -> String -> String)
    -> (DocCommentBlock -> String)
    -> ([DocCommentBlock] -> String -> String)
    -> Show DocCommentBlock
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DocCommentBlock -> String -> String
    showsPrec :: Int -> DocCommentBlock -> String -> String
    $cshow :: DocCommentBlock -> String
    show :: DocCommentBlock -> String
    $cshowList :: [DocCommentBlock] -> String -> String
    showList :: [DocCommentBlock] -> String -> String
    Show)

    data EntityHeader = EntityHeader
        { EntityHeader -> Bool
    entityHeaderSum :: Bool
        , EntityHeader -> Text
    entityHeaderTableName :: Text
        , EntityHeader -> [Attribute]
    entityHeaderRemainingAttributes :: [Attribute]
        , EntityHeader -> SourcePos
    entityHeaderPos :: SourcePos
        }
        deriving (Int -> EntityHeader -> String -> String
    [EntityHeader] -> String -> String
    EntityHeader -> String
    (Int -> EntityHeader -> String -> String)
    -> (EntityHeader -> String)
    -> ([EntityHeader] -> String -> String)
    -> Show EntityHeader
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> EntityHeader -> String -> String
    showsPrec :: Int -> EntityHeader -> String -> String
    $cshow :: EntityHeader -> String
    show :: EntityHeader -> String
    $cshowList :: [EntityHeader] -> String -> String
    showList :: [EntityHeader] -> String -> String
    Show)

    data EntityBlock = EntityBlock
        { EntityBlock -> Maybe DocCommentBlock
    entityBlockDocCommentBlock :: Maybe DocCommentBlock
        , EntityBlock -> EntityHeader
    entityBlockEntityHeader :: EntityHeader
        , EntityBlock -> [Member]
    entityBlockMembers :: [Member]
        }
        deriving (Int -> EntityBlock -> String -> String
    [EntityBlock] -> String -> String
    EntityBlock -> String
    (Int -> EntityBlock -> String -> String)
    -> (EntityBlock -> String)
    -> ([EntityBlock] -> String -> String)
    -> Show EntityBlock
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> EntityBlock -> String -> String
    showsPrec :: Int -> EntityBlock -> String -> String
    $cshow :: EntityBlock -> String
    show :: EntityBlock -> String
    $cshowList :: [EntityBlock] -> String -> String
    showList :: [EntityBlock] -> String -> String
    Show)

    entityBlockFirstPos :: EntityBlock -> SourcePos
    entityBlockFirstPos :: EntityBlock -> SourcePos
    entityBlockFirstPos = EntityHeader -> SourcePos
    entityHeaderPos (EntityHeader -> SourcePos)
    -> (EntityBlock -> EntityHeader) -> EntityBlock -> SourcePos
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityBlock -> EntityHeader
    entityBlockEntityHeader

    entityBlockLastPos :: EntityBlock -> SourcePos
    entityBlockLastPos :: EntityBlock -> SourcePos
    entityBlockLastPos EntityBlock
    eb = case EntityBlock -> [Member]
    entityBlockMembers EntityBlock
    eb of
        [] -> EntityBlock -> SourcePos
    entityBlockFirstPos EntityBlock
    eb
        [Member]
    members -> [SourcePos] -> SourcePos
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([SourcePos] -> SourcePos) -> [SourcePos] -> SourcePos
    forall a b. (a -> b) -> a -> b
    $ (Member -> SourcePos) -> [Member] -> [SourcePos]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Member -> SourcePos
    memberEndPos [Member]
    members

    entityBlockEntityFields :: EntityBlock -> [EntityField]
    entityBlockEntityFields :: EntityBlock -> [EntityField]
    entityBlockEntityFields = (Member -> [EntityField]) -> [Member] -> [EntityField]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Member -> [EntityField]
    f ([Member] -> [EntityField])
    -> (EntityBlock -> [Member]) -> EntityBlock -> [EntityField]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> EntityBlock -> [Member]
    entityBlockMembers
      where
        f :: Member -> [EntityField]
    f Member
    m = case Member
    m of
            MemberExtraBlock ExtraBlock
    _ -> []
            MemberEntityField EntityField
    ba -> [EntityField
    ba]
            MemberDirective Directive
    _ -> []

    entityBlockExtraBlocks :: EntityBlock -> [ExtraBlock]
    entityBlockExtraBlocks :: EntityBlock -> [ExtraBlock]
    entityBlockExtraBlocks = (Member -> [ExtraBlock]) -> [Member] -> [ExtraBlock]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Member -> [ExtraBlock]
    f ([Member] -> [ExtraBlock])
    -> (EntityBlock -> [Member]) -> EntityBlock -> [ExtraBlock]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> EntityBlock -> [Member]
    entityBlockMembers
      where
        f :: Member -> [ExtraBlock]
    f Member
    m = case Member
    m of
            MemberExtraBlock ExtraBlock
    eb -> [ExtraBlock
    eb]
            MemberEntityField EntityField
    _ -> []
            MemberDirective Directive
    _ -> []

    entityBlockDirectives :: EntityBlock -> [Directive]
    entityBlockDirectives :: EntityBlock -> [Directive]
    entityBlockDirectives = (Member -> [Directive]) -> [Member] -> [Directive]
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap Member -> [Directive]
    f ([Member] -> [Directive])
    -> (EntityBlock -> [Member]) -> EntityBlock -> [Directive]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> EntityBlock -> [Member]
    entityBlockMembers
      where
        f :: Member -> [Directive]
    f Member
    m = case Member
    m of
            MemberExtraBlock ExtraBlock
    _ -> []
            MemberEntityField EntityField
    _ -> []
            MemberDirective Directive
    bd -> [Directive
    bd]

    data ExtraBlockHeader = ExtraBlockHeader
        { ExtraBlockHeader -> Text
    extraBlockHeaderKey :: Text
        , ExtraBlockHeader -> [Attribute]
    extraBlockHeaderRemainingAttributes :: [Attribute]
        , ExtraBlockHeader -> SourcePos
    extraBlockHeaderPos :: SourcePos
        }
        deriving (Int -> ExtraBlockHeader -> String -> String
    [ExtraBlockHeader] -> String -> String
    ExtraBlockHeader -> String
    (Int -> ExtraBlockHeader -> String -> String)
    -> (ExtraBlockHeader -> String)
    -> ([ExtraBlockHeader] -> String -> String)
    -> Show ExtraBlockHeader
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ExtraBlockHeader -> String -> String
    showsPrec :: Int -> ExtraBlockHeader -> String -> String
    $cshow :: ExtraBlockHeader -> String
    show :: ExtraBlockHeader -> String
    $cshowList :: [ExtraBlockHeader] -> String -> String
    showList :: [ExtraBlockHeader] -> String -> String
    Show)

    data ExtraBlock = ExtraBlock
        { ExtraBlock -> Maybe DocCommentBlock
    extraBlockDocCommentBlock :: Maybe DocCommentBlock
        , ExtraBlock -> ExtraBlockHeader
    extraBlockExtraBlockHeader :: ExtraBlockHeader
        , ExtraBlock -> NonEmpty ExtraBlockLine
    extraBlockLines :: NonEmpty ExtraBlockLine
        }
        deriving (Int -> ExtraBlock -> String -> String
    [ExtraBlock] -> String -> String
    ExtraBlock -> String
    (Int -> ExtraBlock -> String -> String)
    -> (ExtraBlock -> String)
    -> ([ExtraBlock] -> String -> String)
    -> Show ExtraBlock
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ExtraBlock -> String -> String
    showsPrec :: Int -> ExtraBlock -> String -> String
    $cshow :: ExtraBlock -> String
    show :: ExtraBlock -> String
    $cshowList :: [ExtraBlock] -> String -> String
    showList :: [ExtraBlock] -> String -> String
    Show)

    data FieldStrictness = Strict | Lazy
        deriving (Int -> FieldStrictness -> String -> String
    [FieldStrictness] -> String -> String
    FieldStrictness -> String
    (Int -> FieldStrictness -> String -> String)
    -> (FieldStrictness -> String)
    -> ([FieldStrictness] -> String -> String)
    -> Show FieldStrictness
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> FieldStrictness -> String -> String
    showsPrec :: Int -> FieldStrictness -> String -> String
    $cshow :: FieldStrictness -> String
    show :: FieldStrictness -> String
    $cshowList :: [FieldStrictness] -> String -> String
    showList :: [FieldStrictness] -> String -> String
    Show)

    newtype FieldName = FieldName Text
        deriving (Int -> FieldName -> String -> String
    [FieldName] -> String -> String
    FieldName -> String
    (Int -> FieldName -> String -> String)
    -> (FieldName -> String)
    -> ([FieldName] -> String -> String)
    -> Show FieldName
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> FieldName -> String -> String
    showsPrec :: Int -> FieldName -> String -> String
    $cshow :: FieldName -> String
    show :: FieldName -> String
    $cshowList :: [FieldName] -> String -> String
    showList :: [FieldName] -> String -> String
    Show, FieldName -> FieldName -> Bool
    (FieldName -> FieldName -> Bool)
    -> (FieldName -> FieldName -> Bool) -> Eq FieldName
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FieldName -> FieldName -> Bool
    == :: FieldName -> FieldName -> Bool
    $c/= :: FieldName -> FieldName -> Bool
    /= :: FieldName -> FieldName -> Bool
    Eq)

    newtype DirectiveName = DirectiveName Text
        deriving (Int -> DirectiveName -> String -> String
    [DirectiveName] -> String -> String
    DirectiveName -> String
    (Int -> DirectiveName -> String -> String)
    -> (DirectiveName -> String)
    -> ([DirectiveName] -> String -> String)
    -> Show DirectiveName
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DirectiveName -> String -> String
    showsPrec :: Int -> DirectiveName -> String -> String
    $cshow :: DirectiveName -> String
    show :: DirectiveName -> String
    $cshowList :: [DirectiveName] -> String -> String
    showList :: [DirectiveName] -> String -> String
    Show, DirectiveName -> DirectiveName -> Bool
    (DirectiveName -> DirectiveName -> Bool)
    -> (DirectiveName -> DirectiveName -> Bool) -> Eq DirectiveName
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DirectiveName -> DirectiveName -> Bool
    == :: DirectiveName -> DirectiveName -> Bool
    $c/= :: DirectiveName -> DirectiveName -> Bool
    /= :: DirectiveName -> DirectiveName -> Bool
    Eq)

    data EntityField = EntityField
        { EntityField -> Maybe DocCommentBlock
    entityFieldDocCommentBlock :: Maybe DocCommentBlock
        , EntityField -> Maybe FieldStrictness
    entityFieldStrictness :: Maybe FieldStrictness
        , EntityField -> FieldName
    entityFieldName :: FieldName
        , EntityField -> TypeExpr
    entityFieldType :: TypeExpr
        , EntityField -> [Attribute]
    entityFieldAttributes :: [Attribute]
        , EntityField -> SourcePos
    entityFieldPos :: SourcePos
        }
        deriving (Int -> EntityField -> String -> String
    [EntityField] -> String -> String
    EntityField -> String
    (Int -> EntityField -> String -> String)
    -> (EntityField -> String)
    -> ([EntityField] -> String -> String)
    -> Show EntityField
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> EntityField -> String -> String
    showsPrec :: Int -> EntityField -> String -> String
    $cshow :: EntityField -> String
    show :: EntityField -> String
    $cshowList :: [EntityField] -> String -> String
    showList :: [EntityField] -> String -> String
    Show)

    data Directive = Directive
        { Directive -> Maybe DocCommentBlock
    directiveDocCommentBlock :: Maybe DocCommentBlock
        , Directive -> DirectiveName
    directiveName :: DirectiveName
        , Directive -> [Attribute]
    directiveAttributes :: [Attribute]
        , Directive -> SourcePos
    directivePos :: SourcePos
        }
        deriving (Int -> Directive -> String -> String
    [Directive] -> String -> String
    Directive -> String
    (Int -> Directive -> String -> String)
    -> (Directive -> String)
    -> ([Directive] -> String -> String)
    -> Show Directive
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Directive -> String -> String
    showsPrec :: Int -> Directive -> String -> String
    $cshow :: Directive -> String
    show :: Directive -> String
    $cshowList :: [Directive] -> String -> String
    showList :: [Directive] -> String -> String
    Show)

    data Member
        = MemberExtraBlock ExtraBlock
        | MemberEntityField EntityField
        | MemberDirective Directive
        deriving (Int -> Member -> String -> String
    [Member] -> String -> String
    Member -> String
    (Int -> Member -> String -> String)
    -> (Member -> String)
    -> ([Member] -> String -> String)
    -> Show Member
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Member -> String -> String
    showsPrec :: Int -> Member -> String -> String
    $cshow :: Member -> String
    show :: Member -> String
    $cshowList :: [Member] -> String -> String
    showList :: [Member] -> String -> String
    Show)

    data ExtraBlockLine = ExtraBlockLine
        { ExtraBlockLine -> Maybe DocCommentBlock
    extraBlockLineDocCommentBlock :: Maybe DocCommentBlock
        , ExtraBlockLine -> [String]
    extraBlockLineTokens :: [String]
        , ExtraBlockLine -> SourcePos
    extraBlockLinePos :: SourcePos
        }
        deriving (Int -> ExtraBlockLine -> String -> String
    [ExtraBlockLine] -> String -> String
    ExtraBlockLine -> String
    (Int -> ExtraBlockLine -> String -> String)
    -> (ExtraBlockLine -> String)
    -> ([ExtraBlockLine] -> String -> String)
    -> Show ExtraBlockLine
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> ExtraBlockLine -> String -> String
    showsPrec :: Int -> ExtraBlockLine -> String -> String
    $cshow :: ExtraBlockLine -> String
    show :: ExtraBlockLine -> String
    $cshowList :: [ExtraBlockLine] -> String -> String
    showList :: [ExtraBlockLine] -> String -> String
    Show)

    -- | The source position at the beginning of the member's final line.
    memberEndPos :: Member -> SourcePos
    memberEndPos :: Member -> SourcePos
    memberEndPos (MemberEntityField EntityField
    fs) = EntityField -> SourcePos
    entityFieldPos EntityField
    fs
    memberEndPos (MemberDirective Directive
    d) = Directive -> SourcePos
    directivePos Directive
    d
    memberEndPos (MemberExtraBlock ExtraBlock
    ex) = ExtraBlockLine -> SourcePos
    extraBlockLinePos (ExtraBlockLine -> SourcePos)
    -> (ExtraBlock -> ExtraBlockLine) -> ExtraBlock -> SourcePos
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty ExtraBlockLine -> ExtraBlockLine
    forall a. NonEmpty a -> a
    NEL.last (NonEmpty ExtraBlockLine -> ExtraBlockLine)
    -> (ExtraBlock -> NonEmpty ExtraBlockLine)
    -> ExtraBlock
    -> ExtraBlockLine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExtraBlock -> NonEmpty ExtraBlockLine
    extraBlockLines (ExtraBlock -> SourcePos) -> ExtraBlock -> SourcePos
    forall a b. (a -> b) -> a -> b
    $ ExtraBlock
    ex

    -- | Represents an entity member as a list of EntityFields
    --
    -- @since 2.16.0.0
    memberEntityFields :: Member -> [EntityField]
    memberEntityFields :: Member -> [EntityField]
    memberEntityFields (MemberEntityField EntityField
    fs) = [EntityField
    fs]
    memberEntityFields (MemberDirective Directive
    _) = []
    memberEntityFields (MemberExtraBlock ExtraBlock
    _) = []

    extraBlocksAsMap :: [ExtraBlock] -> M.Map Text [ExtraLine]
    extraBlocksAsMap :: [ExtraBlock] -> Map Text [[Text]]
    extraBlocksAsMap [ExtraBlock]
    exs = [(Text, [[Text]])] -> Map Text [[Text]]
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, [[Text]])] -> Map Text [[Text]])
    -> [(Text, [[Text]])] -> Map Text [[Text]]
    forall a b. (a -> b) -> a -> b
    $ (ExtraBlock -> (Text, [[Text]]))
    -> [ExtraBlock] -> [(Text, [[Text]])]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ExtraBlock -> (Text, [[Text]])
    asPair [ExtraBlock]
    exs
      where
        asPair :: ExtraBlock -> (Text, [[Text]])
    asPair ExtraBlock
    ex =
            ( ExtraBlockHeader -> Text
    extraBlockHeaderKey (ExtraBlockHeader -> Text)
    -> (ExtraBlock -> ExtraBlockHeader) -> ExtraBlock -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExtraBlock -> ExtraBlockHeader
    extraBlockExtraBlockHeader (ExtraBlock -> Text) -> ExtraBlock -> Text
    forall a b. (a -> b) -> a -> b
    $ ExtraBlock
    ex
            , NonEmpty [Text] -> [[Text]]
    forall a. NonEmpty a -> [a]
    NEL.toList (ExtraBlock -> NonEmpty [Text]
    extraLines ExtraBlock
    ex)
            )
        extraLines :: ExtraBlock -> NonEmpty [Text]
        extraLines :: ExtraBlock -> NonEmpty [Text]
    extraLines ExtraBlock
    ex = (String -> Text) -> [String] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Text
    Text.pack ([String] -> [Text])
    -> (ExtraBlockLine -> [String]) -> ExtraBlockLine -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExtraBlockLine -> [String]
    extraBlockLineTokens (ExtraBlockLine -> [Text])
    -> NonEmpty ExtraBlockLine -> NonEmpty [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ExtraBlock -> NonEmpty ExtraBlockLine
    extraBlockLines ExtraBlock
    ex

    entityHeader :: Parser EntityHeader
    entityHeader :: Parser EntityHeader
    entityHeader = do
        pos <- Parser SourcePos
    forall s e (m :: * -> *).
    (TraversableStream s, MonadParsec e s m) =>
    m SourcePos
    getSourcePos
        plus <- optional (char '+')
        en <- validHSpace *> L.lexeme spaceConsumer blockKey
        rest <- L.lexeme spaceConsumer (many attribute)
        _ <- setLastDocumentablePosition
        pure
            EntityHeader
                { entityHeaderSum = isJust plus
                , entityHeaderTableName = blockKeyContent en
                , entityHeaderRemainingAttributes = rest
                , entityHeaderPos = pos
                }

    appendCommentToState :: (SourcePos, CommentToken) -> Parser ()
    appendCommentToState :: (SourcePos, CommentToken) -> Parser ()
    appendCommentToState (SourcePos, CommentToken)
    ptok =
        (ExtraState -> ExtraState) -> Parser ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((ExtraState -> ExtraState) -> Parser ())
    -> (ExtraState -> ExtraState) -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ \ExtraState
    es ->
            let
                comments :: [(SourcePos, CommentToken)]
    comments = ExtraState -> [(SourcePos, CommentToken)]
    esPositionedCommentTokens ExtraState
    es
             in
                ExtraState
    es{esPositionedCommentTokens = ptok : comments}

    setLastDocumentablePosition :: Parser ()
    setLastDocumentablePosition :: Parser ()
    setLastDocumentablePosition = do
        pos <- Parser SourcePos
    forall s e (m :: * -> *).
    (TraversableStream s, MonadParsec e s m) =>
    m SourcePos
    getSourcePos
        modify $ \ExtraState
    es -> ExtraState
    es{esLastDocumentablePosition = Just pos}

    getDcb :: Parser (Maybe DocCommentBlock)
    getDcb :: Parser (Maybe DocCommentBlock)
    getDcb = do
        es <- Parser ExtraState
    forall s (m :: * -> *). MonadState s m => m s
    get
        let
            comments = [(SourcePos, CommentToken)] -> [(SourcePos, CommentToken)]
    forall a. [a] -> [a]
    reverse ([(SourcePos, CommentToken)] -> [(SourcePos, CommentToken)])
    -> [(SourcePos, CommentToken)] -> [(SourcePos, CommentToken)]
    forall a b. (a -> b) -> a -> b
    $ ExtraState -> [(SourcePos, CommentToken)]
    esPositionedCommentTokens ExtraState
    es
        _ <- put es{esPositionedCommentTokens = []}
        let
            candidates = ((SourcePos, CommentToken) -> Bool)
    -> [(SourcePos, CommentToken)] -> [(SourcePos, CommentToken)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (\(SourcePos
    _sp, CommentToken
    ct) -> Bool -> Bool
    not (CommentToken -> Bool
    isDocComment CommentToken
    ct)) [(SourcePos, CommentToken)]
    comments
            filteredCandidates = ((SourcePos, CommentToken) -> Bool)
    -> [(SourcePos, CommentToken)] -> [(SourcePos, CommentToken)]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (ExtraState -> (SourcePos, CommentToken) -> Bool
    commentIsIncorrectlyPositioned ExtraState
    es) [(SourcePos, CommentToken)]
    candidates
        pure $ docCommentBlockFromPositionedAttributes filteredCandidates
      where
        commentIsIncorrectlyPositioned
            :: ExtraState -> (SourcePos, CommentToken) -> Bool
        commentIsIncorrectlyPositioned :: ExtraState -> (SourcePos, CommentToken) -> Bool
    commentIsIncorrectlyPositioned ExtraState
    es (SourcePos, CommentToken)
    ptok = case ExtraState -> Maybe SourcePos
    esLastDocumentablePosition ExtraState
    es of
            Maybe SourcePos
    Nothing -> Bool
    False
            Just SourcePos
    lastDocumentablePos -> (SourcePos -> Pos
    sourceLine (SourcePos -> Pos)
    -> ((SourcePos, CommentToken) -> SourcePos)
    -> (SourcePos, CommentToken)
    -> Pos
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SourcePos, CommentToken) -> SourcePos
    forall a b. (a, b) -> a
    fst) (SourcePos, CommentToken)
    ptok Pos -> Pos -> Bool
    forall a. Ord a => a -> a -> Bool
    <= SourcePos -> Pos
    sourceLine SourcePos
    lastDocumentablePos

    extraBlock :: Parser Member
    extraBlock :: Parser Member
    extraBlock = Parser ()
    -> Parser (IndentOpt Parser Member ExtraBlockLine) -> Parser Member
    forall s e (m :: * -> *) a b.
    (TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
    m () -> m (IndentOpt m a b) -> m a
    L.indentBlock Parser ()
    spaceConsumerN Parser (IndentOpt Parser Member ExtraBlockLine)
    innerParser
      where
        mkExtraBlockMember :: Maybe DocCommentBlock
    -> (ExtraBlockHeader, [ExtraBlockLine]) -> Member
    mkExtraBlockMember Maybe DocCommentBlock
    dcb (ExtraBlockHeader
    header, [ExtraBlockLine]
    extraBlockLines) =
            ExtraBlock -> Member
    MemberExtraBlock
                ExtraBlock
                    { extraBlockExtraBlockHeader :: ExtraBlockHeader
    extraBlockExtraBlockHeader = ExtraBlockHeader
    header
                    , extraBlockLines :: NonEmpty ExtraBlockLine
    extraBlockLines = [ExtraBlockLine] -> NonEmpty ExtraBlockLine
    forall {a}. [a] -> NonEmpty a
    ensureNonEmpty [ExtraBlockLine]
    extraBlockLines
                    , extraBlockDocCommentBlock :: Maybe DocCommentBlock
    extraBlockDocCommentBlock = Maybe DocCommentBlock
    dcb
                    }
        ensureNonEmpty :: [a] -> NonEmpty a
    ensureNonEmpty [a]
    lines = case [a] -> Maybe (NonEmpty a)
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [a]
    lines of
            Just NonEmpty a
    nel -> NonEmpty a
    nel
            Maybe (NonEmpty a)
    Nothing -> String -> NonEmpty a
    forall a. HasCallStack => String -> a
    error String
    "unreachable" -- lines is known to be non-empty
        innerParser :: Parser (IndentOpt Parser Member ExtraBlockLine)
    innerParser = do
            dcb <- Parser (Maybe DocCommentBlock)
    getDcb
            header <- extraBlockHeader
            pure $
                L.IndentSome
                    Nothing
                    (return . mkExtraBlockMember dcb . (header,))
                    extraBlockLine

    extraBlockHeader :: Parser ExtraBlockHeader
    extraBlockHeader :: Parser ExtraBlockHeader
    extraBlockHeader = do
        pos <- Parser SourcePos
    forall s e (m :: * -> *).
    (TraversableStream s, MonadParsec e s m) =>
    m SourcePos
    getSourcePos
        tn <- L.lexeme spaceConsumer blockKey
        rest <- L.lexeme spaceConsumer (many attribute)
        _ <- setLastDocumentablePosition
        pure $
            ExtraBlockHeader
                { extraBlockHeaderKey = blockKeyContent tn
                , extraBlockHeaderRemainingAttributes = rest
                , extraBlockHeaderPos = pos
                }

    extraBlockLine :: Parser ExtraBlockLine
    extraBlockLine :: Parser ExtraBlockLine
    extraBlockLine = do
        dcb <- Parser (Maybe DocCommentBlock)
    getDcb
        pos <- getSourcePos
        tokens <- some $ L.lexeme spaceConsumer (some contentChar)
        _ <- setLastDocumentablePosition
        pure $
            ExtraBlockLine
                { extraBlockLineDocCommentBlock = dcb
                , extraBlockLineTokens = tokens
                , extraBlockLinePos = pos
                }

    entityField :: Parser Member
    entityField :: Parser Member
    entityField = do
        dcb <- Parser (Maybe DocCommentBlock)
    getDcb
        pos <- getSourcePos
        ss <- optional fieldStrictness
        fn <- L.lexeme spaceConsumer fieldName
        ft <- L.lexeme spaceConsumer typeExpr -- Note that `typeExpr` consumes outer parentheses.
        fa <- L.lexeme spaceConsumer (many attribute)
        _ <- setLastDocumentablePosition
        lookAhead (void newline <|> eof)
        pure $
            MemberEntityField
                EntityField
                    { entityFieldDocCommentBlock = dcb
                    , entityFieldStrictness = ss
                    , entityFieldName = fn
                    , entityFieldType = ft
                    , entityFieldAttributes = fa
                    , entityFieldPos = pos
                    }

    directiveNameP :: Parser DirectiveName
    directiveNameP :: Parser DirectiveName
    directiveNameP =
        String -> Parser DirectiveName -> Parser DirectiveName
    forall a. String -> Parser a -> Parser a
    forall e s (m :: * -> *) a.
    MonadParsec e s m =>
    String -> m a -> m a
    label String
    "directive name" (Parser DirectiveName -> Parser DirectiveName)
    -> Parser DirectiveName -> Parser DirectiveName
    forall a b. (a -> b) -> a -> b
    $
            Text -> DirectiveName
    DirectiveName (Text -> DirectiveName)
    -> (String -> Text) -> String -> DirectiveName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    Text.pack
                (String -> DirectiveName) -> Parser String -> Parser DirectiveName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Parser String] -> Parser String
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
                    [ Tokens String -> Parser (Tokens String)
    forall e s (m :: * -> *).
    MonadParsec e s m =>
    Tokens s -> m (Tokens s)
    string String
    Tokens String
    "deriving"
                    , Parser String
    directiveName'
                    ]
      where
        directiveName' :: Parser String
    directiveName' = do
            fl <- Parser Char
    Parser (Token String)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Token s)
    upperChar
            rl <- many alphaNumChar
            pure (fl : rl)

    directive :: Parser Member
    directive :: Parser Member
    directive = do
        dcb <- Parser (Maybe DocCommentBlock)
    getDcb
        pos <- getSourcePos
        dn <- L.lexeme spaceConsumer directiveNameP
        args <- many $ L.lexeme spaceConsumer attribute
        _ <- setLastDocumentablePosition
        lookAhead (void newline <|> eof)
        pure $
            MemberDirective
                Directive
                    { directiveDocCommentBlock = dcb
                    , directiveName = dn
                    , directiveAttributes = args
                    , directivePos = pos
                    }

    member :: Parser Member
    member :: Parser Member
    member =
        [Parser Member] -> Parser Member
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    choice
            [ Parser Member -> Parser Member
    forall a. Parser a -> Parser a
    forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
    try Parser Member
    extraBlock
            , Parser Member
    directive
            , Parser Member
    entityField
            ]

    entityBlock :: Parser EntityBlock
    entityBlock :: Parser EntityBlock
    entityBlock = do
        Parser ()
    -> Parser (IndentOpt Parser EntityBlock Member)
    -> Parser EntityBlock
    forall s e (m :: * -> *) a b.
    (TraversableStream s, MonadParsec e s m, Token s ~ Char) =>
    m () -> m (IndentOpt m a b) -> m a
    L.indentBlock Parser ()
    spaceConsumerN Parser (IndentOpt Parser EntityBlock Member)
    innerParser
      where
        mkEntityBlock :: Maybe DocCommentBlock -> (EntityHeader, [Member]) -> EntityBlock
    mkEntityBlock Maybe DocCommentBlock
    dcb (EntityHeader
    header, [Member]
    members) =
            EntityBlock
                { entityBlockEntityHeader :: EntityHeader
    entityBlockEntityHeader = EntityHeader
    header
                , entityBlockMembers :: [Member]
    entityBlockMembers = [Member]
    members
                , entityBlockDocCommentBlock :: Maybe DocCommentBlock
    entityBlockDocCommentBlock = Maybe DocCommentBlock
    dcb
                }
        innerParser :: Parser (IndentOpt Parser EntityBlock Member)
    innerParser = do
            dcb <- Parser (Maybe DocCommentBlock)
    getDcb
            header <- entityHeader
            pure $ L.IndentMany Nothing (return . mkEntityBlock dcb . (header,)) member

    entitiesFromDocument :: Parser [EntityBlock]
    entitiesFromDocument :: Parser [EntityBlock]
    entitiesFromDocument = Parser EntityBlock -> Parser [EntityBlock]
    forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
    many Parser EntityBlock
    entityBlock

    docCommentBlockText :: DocCommentBlock -> Text
    docCommentBlockText :: DocCommentBlock -> Text
    docCommentBlockText DocCommentBlock
    dcb = [Text] -> Text
    Text.unlines ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ DocCommentBlock -> [Text]
    docCommentBlockLines DocCommentBlock
    dcb

    isDocComment :: CommentToken -> Bool
    isDocComment :: CommentToken -> Bool
    isDocComment CommentToken
    tok = case CommentToken
    tok of
        DocComment Text
    _ -> Bool
    True
        CommentToken
    _ -> Bool
    False

    docCommentBlockFromPositionedAttributes
        :: [(SourcePos, CommentToken)] -> Maybe DocCommentBlock
    docCommentBlockFromPositionedAttributes :: [(SourcePos, CommentToken)] -> Maybe DocCommentBlock
    docCommentBlockFromPositionedAttributes [(SourcePos, CommentToken)]
    ptoks =
        case [(SourcePos, CommentToken)]
    -> Maybe (NonEmpty (SourcePos, CommentToken))
    forall a. [a] -> Maybe (NonEmpty a)
    NEL.nonEmpty [(SourcePos, CommentToken)]
    ptoks of
            Maybe (NonEmpty (SourcePos, CommentToken))
    Nothing -> Maybe DocCommentBlock
    forall a. Maybe a
    Nothing
            Just NonEmpty (SourcePos, CommentToken)
    nel ->
                DocCommentBlock -> Maybe DocCommentBlock
    forall a. a -> Maybe a
    Just (DocCommentBlock -> Maybe DocCommentBlock)
    -> DocCommentBlock -> Maybe DocCommentBlock
    forall a b. (a -> b) -> a -> b
    $
                    DocCommentBlock
                        { docCommentBlockLines :: [Text]
    docCommentBlockLines = NonEmpty Text -> [Text]
    forall a. NonEmpty a -> [a]
    NEL.toList (NonEmpty Text -> [Text]) -> NonEmpty Text -> [Text]
    forall a b. (a -> b) -> a -> b
    $ ((SourcePos, CommentToken) -> Text)
    -> NonEmpty (SourcePos, CommentToken) -> NonEmpty Text
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (CommentToken -> Text
    commentContent (CommentToken -> Text)
    -> ((SourcePos, CommentToken) -> CommentToken)
    -> (SourcePos, CommentToken)
    -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SourcePos, CommentToken) -> CommentToken
    forall a b. (a, b) -> b
    snd) NonEmpty (SourcePos, CommentToken)
    nel
                        , docCommentBlockPos :: SourcePos
    docCommentBlockPos = (SourcePos, CommentToken) -> SourcePos
    forall a b. (a, b) -> a
    fst ((SourcePos, CommentToken) -> SourcePos)
    -> (SourcePos, CommentToken) -> SourcePos
    forall a b. (a -> b) -> a -> b
    $ NonEmpty (SourcePos, CommentToken) -> (SourcePos, CommentToken)
    forall a. NonEmpty a -> a
    NEL.head NonEmpty (SourcePos, CommentToken)
    nel
                        }

    parseEntities
        :: PersistSettings
        -> Text
        -> String
        -> ParseResult [EntityBlock]
    parseEntities :: PersistSettings -> Text -> String -> ParseResult [EntityBlock]
    parseEntities PersistSettings
    ps Text
    fp String
    s = do
        let
            (Set ParserWarning
    warnings, Either (ParseErrorBundle String Void) ([EntityBlock], ExtraState)
    res) =
                PersistSettings
    -> ExtraState
    -> Parser [EntityBlock]
    -> String
    -> String
    -> (Set ParserWarning,
        Either (ParseErrorBundle String Void) ([EntityBlock], ExtraState))
    forall a.
    PersistSettings
    -> ExtraState
    -> Parser a
    -> String
    -> String
    -> InternalParseResult a
    runConfiguredParser PersistSettings
    ps ExtraState
    initialExtraState Parser [EntityBlock]
    entitiesFromDocument (Text -> String
    Text.unpack Text
    fp) String
    s
        case Either (ParseErrorBundle String Void) ([EntityBlock], ExtraState)
    res of
            Left ParseErrorBundle String Void
    peb ->
                (Set ParserWarning
    warnings, ParseErrorBundle String Void
    -> Either (ParseErrorBundle String Void) [EntityBlock]
    forall a b. a -> Either a b
    Left ParseErrorBundle String Void
    peb)
            Right ([EntityBlock]
    entities, ExtraState
    _comments) ->
                (Set ParserWarning
    warnings, [EntityBlock]
    -> Either (ParseErrorBundle String Void) [EntityBlock]
    forall a. a -> Either (ParseErrorBundle String Void) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [EntityBlock]
    entities)

    toParsedEntityDef :: Maybe SourceLoc -> EntityBlock -> ParsedEntityDef
    toParsedEntityDef :: Maybe SourceLoc -> EntityBlock -> ParsedEntityDef
    toParsedEntityDef Maybe SourceLoc
    mSourceLoc EntityBlock
    eb =
        ParsedEntityDef
            { parsedEntityDefComments :: [Text]
    parsedEntityDefComments = [Text]
    comments
            , parsedEntityDefEntityName :: EntityNameHS
    parsedEntityDefEntityName = EntityNameHS
    entityNameHS
            , parsedEntityDefIsSum :: Bool
    parsedEntityDefIsSum = Bool
    isSum
            , parsedEntityDefEntityAttributes :: [Attribute]
    parsedEntityDefEntityAttributes = [Attribute]
    entityAttributes
            , parsedEntityDefFields :: [(EntityField, Maybe Text)]
    parsedEntityDefFields = [(EntityField, Maybe Text)]
    parsedFields
            , parsedEntityDefDirectives :: [(Directive, Maybe Text)]
    parsedEntityDefDirectives = [(Directive, Maybe Text)]
    parsedDirectives
            , parsedEntityDefExtras :: Map Text [[Text]]
    parsedEntityDefExtras = Map Text [[Text]]
    extras
            , parsedEntityDefSpan :: Maybe SourceSpan
    parsedEntityDefSpan = Maybe SourceSpan
    mSpan
            }
      where
        comments :: [Text]
    comments =
            [Text]
    -> (DocCommentBlock -> [Text]) -> Maybe DocCommentBlock -> [Text]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                []
                DocCommentBlock -> [Text]
    docCommentBlockLines
                (EntityBlock -> Maybe DocCommentBlock
    entityBlockDocCommentBlock EntityBlock
    eb)
        entityAttributes :: [Attribute]
    entityAttributes = EntityHeader -> [Attribute]
    entityHeaderRemainingAttributes (EntityHeader -> [Attribute])
    -> (EntityBlock -> EntityHeader) -> EntityBlock -> [Attribute]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityBlock -> EntityHeader
    entityBlockEntityHeader (EntityBlock -> [Attribute]) -> EntityBlock -> [Attribute]
    forall a b. (a -> b) -> a -> b
    $ EntityBlock
    eb
        isSum :: Bool
    isSum = EntityHeader -> Bool
    entityHeaderSum (EntityHeader -> Bool)
    -> (EntityBlock -> EntityHeader) -> EntityBlock -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityBlock -> EntityHeader
    entityBlockEntityHeader (EntityBlock -> Bool) -> EntityBlock -> Bool
    forall a b. (a -> b) -> a -> b
    $ EntityBlock
    eb
        entityNameHS :: EntityNameHS
    entityNameHS = Text -> EntityNameHS
    EntityNameHS (Text -> EntityNameHS)
    -> (EntityBlock -> Text) -> EntityBlock -> EntityNameHS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityHeader -> Text
    entityHeaderTableName (EntityHeader -> Text)
    -> (EntityBlock -> EntityHeader) -> EntityBlock -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EntityBlock -> EntityHeader
    entityBlockEntityHeader (EntityBlock -> EntityNameHS) -> EntityBlock -> EntityNameHS
    forall a b. (a -> b) -> a -> b
    $ EntityBlock
    eb

        fieldPair :: EntityField -> (EntityField, Maybe Text)
    fieldPair EntityField
    a = (EntityField
    a, DocCommentBlock -> Text
    docCommentBlockText (DocCommentBlock -> Text) -> Maybe DocCommentBlock -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> EntityField -> Maybe DocCommentBlock
    entityFieldDocCommentBlock EntityField
    a)
        parsedFields :: [(EntityField, Maybe Text)]
    parsedFields = (EntityField -> (EntityField, Maybe Text))
    -> [EntityField] -> [(EntityField, Maybe Text)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap EntityField -> (EntityField, Maybe Text)
    fieldPair (EntityBlock -> [EntityField]
    entityBlockEntityFields EntityBlock
    eb)

        directivePair :: Directive -> (Directive, Maybe Text)
    directivePair Directive
    d = (Directive
    d, DocCommentBlock -> Text
    docCommentBlockText (DocCommentBlock -> Text) -> Maybe DocCommentBlock -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Directive -> Maybe DocCommentBlock
    directiveDocCommentBlock Directive
    d)
        parsedDirectives :: [(Directive, Maybe Text)]
    parsedDirectives = (Directive -> (Directive, Maybe Text))
    -> [Directive] -> [(Directive, Maybe Text)]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Directive -> (Directive, Maybe Text)
    directivePair (EntityBlock -> [Directive]
    entityBlockDirectives EntityBlock
    eb)

        extras :: Map Text [[Text]]
    extras = [ExtraBlock] -> Map Text [[Text]]
    extraBlocksAsMap (EntityBlock -> [ExtraBlock]
    entityBlockExtraBlocks EntityBlock
    eb)
        filepath :: Text
    filepath = Text -> (SourceLoc -> Text) -> Maybe SourceLoc -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "" SourceLoc -> Text
    locFile Maybe SourceLoc
    mSourceLoc
        relativeStartLine :: Int
    relativeStartLine = Int -> (SourceLoc -> Int) -> Maybe SourceLoc -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 SourceLoc -> Int
    locStartLine Maybe SourceLoc
    mSourceLoc
        relativeStartCol :: Int
    relativeStartCol = Int -> (SourceLoc -> Int) -> Maybe SourceLoc -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    0 SourceLoc -> Int
    locStartCol Maybe SourceLoc
    mSourceLoc
        mSpan :: Maybe SourceSpan
    mSpan =
            SourceSpan -> Maybe SourceSpan
    forall a. a -> Maybe a
    Just
                SourceSpan
                    { spanFile :: Text
    spanFile = Text
    filepath
                    , spanStartLine :: Int
    spanStartLine =
                        Int
    relativeStartLine Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Pos -> Int
    unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourcePos -> Pos
    sourceLine (SourcePos -> Int) -> SourcePos -> Int
    forall a b. (a -> b) -> a -> b
    $ EntityBlock -> SourcePos
    entityBlockFirstPos EntityBlock
    eb)
                    , spanEndLine :: Int
    spanEndLine = Int
    relativeStartLine Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Pos -> Int
    unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourcePos -> Pos
    sourceLine (SourcePos -> Int) -> SourcePos -> Int
    forall a b. (a -> b) -> a -> b
    $ EntityBlock -> SourcePos
    entityBlockLastPos EntityBlock
    eb)
                    , spanStartCol :: Int
    spanStartCol =
                        Int
    relativeStartCol Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Pos -> Int
    unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourcePos -> Pos
    sourceColumn (SourcePos -> Int) -> SourcePos -> Int
    forall a b. (a -> b) -> a -> b
    $ EntityBlock -> SourcePos
    entityBlockFirstPos EntityBlock
    eb)
                    , spanEndCol :: Int
    spanEndCol = Pos -> Int
    unPos (Pos -> Int) -> (SourcePos -> Pos) -> SourcePos -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourcePos -> Pos
    sourceColumn (SourcePos -> Int) -> SourcePos -> Int
    forall a b. (a -> b) -> a -> b
    $ EntityBlock -> SourcePos
    entityBlockLastPos EntityBlock
    eb
                    }

    parseSource
        :: PersistSettings
        -> Maybe SourceLoc
        -> Text
        -> ParseResult [ParsedEntityDef]
    parseSource :: PersistSettings
    -> Maybe SourceLoc -> Text -> ParseResult [ParsedEntityDef]
    parseSource PersistSettings
    ps Maybe SourceLoc
    mSourceLoc Text
    source =
        ([EntityBlock] -> [ParsedEntityDef])
    -> Either (ParseErrorBundle String Void) [EntityBlock]
    -> Either (ParseErrorBundle String Void) [ParsedEntityDef]
    forall a b.
    (a -> b)
    -> Either (ParseErrorBundle String Void) a
    -> Either (ParseErrorBundle String Void) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((EntityBlock -> ParsedEntityDef)
    -> [EntityBlock] -> [ParsedEntityDef]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Maybe SourceLoc -> EntityBlock -> ParsedEntityDef
    toParsedEntityDef Maybe SourceLoc
    mSourceLoc))
            (Either (ParseErrorBundle String Void) [EntityBlock]
     -> Either (ParseErrorBundle String Void) [ParsedEntityDef])
    -> ParseResult [EntityBlock] -> ParseResult [ParsedEntityDef]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PersistSettings -> Text -> String -> ParseResult [EntityBlock]
    parseEntities PersistSettings
    ps Text
    filepath (Text -> String
    Text.unpack Text
    source)
      where
        filepath :: Text
    filepath = Text -> (SourceLoc -> Text) -> Maybe SourceLoc -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    "" SourceLoc -> Text
    locFile Maybe SourceLoc
    mSourceLoc