{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-- | A parse result type for parsers from AST to Haskell types.
module Distribution.Fields.ParseResult
  ( ParseResult
  , runParseResult
  , PSource (..)
  , CabalFileSource (..)
  , recoverWith
  , parseWarning
  , parseWarnings
  , parseFailure
  , parseFatalFailure
  , parseFatalFailure'
  , getCabalSpecVersion
  , setCabalSpecVersion
  , withoutWarnings
  , liftParseResult
  , withSource
  ) where

import Distribution.Compat.Prelude
import Distribution.Parsec.Error (PError (..), PErrorWithSource (..))
import Distribution.Parsec.Position (Position (..), zeroPos)
import Distribution.Parsec.Source
import Distribution.Parsec.Warning
import Distribution.Version (Version)

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

data PRContext src = PRContext
  { forall src. PRContext src -> PSource src
prContextSource :: PSource src
  -- ^ The file we are parsing, if known. This field is parametric because we
  -- use the same parser for cabal files and project files.
  }

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

emptyPRState :: PRState src
emptyPRState :: forall src. PRState src
emptyPRState = [PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
forall src.
[PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
PRState [] [] Maybe Version
forall a. Maybe a
Nothing

-- | Forget 'ParseResult's warnings.
--
-- @since 3.4.0.0
withoutWarnings :: ParseResult src a -> ParseResult src a
withoutWarnings :: forall src a. ParseResult src a -> ParseResult src a
withoutWarnings ParseResult src a
m = (forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
forall src a.
(forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
PR ((forall r.
  PRState src
  -> PRContext src
  -> (PRState src -> r)
  -> (PRState src -> a -> r)
  -> r)
 -> ParseResult src a)
-> (forall r.
    PRState src
    -> PRContext src
    -> (PRState src -> r)
    -> (PRState src -> a -> r)
    -> r)
-> ParseResult src a
forall a b. (a -> b) -> a -> b
$ \PRState src
s PRContext src
ctx PRState src -> r
failure PRState src -> a -> r
success ->
  ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
forall src a.
ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
unPR ParseResult src a
m PRState src
s PRContext src
ctx PRState src -> r
failure ((PRState src -> a -> r) -> r) -> (PRState src -> a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState src
s1 -> PRState src -> a -> r
success (PRState src
s1 PRState src -> PRState src -> PRState src
forall {src}. PRState src -> PRState src -> PRState src
`withWarningsOf` PRState src
s)
  where
    withWarningsOf :: PRState src -> PRState src -> PRState src
withWarningsOf (PRState [PWarningWithSource src]
_ [PErrorWithSource src]
e Maybe Version
v) (PRState [PWarningWithSource src]
w [PErrorWithSource src]
_ Maybe Version
_) = [PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
forall src.
[PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
PRState [PWarningWithSource src]
w [PErrorWithSource src]
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 src a -> ([PWarningWithSource src], Either (Maybe Version, NonEmpty (PErrorWithSource src)) a)
runParseResult :: forall src a.
ParseResult src a
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) a)
runParseResult ParseResult src a
pr = ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
forall src a.
ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
unPR ParseResult src a
pr PRState src
forall src. PRState src
emptyPRState PRContext src
forall {src}. PRContext src
initialCtx PRState src
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) a)
forall {src} {b}.
PRState src
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) b)
failure PRState src
-> a
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) a)
forall {src} {p}.
PRState src
-> p
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) p)
success
  where
    initialCtx :: PRContext src
