    {-# LANGUAGE BangPatterns     #-}
    {-# LANGUAGE CPP              #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes       #-}
    -- | A parse result type for parsers from AST to Haskell types.
    module Distribution.Fields.ParseResult (
        ParseResult,
        runParseResult,
        recoverWith,
        parseWarning,
        parseWarnings,
        parseFailure,
        parseFatalFailure,
        parseFatalFailure',
        getCabalSpecVersion,
        setCabalSpecVersion,
        readAndParseFile,
        parseString,
        withoutWarnings,
        ) where

    import qualified Data.ByteString.Char8        as BS
    import           Distribution.Compat.Prelude
    import           Distribution.Parsec.Error    (PError (..), showPError)
    import           Distribution.Parsec.Position (Position (..), zeroPos)
    import           Distribution.Parsec.Warning  (PWarnType (..), PWarning (..), showPWarning)
    import           Distribution.Simple.Utils    (die', warn)
    import           Distribution.Verbosity       (Verbosity)
    import           Distribution.Version         (Version)
    import           Prelude ()
    import           System.Directory             (doesFileExist)

    #if MIN_VERSION_base(4,10,0)
    import Control.Applicative (Applicative (..))
    #endif

    -- | A monad with failure and accumulating errors and warnings.
    newtype ParseResult a = PR
        { forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR
            :: forall r. PRState
            -> (PRState -> r) -- failure, but we were able to recover a new-style spec-version declaration
            -> (PRState -> a -> r)             -- success
            -> r
        }

    -- Note: we have version here, as we could get any version.
    data PRState = PRState ![PWarning] ![PError] !(Maybe Version)

    emptyPRState :: PRState
    emptyPRState :: PRState
    emptyPRState = [PWarning] -> [PError] -> Maybe Version -> PRState
    PRState [] [] forall a. Maybe a
    Nothing

    -- | Forget 'ParseResult's warnings.
    --
    -- @since 3.4.0.0
    withoutWarnings :: ParseResult a -> ParseResult a
    withoutWarnings :: forall a. ParseResult a -> ParseResult a
    withoutWarnings ParseResult a
    m = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \PRState
    s PRState -> r
    failure PRState -> a -> r
    success ->
        forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    m PRState
    s PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s1 -> PRState -> a -> r
    success (PRState
    s1 PRState -> PRState -> PRState
    `withWarningsOf` PRState
    s)
      where
        withWarningsOf :: PRState -> PRState -> PRState
    withWarningsOf (PRState [PWarning]
    _ [PError]
    e Maybe Version
    v) (PRState [PWarning]
    w [PError]
    _ Maybe Version
    _) = [PWarning] -> [PError] -> Maybe Version -> PRState
    PRState [PWarning]
    w [PError]
    e Maybe Version
    v

    -- | Destruct a 'ParseResult' into the emitted warnings and either
    -- a successful value or
    -- list of errors and possibly recovered a spec-version declaration.
    runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    runParseResult :: forall a.
    ParseResult a
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    runParseResult ParseResult a
    pr = forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    pr PRState
    emptyPRState forall {b}.
    PRState -> ([PWarning], Either (Maybe Version, NonEmpty PError) b)
    failure forall {b}.
    PRState
    -> b -> ([PWarning], Either (Maybe Version, NonEmpty PError) b)
    success
      where
        failure :: PRState -> ([PWarning], Either (Maybe Version, NonEmpty PError) b)
    failure (PRState [PWarning]
    warns []         Maybe Version
    v)   = ([PWarning]
    warns, forall a b. a -> Either a b
    Left (Maybe Version
    v, Position -> String -> PError
    PError Position
    zeroPos String
    "panic" forall a. a -> [a] -> NonEmpty a
    :| []))
        failure (PRState [PWarning]
    warns (PError
    err:[PError]
    errs) Maybe Version
    v)   = ([PWarning]
    warns, forall a b. a -> Either a b
    Left (Maybe Version
    v, PError
    err forall a. a -> [a] -> NonEmpty a
    :| [PError]
    errs)) where
        success :: PRState
    -> b -> ([PWarning], Either (Maybe Version, NonEmpty PError) b)
    success (PRState [PWarning]
    warns []         Maybe Version
    _)   b
    x = ([PWarning]
    warns, forall a b. b -> Either a b
    Right b
    x)
        -- If there are any errors, don't return the result
        success (PRState [PWarning]
    warns (PError
    err:[PError]
    errs) Maybe Version
    v) b
    _ = ([PWarning]
    warns, forall a b. a -> Either a b
    Left (Maybe Version
    v, PError
    err forall a. a -> [a] -> NonEmpty a
    :| [PError]
    errs))

    instance Functor ParseResult where
        fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
    fmap a -> b
    f (PR forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    pr) = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s PRState -> r
    failure PRState -> b -> r
    success ->
            forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    pr PRState
    s PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s' a
    a ->
            PRState -> b -> r
    success PRState
    s' (a -> b
    f a
    a)
        {-# INLINE fmap #-}

    instance Applicative ParseResult where
        pure :: forall a. a -> ParseResult a
    pure a
    x = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s PRState -> r
    _ PRState -> a -> r
    success -> PRState -> a -> r
    success PRState
    s a
    x
        {-# INLINE pure #-}

        ParseResult (a -> b)
    f <*> :: forall a b. ParseResult (a -> b) -> ParseResult a -> ParseResult b
    <*> ParseResult a
    x = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s0 PRState -> r
    failure PRState -> b -> r
    success ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult (a -> b)
    f PRState
    s0 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s1 a -> b
    f' ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    x PRState
    s1 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s2 a
    x' ->
            PRState -> b -> r
    success PRState
    s2 (a -> b
    f' a
    x')
        {-# INLINE (<*>) #-}

        ParseResult a
    x  *> :: forall a b. ParseResult a -> ParseResult b -> ParseResult b
    *> ParseResult b
    y = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s0 PRState -> r
    failure PRState -> b -> r
    success ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    x PRState
    s0 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s1 a
    _ ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult b
    y PRState
    s1 PRState -> r
    failure PRState -> b -> r
    success
        {-# INLINE (*>) #-}

        ParseResult a
    x  <* :: forall a b. ParseResult a -> ParseResult b -> ParseResult a
    <* ParseResult b
    y = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s0 PRState -> r
    failure PRState -> a -> r
    success ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    x PRState
    s0 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s1 a
    x' ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult b
    y PRState
    s1 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s2 b
    _  ->
            PRState -> a -> r
    success PRState
    s2 a
    x'
        {-# INLINE (<*) #-}

    #if MIN_VERSION_base(4,10,0)
        liftA2 :: forall a b c.
    (a -> b -> c) -> ParseResult a -> ParseResult b -> ParseResult c
    liftA2 a -> b -> c
    f ParseResult a
    x ParseResult b
    y = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s0 PRState -> r
    failure PRState -> c -> r
    success ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    x PRState
    s0 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s1 a
    x' ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult b
    y PRState
    s1 PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s2 b
    y' ->
            PRState -> c -> r
    success PRState
    s2 (a -> b -> c
    f a
    x' b
    y')
        {-# INLINE liftA2 #-}
    #endif

    instance Monad ParseResult where
        return :: forall a. a -> ParseResult a
    return = forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        >> :: forall a b. ParseResult a -> ParseResult b -> ParseResult b
    (>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)

        ParseResult a
    m >>= :: forall a b. ParseResult a -> (a -> ParseResult b) -> ParseResult b
    >>= a -> ParseResult b
    k = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s PRState -> r
    failure PRState -> b -> r
    success ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR ParseResult a
    m PRState
    s PRState -> r
    failure forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s' a
    a ->
            forall a.
    ParseResult a
    -> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    unPR (a -> ParseResult b
    k a
    a) PRState
    s' PRState -> r
    failure PRState -> b -> r
    success
        {-# INLINE (>>=) #-}

    -- | "Recover" the parse result, so we can proceed parsing.
    -- 'runParseResult' will still result in 'Nothing', if there are recorded errors.
    recoverWith :: ParseResult a -> a -> ParseResult a
    recoverWith :: forall a. ParseResult a -> a -> ParseResult a
    recoverWith (PR forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    pr) a
    x = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \ !PRState
    s PRState -> r
    _failure PRState -> a -> r
    success ->
        forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
    pr PRState
    s (\ !PRState
    s' -> PRState -> a -> r
    success PRState
    s' a
    x) PRState -> a -> r
    success

    -- | Set cabal spec version.
    setCabalSpecVersion :: Maybe Version -> ParseResult ()
    setCabalSpecVersion :: Maybe Version -> ParseResult ()
    setCabalSpecVersion Maybe Version
    v = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \(PRState [PWarning]
    warns [PError]
    errs Maybe Version
    _) PRState -> r
    _failure PRState -> () -> r
    success ->
        PRState -> () -> r
    success ([PWarning] -> [PError] -> Maybe Version -> PRState
    PRState [PWarning]
    warns [PError]
    errs Maybe Version
    v) ()

    -- | Get cabal spec version.
    getCabalSpecVersion :: ParseResult (Maybe Version)
    getCabalSpecVersion :: ParseResult (Maybe Version)
    getCabalSpecVersion = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \s :: PRState
    s@(PRState [PWarning]
    _ [PError]
    _ Maybe Version
    v) PRState -> r
    _failure PRState -> Maybe Version -> r
    success ->
        PRState -> Maybe Version -> r
    success PRState
    s Maybe Version
    v

    -- | Add a warning. This doesn't fail the parsing process.
    parseWarning :: Position -> PWarnType -> String -> ParseResult ()
    parseWarning :: Position -> PWarnType -> String -> ParseResult ()
    parseWarning Position
    pos PWarnType
    t String
    msg = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \(PRState [PWarning]
    warns [PError]
    errs Maybe Version
    v) PRState -> r
    _failure PRState -> () -> r
    success ->
        PRState -> () -> r
    success ([PWarning] -> [PError] -> Maybe Version -> PRState
    PRState (PWarnType -> Position -> String -> PWarning
    PWarning PWarnType
    t Position
    pos String
    msg forall a. a -> [a] -> [a]
    : [PWarning]
    warns) [PError]
    errs Maybe Version
    v) ()

    -- | Add multiple warnings at once.
    parseWarnings :: [PWarning] -> ParseResult ()
    parseWarnings :: [PWarning] -> ParseResult ()
    parseWarnings [PWarning]
    newWarns = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \(PRState [PWarning]
    warns [PError]
    errs Maybe Version
    v) PRState -> r
    _failure PRState -> () -> r
    success ->
        PRState -> () -> r
    success ([PWarning] -> [PError] -> Maybe Version -> PRState
    PRState ([PWarning]
    newWarns forall a. [a] -> [a] -> [a]
    ++ [PWarning]
    warns) [PError]
    errs Maybe Version
    v) ()

    -- | Add an error, but not fail the parser yet.
    --
    -- For fatal failure use 'parseFatalFailure'
    parseFailure :: Position -> String -> ParseResult ()
    parseFailure :: Position -> String -> ParseResult ()
    parseFailure Position
    pos String
    msg = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \(PRState [PWarning]
    warns [PError]
    errs Maybe Version
    v) PRState -> r
    _failure PRState -> () -> r
    success ->
        PRState -> () -> r
    success ([PWarning] -> [PError] -> Maybe Version -> PRState
    PRState [PWarning]
    warns (Position -> String -> PError
    PError Position
    pos String
    msg forall a. a -> [a] -> [a]
    : [PError]
    errs) Maybe Version
    v) ()

    -- | Add an fatal error.
    parseFatalFailure :: Position -> String -> ParseResult a
    parseFatalFailure :: forall a. Position -> String -> ParseResult a
    parseFatalFailure Position
    pos String
    msg = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall a b. (a -> b) -> a -> b
    $ \(PRState [PWarning]
    warns [PError]
    errs Maybe Version
    v) PRState -> r
    failure PRState -> a -> r
    _success ->
        PRState -> r
    failure ([PWarning] -> [PError] -> Maybe Version -> PRState
    PRState [PWarning]
    warns (Position -> String -> PError
    PError Position
    pos String
    msg forall a. a -> [a] -> [a]
    : [PError]
    errs) Maybe Version
    v)

    -- | A 'mzero'.
    parseFatalFailure' :: ParseResult a
    parseFatalFailure' :: forall a. ParseResult a
    parseFatalFailure' = forall a.
    (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
    -> ParseResult a
    PR forall {t} {p}. PRState -> (PRState -> t) -> p -> t
    pr
      where
        pr :: PRState -> (PRState -> t) -> p -> t
    pr (PRState [PWarning]
    warns [] Maybe Version
    v) PRState -> t
    failure p
    _success = PRState -> t
    failure ([PWarning] -> [PError] -> Maybe Version -> PRState
    PRState [PWarning]
    warns [PError
    err] Maybe Version
    v)
        pr PRState
    s                    PRState -> t
    failure p
    _success = PRState -> t
    failure PRState
    s

        err :: PError
    err = Position -> String -> PError
    PError Position
    zeroPos String
    "Unknown fatal error"

    -- | Helper combinator to do parsing plumbing for files.
    --
    -- Given a parser and a filename, return the parse of the file,
    -- after checking if the file exists.
    --
    -- Argument order is chosen to encourage partial application.
    readAndParseFile
        :: (BS.ByteString -> ParseResult a)  -- ^ File contents to final value parser
        -> Verbosity                         -- ^ Verbosity level
        -> FilePath                          -- ^ File to read
        -> IO a
    readAndParseFile :: forall a.
    (ByteString -> ParseResult a) -> Verbosity -> String -> IO a
    readAndParseFile ByteString -> ParseResult a
    parser Verbosity
    verbosity String
    fpath = do
        Bool
    exists <- String -> IO Bool
    doesFileExist String
    fpath
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    exists forall a b. (a -> b) -> a -> b
    $
          forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity forall a b. (a -> b) -> a -> b
    $
            String
    "Error Parsing: file \"" forall a. [a] -> [a] -> [a]
    ++ String
    fpath forall a. [a] -> [a] -> [a]
    ++ String
    "\" doesn't exist. Cannot continue."
        ByteString
    bs <- String -> IO ByteString
    BS.readFile String
    fpath
        forall a.
    (ByteString -> ParseResult a)
    -> Verbosity -> String -> ByteString -> IO a
    parseString ByteString -> ParseResult a
    parser Verbosity
    verbosity String
    fpath ByteString
    bs

    parseString
        :: (BS.ByteString -> ParseResult a)  -- ^ File contents to final value parser
        -> Verbosity                         -- ^ Verbosity level
        -> String                            -- ^ File name
        -> BS.ByteString
        -> IO a
    parseString :: forall a.
    (ByteString -> ParseResult a)
    -> Verbosity -> String -> ByteString -> IO a
    parseString ByteString -> ParseResult a
    parser Verbosity
    verbosity String
    name ByteString
    bs = do
        let ([PWarning]
    warnings, Either (Maybe Version, NonEmpty PError) a
    result) = forall a.
    ParseResult a
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    runParseResult (ByteString -> ParseResult a
    parser ByteString
    bs)
        forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Verbosity -> String -> IO ()
    warn Verbosity
    verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> PWarning -> String
    showPWarning String
    name) [PWarning]
    warnings
        case Either (Maybe Version, NonEmpty PError) a
    result of
            Right a
    x -> forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
            Left (Maybe Version
    _, NonEmpty PError
    errors) -> do
                forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Verbosity -> String -> IO ()
    warn Verbosity
    verbosity forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> PError -> String
    showPError String
    name) NonEmpty PError
    errors
                forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity forall a b. (a -> b) -> a -> b
    $ String
    "Failed parsing \"" forall a. [a] -> [a] -> [a]
    ++ String
    name forall a. [a] -> [a] -> [a]
    ++ String
    "\"."