{-# language BangPatterns           #-}
{-# language CPP                    #-}
{-# language DeriveFoldable         #-}
{-# language DeriveFunctor          #-}
{-# language DeriveTraversable      #-}
{-# language FlexibleContexts       #-}
{-# language FlexibleInstances      #-}
{-# language FunctionalDependencies #-}
{-# language MultiParamTypeClasses  #-}
{-# language Rank2Types             #-}
{-# language TemplateHaskell        #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) Edward Kmett 2011-2019
-- License     :  BSD3
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
module Text.Trifecta.Parser
  ( Parser(..)
  , manyAccum
  -- * Feeding a parser more more input
  , Step(..)
  , feed
  , starve
  , stepParser
  , stepResult
  , stepIt
  -- * Parsing
  , runParser
  , parseFromFile
  , parseFromFileEx
  , parseString
  , parseByteString
  , parseTest
  ) where

import Control.Applicative as Alternative
import Control.Monad (MonadPlus(..), ap, join)
import Control.Monad.IO.Class
import qualified Control.Monad.Fail as Fail
import Data.ByteString as Strict hiding (empty, snoc)
import Data.ByteString.UTF8 as UTF8
import Data.Maybe (fromMaybe, isJust)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Semigroup.Reducer
-- import Data.Sequence as Seq hiding (empty)
import Data.Set as Set hiding (empty, toList)
import Data.Text.Prettyprint.Doc as Pretty hiding (line)
import System.IO
import Text.Parser.Combinators
import Text.Parser.Char
import Text.Parser.LookAhead
import Text.Parser.Token
import Text.Trifecta.Combinators
import Text.Trifecta.Delta       as Delta
import Text.Trifecta.Rendering
import Text.Trifecta.Result
import Text.Trifecta.Rope
import Text.Trifecta.Util.It
import Text.Trifecta.Util.Pretty

-- | The type of a trifecta parser
--
-- The first four arguments are behavior continuations:
--
--   * epsilon success: the parser has consumed no input and has a result
--     as well as a possible Err; the position and chunk are unchanged
--     (see `pure`)
--
--   * epsilon failure: the parser has consumed no input and is failing
--     with the given Err; the position and chunk are unchanged (see
--     `empty`)
--
--   * committed success: the parser has consumed input and is yielding
--     the result, set of expected strings that would have permitted this
--     parse to continue, new position, and residual chunk to the
--     continuation.
--
--   * committed failure: the parser has consumed input and is failing with
--     a given ErrInfo (user-facing error message)
--
-- The remaining two arguments are
--
--   * the current position
--
--   * the chunk of input currently under analysis
--
-- `Parser` is an `Alternative`; trifecta's backtracking behavior encoded as
-- `<|>` is to behave as the leftmost parser which yields a value
-- (regardless of any input being consumed) or which consumes input and
-- fails.  That is, a choice of parsers will only yield an epsilon failure
-- if *all* parsers in the choice do.  If that is not the desired behavior,
-- see `try`, which turns a committed parser failure into an epsilon failure
-- (at the cost of error information).
newtype Parser a = Parser
  { Parser a
-> forall r.
   (a -> Err -> It Rope r)
   -> (Err -> It Rope r)
   -> (a -> Set String -> Delta -> ByteString -> It Rope r)
   -> (ErrInfo -> It Rope r)
   -> Delta
   -> ByteString
   -> It Rope r
unparser :: forall r.
       (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)  -- committed success
    -> (ErrInfo -> It Rope r)                                 -- committed err
    -> Delta
    -> ByteString
    -> It Rope r
  }

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m) = (forall r.
 (b -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (b -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser b
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (b -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (b -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser b)
-> (forall r.
    (b -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (b -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser b
forall a b. (a -> b) -> a -> b
$ \ b -> Err -> It Rope r
eo Err -> It Rope r
ee b -> Set String -> Delta -> ByteString -> It Rope r
co -> (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m (b -> Err -> It Rope r
eo (b -> Err -> It Rope r) -> (a -> b) -> a -> Err -> It Rope r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Err -> It Rope r
ee (b -> Set String -> Delta -> ByteString -> It Rope r
co (b -> Set String -> Delta -> ByteString -> It Rope r)
-> (a -> b) -> a -> Set String -> Delta -> ByteString -> It Rope r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
  {-# inlinable fmap #-}
  a
a <$ :: a -> Parser b -> Parser a
<$ Parser forall r.
(b -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (b -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
eo Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
co -> (b -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (b -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(b -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (b -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m (\b
_ -> a -> Err -> It Rope r
eo a
a) Err -> It Rope r
ee (\b
_ -> a -> Set String -> Delta -> ByteString -> It Rope r
co a
a)
  {-# inlinable (<$) #-}

instance Applicative Parser where
  pure :: a -> Parser a
pure a
a = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
eo Err -> It Rope r
_ a -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
_ -> a -> Err -> It Rope r
eo a
a Err
forall a. Monoid a => a
mempty
  {-# inlinable pure #-}
  <*> :: Parser (a -> b) -> Parser a -> Parser b
(<*>) = Parser (a -> b) -> Parser a -> Parser b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  {-# inlinable (<*>) #-}

instance Alternative Parser where
  empty :: Parser a
empty = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \a -> Err -> It Rope r
_ Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
_ -> Err -> It Rope r
ee Err
forall a. Monoid a => a
mempty
  {-# inlinable empty #-}
  Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m <|> :: Parser a -> Parser a -> Parser a
<|> Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
n = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
eo Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce Delta
d ByteString
bs ->
    (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m a -> Err -> It Rope r
eo (\Err
e -> (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
n (\a
a Err
e' -> a -> Err -> It Rope r
eo a
a (Err
e Err -> Err -> Err
forall a. Semigroup a => a -> a -> a
<> Err
e')) (\Err
e' -> Err -> It Rope r
ee (Err
e Err -> Err -> Err
forall a. Semigroup a => a -> a -> a
<> Err
e')) a -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce Delta
d ByteString
bs) a -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce Delta
d ByteString
bs
  {-# inlinable (<|>) #-}
  many :: Parser a -> Parser [a]
many Parser a
p = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> [a] -> [a]) -> Parser a -> Parser [a]
forall a. (a -> [a] -> [a]) -> Parser a -> Parser [a]
manyAccum (:) Parser a
p
  {-# inlinable many #-}
  some :: Parser a -> Parser [a]
some Parser a
p = (:) (a -> [a] -> [a]) -> Parser a -> Parser ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p Parser ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Alternative.many Parser a
p

instance Semigroup a => Semigroup (Parser a) where
  <> :: Parser a -> Parser a -> Parser a
(<>) = (a -> a -> a) -> Parser a -> Parser a -> Parser a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# inlinable (<>) #-}

instance (Semigroup a, Monoid a) => Monoid (Parser a) where
  mappend :: Parser a -> Parser a -> Parser a
mappend = Parser a -> Parser a -> Parser a
forall a. Semigroup a => a -> a -> a
(<>)
  {-# inlinable mappend #-}

  mempty :: Parser a
mempty = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  {-# inlinable mempty #-}

instance Monad Parser where
  return :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# inlinable return #-}
  Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
k = (forall r.
 (b -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (b -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser b
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (b -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (b -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser b)
-> (forall r.
    (b -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (b -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser b
forall a b. (a -> b) -> a -> b
$ \ b -> Err -> It Rope r
eo Err -> It Rope r
ee b -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce Delta
d ByteString
bs ->
    (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m -- epsilon result: feed result to monadic continutaion; committed
      -- continuations as they were given to us; epsilon callbacks merge
      -- error information with `<>`
      (\a
a Err
e -> Parser b
-> (b -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (b -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall a.
Parser a
-> forall r.
   (a -> Err -> It Rope r)
   -> (Err -> It Rope r)
   -> (a -> Set String -> Delta -> ByteString -> It Rope r)
   -> (ErrInfo -> It Rope r)
   -> Delta
   -> ByteString
   -> It Rope r
unparser (a -> Parser b
k a
a) (\b
b Err
e' -> b -> Err -> It Rope r
eo b
b (Err
e Err -> Err -> Err
forall a. Semigroup a => a -> a -> a
<> Err
e')) (\Err
e' -> Err -> It Rope r
ee (Err
e Err -> Err -> Err
forall a. Semigroup a => a -> a -> a
<> Err
e')) b -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce Delta
d ByteString
bs)
      -- epsilon error: as given
      Err -> It Rope r
ee
      -- committed result: feed result to monadic continuation and...
      (\a
a Set String
es Delta
d' ByteString
bs' -> Parser b
-> (b -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (b -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall a.
Parser a
-> forall r.
   (a -> Err -> It Rope r)
   -> (Err -> It Rope r)
   -> (a -> Set String -> Delta -> ByteString -> It Rope r)
   -> (ErrInfo -> It Rope r)
   -> Delta
   -> ByteString
   -> It Rope r
unparser (a -> Parser b
k a
a)
         -- epsilon results are now committed results due to m consuming.
         --
         -- epsilon success is now committed success at the new position
         -- (after m), yielding the result from (k a) and merging the
         -- expected sets (i.e. things that could have resulted in a longer
         -- parse)
         (\b
b Err
e' -> b -> Set String -> Delta -> ByteString -> It Rope r
co b
b (Set String
es Set String -> Set String -> Set String
forall a. Semigroup a => a -> a -> a
<> Err -> Set String
_expected Err
e') Delta
d' ByteString
bs')
         -- epsilon failure is now a committed failure at the new position
         -- (after m); compute the error to display to the user
         (\Err
e ->
           let errDoc :: Doc AnsiStyle
errDoc = Rendering -> Err -> Doc AnsiStyle
explain (Delta -> ByteString -> Rendering
renderingCaret Delta
d' ByteString
bs') Err
e { _expected :: Set String
_expected = Err -> Set String
_expected Err
e Set String -> Set String -> Set String
forall a. Semigroup a => a -> a -> a
<> Set String
es }
               errDelta :: [Delta]
errDelta = Err -> [Delta]
_finalDeltas Err
e
           in  ErrInfo -> It Rope r
ce (ErrInfo -> It Rope r) -> ErrInfo -> It Rope r
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> [Delta] -> ErrInfo
ErrInfo Doc AnsiStyle
errDoc (Delta
d' Delta -> [Delta] -> [Delta]
forall a. a -> [a] -> [a]
: [Delta]
errDelta)
         )
         -- committed behaviors as given; nothing exciting here
         b -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce
         -- new position and remaining chunk after m
         Delta
d' ByteString
bs')
      -- committed error, delta, and bytestring: as given
      ErrInfo -> It Rope r
ce Delta
d ByteString
bs
  {-# inlinable (>>=) #-}
  >> :: Parser a -> Parser b -> Parser b
(>>) = Parser a -> Parser b -> Parser b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# inlinable (>>) #-}
#if !(MIN_VERSION_base(4,13,0))
  fail = Fail.fail
  {-# inlinable fail #-}
#endif

instance Fail.MonadFail Parser where
  fail :: String -> Parser a
fail String
s = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
_ Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
_ -> Err -> It Rope r
ee (String -> Err
failed String
s)
  {-# inlinable fail #-}

instance MonadPlus Parser where
  mzero :: Parser a
mzero = Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# inlinable mzero #-}
  mplus :: Parser a -> Parser a -> Parser a
mplus = Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  {-# inlinable mplus #-}

manyAccum :: (a -> [a] -> [a]) -> Parser a -> Parser [a]
manyAccum :: (a -> [a] -> [a]) -> Parser a -> Parser [a]
manyAccum a -> [a] -> [a]
f (Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
p) = (forall r.
 ([a] -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> ([a] -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser [a]
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  ([a] -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> ([a] -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser [a])
-> (forall r.
    ([a] -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> ([a] -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser [a]
forall a b. (a -> b) -> a -> b
$ \[a] -> Err -> It Rope r
eo Err -> It Rope r
_ [a] -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
ce Delta
d ByteString
bs ->
  let walk :: [a] -> a -> Set String -> Delta -> ByteString -> It Rope r
walk [a]
xs a
x Set String
es Delta
d' ByteString
bs' = (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
p (Delta -> ByteString -> a -> Err -> It Rope r
forall p. Delta -> ByteString -> p -> Err -> It Rope r
manyErr Delta
d' ByteString
bs') (\Err
e -> [a] -> Set String -> Delta -> ByteString -> It Rope r
co (a -> [a] -> [a]
f a
x [a]
xs) (Err -> Set String
_expected Err
e Set String -> Set String -> Set String
forall a. Semigroup a => a -> a -> a
<> Set String
es) Delta
d' ByteString
bs') ([a] -> a -> Set String -> Delta -> ByteString -> It Rope r
walk (a -> [a] -> [a]
f a
x [a]
xs)) ErrInfo -> It Rope r
ce Delta
d' ByteString
bs'
      manyErr :: Delta -> ByteString -> p -> Err -> It Rope r
manyErr Delta
d' ByteString
bs' p
_ Err
e  = ErrInfo -> It Rope r
ce (Doc AnsiStyle -> [Delta] -> ErrInfo
ErrInfo Doc AnsiStyle
errDoc [Delta
d'])
        where errDoc :: Doc AnsiStyle
errDoc = Rendering -> Err -> Doc AnsiStyle
explain (Delta -> ByteString -> Rendering
renderingCaret Delta
d' ByteString
bs') (Err
e Err -> Err -> Err
forall a. Semigroup a => a -> a -> a
<> String -> Err
failed String
"'many' applied to a parser that accepted an empty string")
  in (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
p (Delta -> ByteString -> a -> Err -> It Rope r
forall p. Delta -> ByteString -> p -> Err -> It Rope r
manyErr Delta
d ByteString
bs) ([a] -> Err -> It Rope r
eo []) ([a] -> a -> Set String -> Delta -> ByteString -> It Rope r
walk []) ErrInfo -> It Rope r
ce Delta
d ByteString
bs

liftIt :: It Rope a -> Parser a
liftIt :: It Rope a -> Parser a
liftIt It Rope a
m = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
eo Err -> It Rope r
_ a -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
_ -> do
  a
a <- It Rope a
m
  a -> Err -> It Rope r
eo a
a Err
forall a. Monoid a => a
mempty
{-# inlinable liftIt #-}

instance Parsing Parser where
  try :: Parser a -> Parser a
try (Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m) = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
eo Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
_ -> (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m a -> Err -> It Rope r
eo Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
co (\ErrInfo
_ -> Err -> It Rope r
ee Err
forall a. Monoid a => a
mempty)
  {-# inlinable try #-}
  Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m <?> :: Parser a -> String -> Parser a
<?> String
nm = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
eo Err -> It Rope r
ee -> (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m
     (\a
a Err
e -> a -> Err -> It Rope r
eo a
a (if Maybe (Doc AnsiStyle) -> Bool
forall a. Maybe a -> Bool
isJust (Err -> Maybe (Doc AnsiStyle)
_reason Err
e) then Err
e { _expected :: Set String
_expected = String -> Set String
forall a. a -> Set a
Set.singleton String
nm } else Err
e))
     (\Err
e -> Err -> It Rope r
ee Err
e { _expected :: Set String
_expected = String -> Set String
forall a. a -> Set a
Set.singleton String
nm })
  {-# inlinable (<?>) #-}
  skipMany :: Parser a -> Parser ()
skipMany Parser a
p = () () -> Parser [a] -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (a -> [a] -> [a]) -> Parser a -> Parser [a]
forall a. (a -> [a] -> [a]) -> Parser a -> Parser [a]
manyAccum (\a
_ [a]
_ -> []) Parser a
p
  {-# inlinable skipMany #-}
  unexpected :: String -> Parser a
unexpected String
s = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
_ Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
_ -> Err -> It Rope r
ee (Err -> It Rope r) -> Err -> It Rope r
forall a b. (a -> b) -> a -> b
$ String -> Err
failed (String -> Err) -> String -> Err
forall a b. (a -> b) -> a -> b
$ String
"unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
  {-# inlinable unexpected #-}
  eof :: Parser ()
eof = Parser Char -> Parser ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy Parser Char
forall (m :: * -> *). CharParsing m => m Char
anyChar Parser () -> String -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"end of input"
  {-# inlinable eof #-}
  notFollowedBy :: Parser a -> Parser ()
notFollowedBy Parser a
p = Parser () -> Parser ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser a
p Parser (Maybe a) -> (Maybe a -> Parser ()) -> Parser ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Parser () -> (a -> Parser ()) -> Maybe a -> Parser ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (String -> Parser ()
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected (String -> Parser ()) -> (a -> String) -> a -> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show))
  {-# inlinable notFollowedBy #-}

instance Errable Parser where
  raiseErr :: Err -> Parser a
raiseErr Err
e = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \ a -> Err -> It Rope r
_ Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
_ -> Err -> It Rope r
ee Err
e
  {-# inlinable raiseErr #-}

instance LookAheadParsing Parser where
  lookAhead :: Parser a -> Parser a
lookAhead (Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m) = (forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (a -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (a -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser a)
-> (forall r.
    (a -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (a -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser a
forall a b. (a -> b) -> a -> b
$ \a -> Err -> It Rope r
eo Err -> It Rope r
ee a -> Set String -> Delta -> ByteString -> It Rope r
_ -> (a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
m a -> Err -> It Rope r
eo Err -> It Rope r
ee (\a
a Set String
_ Delta
_ ByteString
_ -> a -> Err -> It Rope r
eo a
a Err
forall a. Monoid a => a
mempty)
  {-# inlinable lookAhead #-}

instance CharParsing Parser where
  satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
f = (forall r.
 (Char -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (Char -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser Char
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (Char -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (Char -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser Char)
-> (forall r.
    (Char -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (Char -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser Char
forall a b. (a -> b) -> a -> b
$ \ Char -> Err -> It Rope r
_ Err -> It Rope r
ee Char -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
_ Delta
d ByteString
bs ->
    case ByteString -> Maybe (Char, ByteString)
UTF8.uncons (ByteString -> Maybe (Char, ByteString))
-> ByteString -> Maybe (Char, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
Strict.drop (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Delta -> Int64
columnByte Delta
d)) ByteString
bs of
      Maybe (Char, ByteString)
Nothing        -> Err -> It Rope r
ee (String -> Err
failed String
"unexpected EOF")
      Just (Char
c, ByteString
xs)
        | Bool -> Bool
not (Char -> Bool
f Char
c)       -> Err -> It Rope r
ee Err
forall a. Monoid a => a
mempty
        | ByteString -> Bool
Strict.null ByteString
xs  -> let !ddc :: Delta
ddc = Delta
d Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Char -> Delta
forall t. HasDelta t => t -> Delta
delta Char
c
                             in It Rope (It Rope r) -> It Rope r
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (It Rope (It Rope r) -> It Rope r)
-> It Rope (It Rope r) -> It Rope r
forall a b. (a -> b) -> a -> b
$ It Rope r
-> (Delta -> ByteString -> It Rope r)
-> Delta
-> It Rope (It Rope r)
forall r. r -> (Delta -> ByteString -> r) -> Delta -> It Rope r
fillIt (Char -> Set String -> Delta -> ByteString -> It Rope r
co Char
c Set String
forall a. Monoid a => a
mempty Delta
ddc (if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then ByteString
forall a. Monoid a => a
mempty else ByteString
bs))
                                              (Char -> Set String -> Delta -> ByteString -> It Rope r
co Char
c Set String
forall a. Monoid a => a
mempty)
                                              Delta
ddc
        | Bool
otherwise       -> Char -> Set String -> Delta -> ByteString -> It Rope r
co Char
c Set String
forall a. Monoid a => a
mempty (Delta
d Delta -> Delta -> Delta
forall a. Semigroup a => a -> a -> a
<> Char -> Delta
forall t. HasDelta t => t -> Delta
delta Char
c) ByteString
bs
  {-# inlinable satisfy #-}

instance TokenParsing Parser

instance DeltaParsing Parser where
  line :: Parser ByteString
line = (forall r.
 (ByteString -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (ByteString -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser ByteString
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (ByteString -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (ByteString -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser ByteString)
-> (forall r.
    (ByteString -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (ByteString -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser ByteString
forall a b. (a -> b) -> a -> b
$ \ByteString -> Err -> It Rope r
eo Err -> It Rope r
_ ByteString -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
_ ByteString
bs -> ByteString -> Err -> It Rope r
eo ByteString
bs Err
forall a. Monoid a => a
mempty
  {-# inlinable line #-}
  position :: Parser Delta
position = (forall r.
 (Delta -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (Delta -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser Delta
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (Delta -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (Delta -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser Delta)
-> (forall r.
    (Delta -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (Delta -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser Delta
forall a b. (a -> b) -> a -> b
$ \Delta -> Err -> It Rope r
eo Err -> It Rope r
_ Delta -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
d ByteString
_ -> Delta -> Err -> It Rope r
eo Delta
d Err
forall a. Monoid a => a
mempty
  {-# inlinable position #-}
  rend :: Parser Rendering
rend = (forall r.
 (Rendering -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (Rendering -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser Rendering
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (Rendering -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (Rendering -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser Rendering)
-> (forall r.
    (Rendering -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (Rendering -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser Rendering
forall a b. (a -> b) -> a -> b
$ \Rendering -> Err -> It Rope r
eo Err -> It Rope r
_ Rendering -> Set String -> Delta -> ByteString -> It Rope r
_ ErrInfo -> It Rope r
_ Delta
d ByteString
bs -> Rendering -> Err -> It Rope r
eo (Delta -> ByteString -> Rendering
forall s. Source s => Delta -> s -> Rendering
rendered Delta
d ByteString
bs) Err
forall a. Monoid a => a
mempty
  {-# inlinable rend #-}
  slicedWith :: (a -> ByteString -> r) -> Parser a -> Parser r
slicedWith a -> ByteString -> r
f Parser a
p = do
    Delta
m <- Parser Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
    a
a <- Parser a
p
    Delta
r <- Parser Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
    a -> ByteString -> r
f a
a (ByteString -> r) -> Parser ByteString -> Parser r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> It Rope ByteString -> Parser ByteString
forall a. It Rope a -> Parser a
liftIt (Delta -> Delta -> It Rope ByteString
sliceIt Delta
m Delta
r)
  {-# inlinable slicedWith #-}

instance MarkParsing Delta Parser where
  mark :: Parser Delta
mark = Parser Delta
forall (m :: * -> *). DeltaParsing m => m Delta
position
  {-# inlinable mark #-}
  release :: Delta -> Parser ()
release Delta
d' = (forall r.
 (() -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (() -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser ()
forall a.
(forall r.
 (a -> Err -> It Rope r)
 -> (Err -> It Rope r)
 -> (a -> Set String -> Delta -> ByteString -> It Rope r)
 -> (ErrInfo -> It Rope r)
 -> Delta
 -> ByteString
 -> It Rope r)
-> Parser a
Parser ((forall r.
  (() -> Err -> It Rope r)
  -> (Err -> It Rope r)
  -> (() -> Set String -> Delta -> ByteString -> It Rope r)
  -> (ErrInfo -> It Rope r)
  -> Delta
  -> ByteString
  -> It Rope r)
 -> Parser ())
-> (forall r.
    (() -> Err -> It Rope r)
    -> (Err -> It Rope r)
    -> (() -> Set String -> Delta -> ByteString -> It Rope r)
    -> (ErrInfo -> It Rope r)
    -> Delta
    -> ByteString
    -> It Rope r)
-> Parser ()
forall a b. (a -> b) -> a -> b
$ \() -> Err -> It Rope r
_ Err -> It Rope r
ee () -> Set String -> Delta -> ByteString -> It Rope r
co ErrInfo -> It Rope r
_ Delta
d ByteString
bs -> do
    Maybe ByteString
mbs <- Delta -> It Rope (Maybe ByteString)
rewindIt Delta
d'
    case Maybe ByteString
mbs of
      Just ByteString
bs' -> () -> Set String -> Delta -> ByteString -> It Rope r
co () Set String
forall a. Monoid a => a
mempty Delta
d' ByteString
bs'
      Maybe ByteString
Nothing
        | Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes Delta
d' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Delta -> Int64
forall t. HasBytes t => t -> Int64
bytes (Delta -> Delta
rewind Delta
d) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
Strict.length ByteString
bs) -> if Delta -> Delta -> Bool
forall s t. (HasDelta s, HasDelta t) => s -> t -> Bool
near Delta
d Delta
d'
            then () -> Set String -> Delta -> ByteString -> It Rope r
co () Set String
forall a. Monoid a => a
mempty Delta
d' ByteString
bs
            else () -> Set String -> Delta -> ByteString -> It Rope r
co () Set String
forall a. Monoid a => a
mempty Delta
d' ByteString
forall a. Monoid a => a
mempty
        | Bool
otherwise -> Err -> It Rope r
ee Err
forall a. Monoid a => a
mempty

-- | A 'Step' allows for incremental parsing, since the parser
--
--   - can be done with a final result
--   - have errored
--   - can have yielded a partial result with possibly more to come
data Step a
  = StepDone !Rope a
    -- ^ Parsing is done and has converted the 'Rope' to a final result

  | StepFail !Rope ErrInfo
    -- ^ Parsing the 'Rope' has failed with an error

  | StepCont !Rope (Result a) (Rope -> Step a)
    -- ^ The 'Rope' has been partially consumed and already yielded a 'Result',
    -- and if more input is provided, more results can be produced.
    --
    -- One common scenario for this is to parse log files: after parsing a
    -- single line, that data can already be worked with, but there may be more
    -- lines to come.

instance Show a => Show (Step a) where
  showsPrec :: Int -> Step a -> String -> String
showsPrec Int
d (StepDone Rope
r a
a) = Bool -> (String -> String) -> String -> String
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    String -> String -> String
showString String
"StepDone " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rope -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Rope
r (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 a
a
  showsPrec Int
d (StepFail Rope
r ErrInfo
xs) = Bool -> (String -> String) -> String -> String
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    String -> String -> String
showString String
"StepFail " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rope -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Rope
r (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ErrInfo -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 ErrInfo
xs
  showsPrec Int
d (StepCont Rope
r Result a
fin Rope -> Step a
_) = Bool -> (String -> String) -> String -> String
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
    String -> String -> String
showString String
"StepCont " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rope -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Rope
r (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String -> String
showChar Char
' ' (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Result a -> String -> String
forall a. Show a => Int -> a -> String -> String
showsPrec Int
11 Result a
fin (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
showString String
" ..."

instance Functor Step where
  fmap :: (a -> b) -> Step a -> Step b
fmap a -> b
f (StepDone Rope
r a
a)    = Rope -> b -> Step b
forall a. Rope -> a -> Step a
StepDone Rope
r (a -> b
f a
a)
  fmap a -> b
_ (StepFail Rope
r ErrInfo
xs)   = Rope -> ErrInfo -> Step b
forall a. Rope -> ErrInfo -> Step a
StepFail Rope
r ErrInfo
xs
  fmap a -> b
f (StepCont Rope
r Result a
z Rope -> Step a
k)  = Rope -> Result b -> (Rope -> Step b) -> Step b
forall a. Rope -> Result a -> (Rope -> Step a) -> Step a
StepCont Rope
r ((a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Result a
z) ((a -> b) -> Step a -> Step b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Step a -> Step b) -> (Rope -> Step a) -> Rope -> Step b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Step a
k)

-- | Feed some additional input to a 'Step' to continue parsing a bit further.
feed :: Reducer t Rope => t -> Step r -> Step r
feed :: t -> Step r -> Step r
feed t
t (StepDone Rope
r r
a)    = Rope -> r -> Step r
forall a. Rope -> a -> Step a
StepDone (Rope -> t -> Rope
forall c m. Reducer c m => m -> c -> m
snoc Rope
r t
t) r
a
feed t
t (StepFail Rope
r ErrInfo
xs)   = Rope -> ErrInfo -> Step r
forall a. Rope -> ErrInfo -> Step a
StepFail (Rope -> t -> Rope
forall c m. Reducer c m => m -> c -> m
snoc Rope
r t
t) ErrInfo
xs
feed t
t (StepCont Rope
r Result r
_ Rope -> Step r
k)  = Rope -> Step r
k (Rope -> t -> Rope
forall c m. Reducer c m => m -> c -> m
snoc Rope
r t
t)
{-# inlinable feed #-}

-- | Assume all possible input has been given to the parser, execute it to yield
-- a final result.
starve :: Step a -> Result a
starve :: Step a -> Result a
starve (StepDone Rope
_ a
a)    = a -> Result a
forall a. a -> Result a
Success a
a
starve (StepFail Rope
_ ErrInfo
xs)   = ErrInfo -> Result a
forall a. ErrInfo -> Result a
Failure ErrInfo
xs
starve (StepCont Rope
_ Result a
z Rope -> Step a
_)  = Result a
z
{-# inlinable starve #-}

stepResult :: Rope -> Result a -> Step a
stepResult :: Rope -> Result a -> Step a
stepResult Rope
r (Success a
a)  = Rope -> a -> Step a
forall a. Rope -> a -> Step a
StepDone Rope
r a
a
stepResult Rope
r (Failure ErrInfo
xs) = Rope -> ErrInfo -> Step a
forall a. Rope -> ErrInfo -> Step a
StepFail Rope
r ErrInfo
xs
{-# inlinable stepResult #-}

stepIt :: It Rope a -> Step a
stepIt :: It Rope a -> Step a
stepIt = Rope -> It Rope a -> Step a
forall a. Rope -> It Rope a -> Step a
go Rope
forall a. Monoid a => a
mempty where
  go :: Rope -> It Rope a -> Step a
go Rope
r It Rope a
m = case It Rope a -> Rope -> It Rope a
forall r a. It r a -> r -> It r a
simplifyIt It Rope a
m Rope
r of
    Pure a
a -> Rope -> a -> Step a
forall a. Rope -> a -> Step a
StepDone Rope
r a
a
    It a
a Rope -> It Rope a
k -> Rope -> Result a -> (Rope -> Step a) -> Step a
forall a. Rope -> Result a -> (Rope -> Step a) -> Step a
StepCont Rope
r (a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) ((Rope -> Step a) -> Step a) -> (Rope -> Step a) -> Step a
forall a b. (a -> b) -> a -> b
$ \Rope
r' -> Rope -> It Rope a -> Step a
go Rope
r' (Rope -> It Rope a
k Rope
r')
{-# inlinable stepIt #-}

data Stepping a
  = EO a Err
  | EE Err
  | CO a (Set String) Delta ByteString
  | CE ErrInfo

-- | Incremental parsing. A 'Step' can be supplied with new input using 'feed',
-- the final 'Result' is obtained using 'starve'.
stepParser
    :: Parser a
    -> Delta -- ^ Starting cursor position. Usually 'mempty' for the beginning of the file.
    -> Step a
stepParser :: Parser a -> Delta -> Step a
stepParser (Parser forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
p) Delta
d0 = Step (Result a) -> Step a
forall a. Step (Result a) -> Step a
joinStep (Step (Result a) -> Step a) -> Step (Result a) -> Step a
forall a b. (a -> b) -> a -> b
$ It Rope (Result a) -> Step (Result a)
forall a. It Rope a -> Step a
stepIt (It Rope (Result a) -> Step (Result a))
-> It Rope (Result a) -> Step (Result a)
forall a b. (a -> b) -> a -> b
$ do
  ByteString
bs0 <- ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
forall a. Monoid a => a
mempty (Maybe ByteString -> ByteString)
-> It Rope (Maybe ByteString) -> It Rope ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delta -> It Rope (Maybe ByteString)
rewindIt Delta
d0
  ByteString -> Stepping a -> Result a
forall a. ByteString -> Stepping a -> Result a
go ByteString
bs0 (Stepping a -> Result a)
-> It Rope (Stepping a) -> It Rope (Result a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Err -> It Rope (Stepping a))
-> (Err -> It Rope (Stepping a))
-> (a -> Set String -> Delta -> ByteString -> It Rope (Stepping a))
-> (ErrInfo -> It Rope (Stepping a))
-> Delta
-> ByteString
-> It Rope (Stepping a)
forall r.
(a -> Err -> It Rope r)
-> (Err -> It Rope r)
-> (a -> Set String -> Delta -> ByteString -> It Rope r)
-> (ErrInfo -> It Rope r)
-> Delta
-> ByteString
-> It Rope r
p a -> Err -> It Rope (Stepping a)
forall a r. a -> Err -> It r (Stepping a)
eo Err -> It Rope (Stepping a)
forall r a. Err -> It r (Stepping a)
ee a -> Set String -> Delta -> ByteString -> It Rope (Stepping a)
forall a r.
a -> Set String -> Delta -> ByteString -> It r (Stepping a)
co ErrInfo -> It Rope (Stepping a)
forall r a. ErrInfo -> It r (Stepping a)
ce Delta
d0 ByteString
bs0
 where
  eo :: a -> Err -> It r (Stepping a)
eo a
a Err
e        = Stepping a -> It r (Stepping a)
forall r a. a -> It r a
Pure (a -> Err -> Stepping a
forall a. a -> Err -> Stepping a
EO a
a Err
e)
  ee :: Err -> It r (Stepping a)
ee Err
e          = Stepping a -> It r (Stepping a)
forall r a. a -> It r a
Pure (Err -> Stepping a
forall a. Err -> Stepping a
EE Err
e)
  co :: a -> Set String -> Delta -> ByteString -> It r (Stepping a)
co a
a Set String
es Delta
d' ByteString
bs = Stepping a -> It r (Stepping a)
forall r a. a -> It r a
Pure (a -> Set String -> Delta -> ByteString -> Stepping a
forall a. a -> Set String -> Delta -> ByteString -> Stepping a
CO a
a Set String
es Delta
d' ByteString
bs)
  ce :: ErrInfo -> It r (Stepping a)
ce ErrInfo
errInf     = Stepping a -> It r (Stepping a)
forall r a. a -> It r a
Pure (ErrInfo -> Stepping a
forall a. ErrInfo -> Stepping a
CE ErrInfo
errInf)

  go :: ByteString -> Stepping a -> Result a
  go :: ByteString -> Stepping a -> Result a
go ByteString
_   (EO a
a Err
_)     = a -> Result a
forall a. a -> Result a
Success a
a
  go ByteString
bs0 (EE Err
e)       = ErrInfo -> Result a
forall a. ErrInfo -> Result a
Failure (ErrInfo -> Result a) -> ErrInfo -> Result a
forall a b. (a -> b) -> a -> b
$
                          let errDoc :: Doc AnsiStyle
errDoc = Rendering -> Err -> Doc AnsiStyle
explain (Delta -> ByteString -> Rendering
renderingCaret Delta
d0 ByteString
bs0) Err
e
                          in  Doc AnsiStyle -> [Delta] -> ErrInfo
ErrInfo Doc AnsiStyle
errDoc (Delta
d0 Delta -> [Delta] -> [Delta]
forall a. a -> [a] -> [a]
: Err -> [Delta]
_finalDeltas Err
e)
  go ByteString
_   (CO a
a Set String
_ Delta
_ ByteString
_) = a -> Result a
forall a. a -> Result a
Success a
a
  go ByteString
_   (CE ErrInfo
e)       = ErrInfo -> Result a
forall a. ErrInfo -> Result a
Failure ErrInfo
e

  joinStep :: Step (Result a) -> Step a
  joinStep :: Step (Result a) -> Step a
joinStep (StepDone Rope
r (Success a
a)) = Rope -> a -> Step a
forall a. Rope -> a -> Step a
StepDone Rope
r a
a
  joinStep (StepDone Rope
r (Failure ErrInfo
e)) = Rope -> ErrInfo -> Step a
forall a. Rope -> ErrInfo -> Step a
StepFail Rope
r ErrInfo
e
  joinStep (StepFail Rope
r ErrInfo
e)           = Rope -> ErrInfo -> Step a
forall a. Rope -> ErrInfo -> Step a
StepFail Rope
r ErrInfo
e
  joinStep (StepCont Rope
r Result (Result a)
a Rope -> Step (Result a)
k)         = Rope -> Result a -> (Rope -> Step a) -> Step a
forall a. Rope -> Result a -> (Rope -> Step a) -> Step a
StepCont Rope
r (Result (Result a) -> Result a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Result (Result a)
a) (Step (Result a) -> Step a
forall a. Step (Result a) -> Step a
joinStep (Step (Result a) -> Step a)
-> (Rope -> Step (Result a)) -> Rope -> Step a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rope -> Step (Result a)
k)
  {-# inlinable joinStep #-}

-- | Run a 'Parser' on input that can be reduced to a 'Rope', e.g. 'String', or
-- 'ByteString'. See also the monomorphic versions 'parseString' and
-- 'parseByteString'.
runParser
    :: Reducer t Rope
    => Parser a
    -> Delta -- ^ Starting cursor position. Usually 'mempty' for the beginning of the file.
    -> t
    -> Result a
runParser :: Parser a -> Delta -> t -> Result a
runParser Parser a
p Delta
d t
bs = Step a -> Result a
forall a. Step a -> Result a
starve (Step a -> Result a) -> Step a -> Result a
forall a b. (a -> b) -> a -> b
$ t -> Step a -> Step a
forall t r. Reducer t Rope => t -> Step r -> Step r
feed t
bs (Step a -> Step a) -> Step a -> Step a
forall a b. (a -> b) -> a -> b
$ Parser a -> Delta -> Step a
forall a. Parser a -> Delta -> Step a
stepParser Parser a
p Delta
d
{-# inlinable runParser #-}

-- | @('parseFromFile' p filePath)@ runs a parser @p@ on the input read from
-- @filePath@ using 'ByteString.readFile'. All diagnostic messages emitted over
-- the course of the parse attempt are shown to the user on the console.
--
-- > main = do
-- >   result <- parseFromFile numbers "digits.txt"
-- >   case result of
-- >     Nothing -> return ()
-- >     Just a  -> print $ sum a
parseFromFile :: MonadIO m => Parser a -> String -> m (Maybe a)
parseFromFile :: Parser a -> String -> m (Maybe a)
parseFromFile Parser a
p String
fn = do
  Result a
result <- Parser a -> String -> m (Result a)
forall (m :: * -> *) a.
MonadIO m =>
Parser a -> String -> m (Result a)
parseFromFileEx Parser a
p String
fn
  case Result a
result of
   Success a
a  -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
   Failure ErrInfo
xs -> do
     IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> SimpleDocStream AnsiStyle -> IO ()
renderIO Handle
stdout (SimpleDocStream AnsiStyle -> IO ())
-> SimpleDocStream AnsiStyle -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
renderPretty Double
0.8 Int
80 (Doc AnsiStyle -> SimpleDocStream AnsiStyle)
-> Doc AnsiStyle -> SimpleDocStream AnsiStyle
forall a b. (a -> b) -> a -> b
$ (ErrInfo -> Doc AnsiStyle
_errDoc ErrInfo
xs) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line'
     Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | @('parseFromFileEx' p filePath)@ runs a parser @p@ on the input read from
-- @filePath@ using 'ByteString.readFile'. Returns all diagnostic messages
-- emitted over the course of the parse and the answer if the parse was
-- successful.
--
-- > main = do
-- >   result <- parseFromFileEx (many number) "digits.txt"
-- >   case result of
-- >     Failure xs -> displayLn xs
-- >     Success a  -> print (sum a)
parseFromFileEx :: MonadIO m => Parser a -> String -> m (Result a)
parseFromFileEx :: Parser a -> String -> m (Result a)
parseFromFileEx Parser a
p String
fn = do
  ByteString
s <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
Strict.readFile String
fn
  Result a -> m (Result a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Result a -> m (Result a)) -> Result a -> m (Result a)
forall a b. (a -> b) -> a -> b
$ Parser a -> Delta -> ByteString -> Result a
forall a. Parser a -> Delta -> ByteString -> Result a
parseByteString Parser a
p (ByteString -> Int64 -> Int64 -> Int64 -> Int64 -> Delta
Directed (String -> ByteString
UTF8.fromString String
fn) Int64
0 Int64
0 Int64
0 Int64
0) ByteString
s

-- | Fully parse a 'UTF8.ByteString' to a 'Result'.
--
-- @parseByteString p delta i@ runs a parser @p@ on @i@.
parseByteString
    :: Parser a
    -> Delta -- ^ Starting cursor position. Usually 'mempty' for the beginning of the file.
    -> UTF8.ByteString
    -> Result a
parseByteString :: Parser a -> Delta -> ByteString -> Result a
parseByteString = Parser a -> Delta -> ByteString -> Result a
forall t a. Reducer t Rope => Parser a -> Delta -> t -> Result a
runParser

-- | Fully parse a 'String' to a 'Result'.
--
-- @parseByteString p delta i@ runs a parser @p@ on @i@.
parseString
    :: Parser a
    -> Delta -- ^ Starting cursor position. Usually 'mempty' for the beginning of the file.
    -> String
    -> Result a
parseString :: Parser a -> Delta -> String -> Result a
parseString = Parser a -> Delta -> String -> Result a
forall t a. Reducer t Rope => Parser a -> Delta -> t -> Result a
runParser

parseTest :: (MonadIO m, Show a) => Parser a -> String -> m ()
parseTest :: Parser a -> String -> m ()
parseTest Parser a
p String
s = case Parser a -> Delta -> ByteString -> Result a
forall a. Parser a -> Delta -> ByteString -> Result a
parseByteString Parser a
p Delta
forall a. Monoid a => a
mempty (String -> ByteString
UTF8.fromString String
s) of
  Failure ErrInfo
xs -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> SimpleDocStream AnsiStyle -> IO ()
renderIO Handle
stdout (SimpleDocStream AnsiStyle -> IO ())
-> SimpleDocStream AnsiStyle -> IO ()
forall a b. (a -> b) -> a -> b
$ Double -> Int -> Doc AnsiStyle -> SimpleDocStream AnsiStyle
renderPretty Double
0.8 Int
80 (Doc AnsiStyle -> SimpleDocStream AnsiStyle)
-> Doc AnsiStyle -> SimpleDocStream AnsiStyle
forall a b. (a -> b) -> a -> b
$ (ErrInfo -> Doc AnsiStyle
_errDoc ErrInfo
xs) Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line' -- TODO: retrieve columns
  Success a
a  -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO ()
forall a. Show a => a -> IO ()
print a
a)