initialCtx = PSource src -> PRContext src
forall src. PSource src -> PRContext src
PRContext PSource src
forall src. PSource src
PUnknownSource

    failure :: PRState src
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) b)
failure (PRState [PWarningWithSource src]
warns [PErrorWithSource src]
errors Maybe Version
v) = ([PWarningWithSource src] -> [PWarningWithSource src]
forall {src}. [PWarningWithSource src] -> [PWarningWithSource src]
sortWarns [PWarningWithSource src]
warns, (Maybe Version, NonEmpty (PErrorWithSource src))
-> Either (Maybe Version, NonEmpty (PErrorWithSource src)) b
forall a b. a -> Either a b
Left (Maybe Version
v, NonEmpty (PErrorWithSource src)
errors'))
      where
        errors' :: NonEmpty (PErrorWithSource src)
errors' = case [PErrorWithSource src]
errors of
          [] -> PSource src -> PError -> PErrorWithSource src
forall src. PSource src -> PError -> PErrorWithSource src
PErrorWithSource PSource src
forall src. PSource src
PUnknownSource (Position -> String -> PError
PError Position
zeroPos String
"panic") PErrorWithSource src
-> [PErrorWithSource src] -> NonEmpty (PErrorWithSource src)
forall a. a -> [a] -> NonEmpty a
:| []
          PErrorWithSource src
err : [PErrorWithSource src]
errs -> PErrorWithSource src
err PErrorWithSource src
-> [PErrorWithSource src] -> NonEmpty (PErrorWithSource src)
forall a. a -> [a] -> NonEmpty a
:| [PErrorWithSource src]
errs

    success :: PRState src
-> p
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) p)
success (PRState [PWarningWithSource src]
warns [PErrorWithSource src]
errors Maybe Version
v) p
x = ([PWarningWithSource src] -> [PWarningWithSource src]
forall {src}. [PWarningWithSource src] -> [PWarningWithSource src]
sortWarns [PWarningWithSource src]
warns, Either (Maybe Version, NonEmpty (PErrorWithSource src)) p
result)
      where
        result :: Either (Maybe Version, NonEmpty (PErrorWithSource src)) p
result = case [PErrorWithSource src]
errors of
          [] -> p -> Either (Maybe Version, NonEmpty (PErrorWithSource src)) p
forall a b. b -> Either a b
Right p
x
          -- If there are any errors, don't return the result
          PErrorWithSource src
err : [PErrorWithSource src]
errs -> (Maybe Version, NonEmpty (PErrorWithSource src))
-> Either (Maybe Version, NonEmpty (PErrorWithSource src)) p
forall a b. a -> Either a b
Left (Maybe Version
v, PErrorWithSource src
err PErrorWithSource src
-> [PErrorWithSource src] -> NonEmpty (PErrorWithSource src)
forall a. a -> [a] -> NonEmpty a
:| [PErrorWithSource src]
errs)

    sortWarns :: [PWarningWithSource src] -> [PWarningWithSource src]
sortWarns = (PWarningWithSource src -> PWarningWithSource src -> Ordering)
-> [PWarningWithSource src] -> [PWarningWithSource src]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((PWarningWithSource src -> Position)
-> PWarningWithSource src -> PWarningWithSource src -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (PWarning -> Position
pwarningPosition (PWarning -> Position)
-> (PWarningWithSource src -> PWarning)
-> PWarningWithSource src
-> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWarningWithSource src -> PWarning
forall src. PWarningWithSource src -> PWarning
pwarning))

-- | Chain parsing operations that involve 'IO' actions.
liftParseResult :: (a -> IO (ParseResult src b)) -> ParseResult src a -> IO (ParseResult src b)
liftParseResult :: forall a src b.
(a -> IO (ParseResult src b))
-> ParseResult src a -> IO (ParseResult src b)
liftParseResult a -> IO (ParseResult src b)
f ParseResult src a
pr = ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
forall src a.
ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
unPR ParseResult src a
pr PRState src
forall src. PRState src
emptyPRState PRContext src
forall {src}. PRContext src
initialCtx PRState src -> IO (ParseResult src b)
forall {m :: * -> *} {src} {a}.
Monad m =>
PRState src -> m (ParseResult src a)
failure PRState src -> a -> IO (ParseResult src b)
success
  where
    initialCtx :: PRContext src
initialCtx = PSource src -> PRContext src
forall src. PSource src -> PRContext src
PRContext PSource src
forall src. PSource src
PUnknownSource

    failure :: PRState src -> m (ParseResult src a)
