{-# 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
    ) 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
    }

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

-- | 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, [PError]) a)
runParseResult :: ParseResult a -> ([PWarning], Either (Maybe Version, [PError]) a)
runParseResult pr :: ParseResult a
pr = ParseResult a
-> PRState
-> (PRState -> ([PWarning], Either (Maybe Version, [PError]) a))
-> (PRState
    -> a -> ([PWarning], Either (Maybe Version, [PError]) a))
-> ([PWarning], Either (Maybe Version, [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, [PError]) a)
forall b.
PRState -> ([PWarning], Either (Maybe Version, [PError]) b)
failure PRState -> a -> ([PWarning], Either (Maybe Version, [PError]) a)
forall b.
PRState -> b -> ([PWarning], Either (Maybe Version, [PError]) b)
success
  where
    failure :: PRState -> ([PWarning], Either (Maybe Version, [PError]) b)
failure (PRState warns :: [PWarning]
warns errs :: [PError]
errs v :: Maybe Version
v)   = ([PWarning]
warns, (Maybe Version, [PError]) -> Either (Maybe Version, [PError]) b
forall a b. a -> Either a b
Left (Maybe Version
v, [PError]
errs))
    success :: PRState -> b -> ([PWarning], Either (Maybe Version, [PError]) b)
success (PRState warns :: [PWarning]
warns [] _)   x :: b
x = ([PWarning]
warns, b -> Either (Maybe Version, [PError]) b
forall a b. b -> Either a b
Right b
x)
    -- If there are any errors, don't return the result
    success (PRState warns :: [PWarning]
warns errs :: [PError]
errs v :: Maybe Version
v) _ = ([PWarning]
warns, (Maybe Version, [PError]) -> Either (Maybe Version, [PError]) b
forall a b. a -> Either a b
Left (Maybe Version
v, [PError]
errs))

instance Functor ParseResult where
    fmap :: (a -> b) -> ParseResult a -> ParseResult b
fmap f :: a -> b
f (PR 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 failure :: PRState -> r
failure success :: 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
a ->
        PRState -> b -> r
success PRState
s' (a -> b
f a
a)
    {-# INLINE fmap #-}

instance Applicative ParseResult where
    pure :: a -> ParseResult a
pure x :: 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 _ success :: PRState -> a -> r
success -> PRState -> a -> r
success PRState
s a
x
    {-# INLINE pure #-}

    f :: ParseResult (a -> b)
f <*> :: ParseResult (a -> b) -> ParseResult a -> ParseResult b
<*> x :: 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 failure :: PRState -> r
failure success :: 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 f' :: 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 x' :: a
x' ->
        PRState -> b -> r
success PRState
s2 (a -> b
f' a
x')
    {-# INLINE (<*>) #-}

    x :: ParseResult a
x  *> :: ParseResult a -> ParseResult b -> ParseResult b
*> y :: 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 failure :: PRState -> r
failure success :: 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 _ ->
        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 (*>) #-}

    x :: ParseResult a
x  <* :: ParseResult a -> ParseResult b -> ParseResult a
<* y :: 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 failure :: PRState -> r
failure success :: 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 x' :: 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 _  ->
        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 f :: a -> b -> c
f x :: ParseResult a
x y :: 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 failure :: PRState -> r
failure success :: 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 x' :: 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 y' :: 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
(*>)

    m :: ParseResult a
m >>= :: ParseResult a -> (a -> ParseResult b) -> ParseResult b
>>= k :: 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 failure :: PRState -> r
failure success :: 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
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 pr :: forall r. PRState -> (PRState -> r) -> (PRState -> a -> r) -> r
pr) x :: 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 _failure :: PRState -> r
_failure success :: 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 v :: 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 warns :: [PWarning]
warns errs :: [PError]
errs _) _failure :: PRState -> r
_failure success :: 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 _ _ v :: Maybe Version
v) _failure :: PRState -> r
_failure success :: 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 pos :: Position
pos t :: PWarnType
t msg :: 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 warns :: [PWarning]
warns errs :: [PError]
errs v :: Maybe Version
v) _failure :: PRState -> r
_failure success :: 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 newWarns :: [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 warns :: [PWarning]
warns errs :: [PError]
errs v :: Maybe Version
v) _failure :: PRState -> r
_failure success :: 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 pos :: Position
pos msg :: 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 warns :: [PWarning]
warns errs :: [PError]
errs v :: Maybe Version
v) _failure :: PRState -> r
_failure success :: 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 pos :: Position
pos msg :: 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 warns :: [PWarning]
warns errs :: [PError]
errs v :: Maybe Version
v) failure :: PRState -> r
failure _success :: 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 warns :: [PWarning]
warns [] v :: Maybe Version
v) failure :: PRState -> p
failure _success :: p
_success = PRState -> p
failure ([PWarning] -> [PError] -> Maybe Version -> PRState
PRState [PWarning]
warns [PError
err] Maybe Version
v)
    pr s :: PRState
s                    failure :: PRState -> p
failure _success :: p
_success = PRState -> p
failure PRState
s

    err :: PError
err = Position -> String -> PError
PError Position
zeroPos "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 parser :: ByteString -> ParseResult a
parser verbosity :: Verbosity
verbosity fpath :: 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
$
        "Error Parsing: file \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fpath String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\" 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 parser :: ByteString -> ParseResult a
parser verbosity :: Verbosity
verbosity name :: String
name bs :: ByteString
bs = do
    let (warnings :: [PWarning]
warnings, result :: Either (Maybe Version, [PError]) a
result) = ParseResult a -> ([PWarning], Either (Maybe Version, [PError]) a)
forall a.
ParseResult a -> ([PWarning], Either (Maybe Version, [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, [PError]) a
result of
        Right x :: a
x -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Left (_, errors :: [PError]
errors) -> do
            (PError -> IO ()) -> [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) [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
$ "Failed parsing \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\"."