{-# 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
    { 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 [] [] Maybe Version
forall a. Maybe a
Nothing

-- | Forget 'ParseResult's warnings.
--
-- @since 3.4.0.0
withoutWarnings :: ParseResult a -> ParseResult a
withoutWarnings :: ParseResult a -> ParseResult a
withoutWarnings ParseResult a
m = (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
 -> ParseResult a)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a b. (a -> b) -> a -> b
$ \PRState
s PRState -> r
failure PRState -> a -> r
success ->
    ParseResult a
-> PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
m PRState
s PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
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 :: ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult ParseResult a
pr = ParseResult a
-> PRState
-> (PRState
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a))
-> (PRState
    -> a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a))
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
pr PRState
emptyPRState PRState -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
forall b.
PRState -> ([PWarning], Either (Maybe Version, NonEmpty PError) b)
failure PRState
-> a -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
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, (Maybe Version, NonEmpty PError)
-> Either (Maybe Version, NonEmpty PError) b
forall a b. a -> Either a b
Left (Maybe Version
v, Position -> String -> PError
PError Position
zeroPos String
"panic" PError -> [PError] -> NonEmpty PError
forall a. a -> [a] -> NonEmpty a
:| []))
    failure (PRState [PWarning]
warns (PError
err:[PError]
errs) Maybe Version
v)   = ([PWarning]
warns, (Maybe Version, NonEmpty PError)
-> Either (Maybe Version, NonEmpty PError) b
forall a b. a -> Either a b
Left (Maybe Version
v, PError
err PError -> [PError] -> NonEmpty PError
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, b -> Either (Maybe Version, NonEmpty PError) b
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, (Maybe Version, NonEmpty PError)
-> Either (Maybe Version, NonEmpty PError) b
forall a b. a -> Either a b
Left (Maybe Version
v, PError
err PError -> [PError] -> NonEmpty PError
forall a. a -> [a] -> NonEmpty a
:| [PError]
errs))

instance Functor ParseResult where
    fmap :: (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (PR forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
pr) = (forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
 -> ParseResult b)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a b. (a -> b) -> a -> b
$ \ !PRState
s PRState -> r
failure PRState -> b -> r
success ->
        PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
pr PRState
s PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
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 :: a -> ParseResult a
pure a
x = (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
 -> ParseResult a)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
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 <*> :: ParseResult (a -> b) -> ParseResult a -> ParseResult b
<*> ParseResult a
x = (forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
 -> ParseResult b)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a b. (a -> b) -> a -> b
$ \ !PRState
s0 PRState -> r
failure PRState -> b -> r
success ->
        ParseResult (a -> b)
-> PRState -> (PRState -> r) -> (PRState -> (a -> b) -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult (a -> b)
f PRState
s0 PRState -> r
failure ((PRState -> (a -> b) -> r) -> r)
-> (PRState -> (a -> b) -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState
s1 a -> b
f' ->
        ParseResult a
-> PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
x PRState
s1 PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
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  *> :: ParseResult a -> ParseResult b -> ParseResult b
*> ParseResult b
y = (forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
 -> ParseResult b)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a b. (a -> b) -> a -> b
$ \ !PRState
s0 PRState -> r
failure PRState -> b -> r
success ->
        ParseResult a
-> PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
x PRState
s0 PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState
s1 a
_ ->
        ParseResult b
-> PRState -> (PRState -> r) -> (PRState -> b -> r) -> r
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  <* :: ParseResult a -> ParseResult b -> ParseResult a
<* ParseResult b
y = (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
 -> ParseResult a)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a b. (a -> b) -> a -> b
$ \ !PRState
s0 PRState -> r
failure PRState -> a -> r
success ->
        ParseResult a
-> PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
x PRState
s0 PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState
s1 a
x' ->
        ParseResult b
-> PRState -> (PRState -> r) -> (PRState -> b -> r) -> r
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) -> r) -> (PRState -> b -> r) -> r
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 :: (a -> b -> c) -> ParseResult a -> ParseResult b -> ParseResult c
liftA2 a -> b -> c
f ParseResult a
x ParseResult b
y = (forall r. PRState -> (PRState -> r) -> (PRState -> c -> r) -> r)
-> ParseResult c
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> c -> r) -> r)
 -> ParseResult c)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> c -> r) -> r)
