{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
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
newtype ParseResult a = PR
{ forall a.
ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
unPR
:: forall r. PRState
-> (PRState -> r)
-> (PRState -> a -> r)
-> r
}
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
withoutWarnings :: ParseResult a -> ParseResult a
withoutWarnings :: forall a. 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
-> forall r. 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
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 = ParseResult a
-> forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
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)
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 :: 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 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 :: forall a. 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 <*> :: forall a b. 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)
-> forall r.
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
-> forall r. 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 *> :: forall a b. 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
-> forall r. 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
-> forall r. 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 <* :: forall a b. 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
-> forall r. 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
-> forall r. 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 :: 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 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
-> forall r. 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
-> forall r. 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 :: forall a. a -> ParseResult a
return = a -> ParseResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
>> :: forall a b. 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 >>= :: forall a b. 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
-> forall r. 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
-> forall r. 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 (>>=) #-}
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 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
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) ()
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
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) ()
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) ()
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) ()
parseFatalFailure :: Position -> String -> ParseResult a
parseFatalFailure :: forall a. 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)
parseFatalFailure' :: ParseResult a
parseFatalFailure' :: forall a. 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 {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"
readAndParseFile
:: (BS.ByteString -> ParseResult a)
-> Verbosity
-> FilePath
-> 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
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)
-> Verbosity
-> String
-> 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) = 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
"\"."