failure PRState src
s = ParseResult src a -> m (ParseResult src a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseResult src a -> m (ParseResult src a))
-> ParseResult src a -> m (ParseResult src a)
forall a b. (a -> b) -> a -> b
$ (forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
forall src a.
(forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
PR ((forall r.
  PRState src
  -> PRContext src
  -> (PRState src -> r)
  -> (PRState src -> a -> r)
  -> r)
 -> ParseResult src a)
-> (forall r.
    PRState src
    -> PRContext src
    -> (PRState src -> r)
    -> (PRState src -> a -> r)
    -> r)
-> ParseResult src a
forall a b. (a -> b) -> a -> b
$ \PRState src
s' PRContext src
_ctx PRState src -> r
failure' PRState src -> a -> r
_ -> PRState src -> r
failure' (PRState src -> PRState src -> PRState src
forall {src}. PRState src -> PRState src -> PRState src
concatPRState PRState src
s PRState src
s')
    success :: PRState src -> a -> IO (ParseResult src b)
success PRState src
s a
a = do
      pr' <- a -> IO (ParseResult src b)
f a
a
      return $ PR $ \PRState src
s' PRContext src
ctx PRState src -> r
failure' PRState src -> b -> r
success' -> ParseResult src b
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> b -> r)
   -> r
forall src a.
ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
unPR ParseResult src b
pr' (PRState src -> PRState src -> PRState src
forall {src}. PRState src -> PRState src -> PRState src
concatPRState PRState src
s PRState src
s') PRContext src
ctx PRState src -> r
failure' PRState src -> b -> r
success'
    concatPRState :: PRState src -> PRState src -> PRState src
concatPRState (PRState [PWarningWithSource src]
warnings [PErrorWithSource src]
errors Maybe Version
version) (PRState [PWarningWithSource src]
warnings' [PErrorWithSource src]
errors' Maybe Version
version') =
      [PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
forall src.
[PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
PRState ([PWarningWithSource src]
warnings [PWarningWithSource src]
-> [PWarningWithSource src] -> [PWarningWithSource src]
forall a. [a] -> [a] -> [a]
++ [PWarningWithSource src]
warnings') ([PErrorWithSource src] -> [PErrorWithSource src]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [PErrorWithSource src]
errors [PErrorWithSource src]
-> [PErrorWithSource src] -> [PErrorWithSource src]
forall a. [a] -> [a] -> [a]
++ [PErrorWithSource src]
errors') (Maybe Version
version Maybe Version -> Maybe Version -> Maybe Version
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Version
version')

withSource :: src -> ParseResult src a -> ParseResult src a
withSource :: forall src a. src -> ParseResult src a -> ParseResult src a
withSource src
source (PR forall r.
PRState src
-> PRContext src
-> (PRState src -> r)
-> (PRState src -> a -> r)
-> r
pr) = (forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
forall src a.
(forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
PR ((forall r.
  PRState src
  -> PRContext src
  -> (PRState src -> r)
  -> (PRState src -> a -> r)
  -> r)
 -> ParseResult src a)
-> (forall r.
    PRState src
    -> PRContext src
    -> (PRState src -> r)
    -> (PRState src -> a -> r)
    -> r)
-> ParseResult src a
forall a b. (a -> b) -> a -> b
$ \PRState src
s PRContext src
ctx PRState src -> r
failure PRState src -> a -> r
success ->
  PRState src
-> PRContext src
-> (PRState src -> r)
-> (PRState src -> a -> r)
-> r
forall r.
PRState src
-> PRContext src
-> (PRState src -> r)
-> (PRState src -> a -> r)
-> r
pr PRState src
s (PRContext src
ctx{prContextSource = PKnownSource source}) PRState src -> r
failure PRState src -> a -> r
success

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

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

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

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

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

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

  ParseResult src a
m >>= :: forall a b.
ParseResult src a -> (a -> ParseResult src b) -> ParseResult src b
>>= a -> ParseResult src b
k = (forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> b -> r)
 -> r)
-> ParseResult src b
forall src a.
(forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
PR ((forall r.
  PRState src
  -> PRContext src
  -> (PRState src -> r)
  -> (PRState src -> b -> r)
  -> r)
 -> ParseResult src b)
-> (forall r.
    PRState src
    -> PRContext src
    -> (PRState src -> r)
    -> (PRState src -> b -> r)
    -> r)
-> ParseResult src b
forall a b. (a -> b) -> a -> b
$ \ !PRState src
s PRContext src
fp PRState src -> r
failure PRState src -> b -> r
success ->
    ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
forall src a.
ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
unPR ParseResult src a
m PRState src
s PRContext src
fp PRState src -> r
failure ((PRState src -> a -> r) -> r) -> (PRState src -> a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !PRState src
s' a
a ->
      ParseResult src b
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> b -> r)
   -> r
forall src a.
ParseResult src a
-> forall r.
   PRState src
   -> PRContext src
   -> (PRState src -> r)
   -> (PRState src -> a -> r)
   -> r
unPR (a -> ParseResult src b
k a
a) PRState src
s' PRContext src
fp PRState src -> r
failure PRState src -> 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 src a -> a -> ParseResult src a
recoverWith :: forall src a. ParseResult src a -> a -> ParseResult src a
recoverWith (PR forall r.
PRState src
-> PRContext src
-> (PRState src -> r)
-> (PRState src -> a -> r)
-> r
pr) a
x = (forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
forall src a.
(forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
PR ((forall r.
  PRState src
  -> PRContext src
  -> (PRState src -> r)
  -> (PRState src -> a -> r)
  -> r)
 -> ParseResult src a)
-> (forall r.
    PRState src
    -> PRContext src
    -> (PRState src -> r)
    -> (PRState src -> a -> r)
    -> r)
-> ParseResult src a
forall a b. (a -> b) -> a -> b
$ \ !PRState src
s PRContext src
fp PRState src -> r
_failure PRState src -> a -> r
success ->
  PRState src
-> PRContext src
-> (PRState src -> r)
-> (PRState src -> a -> r)
-> r
forall r.
PRState src
-> PRContext src
-> (PRState src -> r)
-> (PRState src -> a -> r)
-> r
pr PRState src
s PRContext src
fp (\ !PRState src
s' -> PRState src -> a -> r
success PRState src
s' a
x) PRState src -> a -> r
success

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

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

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

-- | Add multiple warnings at once.
parseWarnings :: [PWarning] -> ParseResult src ()
parseWarnings :: forall src. [PWarning] -> ParseResult src ()
parseWarnings [PWarning]
newWarns = (forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> () -> r)
 -> r)
-> ParseResult src ()
forall src a.
(forall r.
 PRState src
 -> PRContext src
 -> (PRState src -> r)
 -> (PRState src -> a -> r)
 -> r)
-> ParseResult src a
PR ((forall r.
  PRState src
  -> PRContext src
  -> (PRState src -> r)
  -> (PRState src -> () -> r)
  -> r)
 -> ParseResult src ())
-> (forall r.
    PRState src
    -> PRContext src
    -> (PRState src -> r)
    -> (PRState src -> () -> r)
    -> r)
-> ParseResult src ()
forall a b. (a -> b) -> a -> b
$ \(PRState [PWarningWithSource src]
warns [PErrorWithSource src]
errs Maybe Version
v) PRContext src
ctx PRState src -> r
_failure PRState src -> () -> r
success ->
  PRState src -> () -> r
success ([PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
forall src.
[PWarningWithSource src]
-> [PErrorWithSource src] -> Maybe Version -> PRState src
PRState ((PWarning -> PWarningWithSource src)
-> [PWarning] -> [PWarningWithSource src]
forall a b. (a -> b) -> [a] -> [b]
map (PSource src -> PWarning -> PWarningWithSource src
forall src. PSource src -> PWarning -> PWarningWithSource src
PWarningWithSource (PRContext src -> PSource src
forall src. PRContext src -> PSource src
prContextSource PRContext src
ctx)) [PWarning]
newWarns [PWarningWithSource src]
-> [PWarningWithSource src] -> [PWarningWithSource src]
forall a. [a] -> [a] -> [a]
++ [PWarningWithSource src]
warns) [PErrorWithSource src]
errs Maybe Version
v) ()

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

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

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

    err :: PErrorWithSource src
err = PSource src -> PError -> PErrorWithSource src
forall src. PSource src -> PError -> PErrorWithSource src
PErrorWithSource PSource src
forall src. PSource src
PUnknownSource (Position -> String -> PError
PError Position
zeroPos String
"Unknown fatal error")