-> ParseResult c
forall a b. (a -> b) -> a -> b
$ \ !PRState
s0 PRState -> r
failure PRState -> c -> r
success ->
        ParseResult a
-> PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
x PRState
s0 PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState
s1 a
x' ->
        ParseResult b
-> PRState -> (PRState -> r) -> (PRState -> b -> r) -> r
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) -> r) -> (PRState -> b -> r) -> r
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 :: a -> ParseResult a
return = a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    >> :: ParseResult a -> ParseResult b -> ParseResult b
(>>) = ParseResult a -> ParseResult b -> ParseResult b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

    ParseResult a
m >>= :: ParseResult a -> (a -> ParseResult b) -> ParseResult b
>>= a -> ParseResult b
k = (forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
 -> ParseResult b)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> b -> r) -> r)
-> ParseResult b
forall a b. (a -> b) -> a -> b
$ \ !PRState
s PRState -> r
failure PRState -> b -> r
success ->
        ParseResult a
-> PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR ParseResult a
m PRState
s PRState -> r
failure ((PRState -> a -> r) -> r) -> (PRState -> a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState
s' a
a ->
        ParseResult b
-> PRState -> (PRState -> r) -> (PRState -> b -> r) -> r
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 :: ParseResult a -> a -> ParseResult a
recoverWith (PR forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
pr) a
x = (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
 -> ParseResult a)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a b. (a -> b) -> a -> b
$ \ !PRState
s PRState -> r
_failure PRState -> a -> r
success ->
    PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
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 r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
 -> ParseResult ())
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
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 r.
 PRState -> (PRState -> r) -> (PRState -> Maybe Version -> r) -> r)
-> ParseResult (Maybe Version)
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r.
  PRState -> (PRState -> r) -> (PRState -> Maybe Version -> r) -> r)
 -> ParseResult (Maybe Version))
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> Maybe Version -> r) -> r)
-> ParseResult (Maybe Version)
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 r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
 -> ParseResult ())
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
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 PWarning -> [PWarning] -> [PWarning]
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 r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
 -> ParseResult ())
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
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 [PWarning] -> [PWarning] -> [PWarning]
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 r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
 -> ParseResult ())
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> () -> r) -> r)
-> ParseResult ()
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 PError -> [PError] -> [PError]
forall a. a -> [a] -> [a]
: [PError]
errs) Maybe Version
v) ()

-- | Add an fatal error.
parseFatalFailure :: Position -> String -> ParseResult a
parseFatalFailure :: Position -> String -> ParseResult a
parseFatalFailure Position
pos String
msg = (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR ((forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
 -> ParseResult a)
-> (forall r.
    PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
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 PError -> [PError] -> [PError]
forall a. a -> [a] -> [a]
: [PError]
errs) Maybe Version
v)

-- | A 'mzero'.
parseFatalFailure' :: ParseResult a
parseFatalFailure' :: ParseResult a
parseFatalFailure' = (forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
forall a.
(forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r)
-> ParseResult a
PR forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
forall p p. PRState -> (PRState -> p) -> p -> p
pr
  where
    pr :: PRState -> (PRState -> p) -> p -> p
pr (PRState [PWarning]
warns [] Maybe Version
v) PRState -> p
failure p
_success = PRState -> p
failure ([PWarning] -> [PError] -> Maybe Version -> PRState
PRState [PWarning]
warns [PError
err] Maybe Version
v)
    pr PRState
s                    PRState -> p
failure p
_success = PRState -> p
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 :: (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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"Error Parsing: file \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fpath String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\" doesn't exist. Cannot continue."
    ByteString
bs <- String -> IO ByteString
BS.readFile String
fpath
    (ByteString -> ParseResult a)
-> Verbosity -> String -> ByteString -> IO a
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 :: (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) = ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ByteString -> ParseResult a
parser ByteString
bs)
    (PWarning -> IO ()) -> [PWarning] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> (PWarning -> String) -> PWarning -> IO ()
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 -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Left (Maybe Version
_, NonEmpty PError
errors) -> do
            (PError -> IO ()) -> NonEmpty PError -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> (PError -> String) -> PError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PError -> String
showPError String
name) NonEmpty PError
errors
            Verbosity -> String -> IO a
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ String
"Failed parsing \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"."