{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DeriveFunctor, StandaloneDeriving, NamedFieldPuns, CPP #-}
#include "portable-unlifted.h"
{-# OPTIONS_HADDOCK hide #-}
{-|
Module      : Text.Gigaparsec.Internal
Description : Internals of Gigaparsec
License     : BSD-3-Clause
Maintainer  : Jamie Willis, Gigaparsec Maintainers
Stability   : unstable

This module does __not__ adhere to PVP, and can change at any time as
required by the maintainers of the library. Use this functionality at your
own risk.

@since 0.1.0.0
-}
module Text.Gigaparsec.Internal (module Text.Gigaparsec.Internal) where

import Control.Monad.RT (RT)
import Text.Gigaparsec.Internal.Errors (Error, Hints, ExpectItem, CaretWidth)
import Text.Gigaparsec.Internal.Errors qualified as Errors (
    emptyErr, expectedErr, specialisedErr, mergeErr, unexpectedErr,
    isExpectedEmpty, presentationOffset, useHints, DefuncHints(Blank), addError
  )

import Control.Applicative (Applicative(liftA2), Alternative(empty, (<|>), many, some)) -- liftA2 required until 9.6
import Control.Selective (Selective(select))

import Data.Set (Set)

CPP_import_PortableUnlifted

{-
Notes:

We are making a stripped back implementation, where there are way fewer generalisations
on the type: for now, no monad transformers, generalised input types, etc etc.
For consistency with other libraries, this is usually called `Parsec`.

Experimentally, it seems like dual-continuation implementations may be
faster than quad-continuation implementations. This will need some more
investigation and benchmarking to be sure about this however. We'll get a
core representation settled before doing any "hard" work (the composite
combinator API, however, can be done whenever).
-}

{-|
This type represents parsers as a first-class value.

Values of this type are constructed using the library's combinators, to build
up a final 'Parsec' value that can be passed to 'Text.Gigaparsec.parse' or one
of the similar functions. This is implemented internally similar to other
libraries like @parsec@ and @gigaparsec@.

@since 0.1.0.0
-}
type Parsec :: * -> *
newtype Parsec a = Parsec {
    forall a.
Parsec a
-> forall r.
   State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
unParsec :: forall r. State
             -> (a -> State -> RT r)     -- the good continuation
             -> (Error -> State -> RT r) -- the bad continuation
             -> RT r
  }

-- | @since 0.1.0.0
deriving stock instance Functor Parsec -- not clear if there is a point to implementing this

-- | @since 0.1.0.0
instance Applicative Parsec where
  pure :: a -> Parsec a
  pure :: forall a. a -> Parsec a
pure a
x = (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
ok Error -> State -> RT r
_ -> a -> State -> RT r
ok a
x State
st
  -- Continue with x and no input consumed.

  liftA2 :: (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
  liftA2 :: forall a b c. (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
liftA2 a -> b -> c
f (Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) (Parsec forall r.
State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q) = (forall r.
 State -> (c -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec c
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (c -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec c)
-> (forall r.
    State -> (c -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec c
forall a b. (a -> b) -> a -> b
$ \State
st c -> State -> RT r
ok Error -> State -> RT r
err ->
    let ok' :: a -> State -> RT r
ok' a
x State
st' = State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q State
st' (c -> State -> RT r
ok (c -> State -> RT r) -> (b -> c) -> b -> State -> RT r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
f a
x) Error -> State -> RT r
err
    --                    ^^^^^^^^^^
    -- continue with (f x y), where y is the output of q
    in  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
ok' Error -> State -> RT r
err

  (*>) :: Parsec a -> Parsec b -> Parsec b
  *> :: forall a b. Parsec a -> Parsec b -> Parsec b
(*>) = (a -> b -> b) -> Parsec a -> Parsec b -> Parsec b
forall a b c. (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((b -> b) -> a -> b -> b
forall a b. a -> b -> a
const b -> b
forall a. a -> a
id)

  (<*) :: Parsec a -> Parsec b -> Parsec a
  <* :: forall a b. Parsec a -> Parsec b -> Parsec a
(<*) = (a -> b -> a) -> Parsec a -> Parsec b -> Parsec a
forall a b c. (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> a
forall a b. a -> b -> a
const

  {-# INLINE pure #-}
  {-# INLINE liftA2 #-}
  {-# INLINE (<*) #-}
  {-# INLINE (*>) #-}

-- | @since 0.1.0.0
instance Selective Parsec where
  select :: Parsec (Either a b) -> Parsec (a -> b) -> Parsec b
  select :: forall a b. Parsec (Either a b) -> Parsec (a -> b) -> Parsec b
select Parsec (Either a b)
p Parsec (a -> b)
q = Parsec (Either a b)
-> Parsec (a -> b) -> Parsec (b -> b) -> Parsec b
forall a b c.
Parsec (Either a b)
-> Parsec (a -> c) -> Parsec (b -> c) -> Parsec c
_branch Parsec (Either a b)
p Parsec (a -> b)
q ((b -> b) -> Parsec (b -> b)
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b -> b
forall a. a -> a
id)

  {-# INLINE select #-}

{-# INLINE _branch #-}
{-|
This is an internal implementation of `branch`, which is more efficient than
the Selective default `branch`. We should be using this internally, and it
can be dropped if https://github.com/snowleopard/selective/issues/74 is implemented.
-}
_branch :: Parsec (Either a b) -> Parsec (a -> c) -> Parsec (b -> c) -> Parsec c
_branch :: forall a b c.
Parsec (Either a b)
-> Parsec (a -> c) -> Parsec (b -> c) -> Parsec c
_branch (Parsec forall r.
State
-> (Either a b -> State -> RT r)
-> (Error -> State -> RT r)
-> RT r
p) (Parsec forall r.
State
-> ((a -> c) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q1) (Parsec forall r.
State
-> ((b -> c) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q2) = (forall r.
 State -> (c -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec c
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (c -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec c)
-> (forall r.
    State -> (c -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec c
forall a b. (a -> b) -> a -> b
$ \State
st c -> State -> RT r
ok Error -> State -> RT r
err ->
  let ok' :: Either a b -> State -> RT r
ok' Either a b
x State
st' = case Either a b
x of
        Left a
a  -> State
-> ((a -> c) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State
-> ((a -> c) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q1 State
st' (c -> State -> RT r
ok (c -> State -> RT r)
-> ((a -> c) -> c) -> (a -> c) -> State -> RT r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> c) -> a -> c
forall a b. (a -> b) -> a -> b
$ a
a)) Error -> State -> RT r
err
        --                ^^^^^^^^^^^^
        Right b
b -> State
-> ((b -> c) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State
-> ((b -> c) -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q2 State
st' (c -> State -> RT r
ok (c -> State -> RT r)
-> ((b -> c) -> c) -> (b -> c) -> State -> RT r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b -> c) -> b -> c
forall a b. (a -> b) -> a -> b
$ b
b)) Error -> State -> RT r
err
        --                ^^^^^^^^^^^^
        -- feed a/b to the function of the good continuation
  in  State
-> (Either a b -> State -> RT r)
-> (Error -> State -> RT r)
-> RT r
forall r.
State
-> (Either a b -> State -> RT r)
-> (Error -> State -> RT r)
-> RT r
p State
st Either a b -> State -> RT r
ok' Error -> State -> RT r
err

-- | @since 0.1.0.0
instance Monad Parsec where
  return :: a -> Parsec a
  return :: forall a. a -> Parsec a
return = a -> Parsec a
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  (>>=) :: Parsec a -> (a -> Parsec b) -> Parsec b
  Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p >>= :: forall a b. Parsec a -> (a -> Parsec b) -> Parsec b
>>= a -> Parsec b
f = (forall r.
 State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec b)
-> (forall r.
    State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec b
forall a b. (a -> b) -> a -> b
$ \State
st b -> State -> RT r
ok Error -> State -> RT r
err ->
    let ok' :: a -> State -> RT r
ok' a
x State
st' = Parsec b
-> forall r.
   State -> (b -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall a.
Parsec a
-> forall r.
   State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
unParsec (a -> Parsec b
f a
x) State
st' b -> State -> RT r
ok Error -> State -> RT r
err
    --              ^^^^^^^^^^^^^^
    -- get the parser obtained from feeding the output of p to f
    in  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
ok' Error -> State -> RT r
err

  (>>) :: Parsec a -> Parsec b -> Parsec b
  >> :: forall a b. Parsec a -> Parsec b -> Parsec b
(>>) = Parsec a -> Parsec b -> Parsec b
forall a b. Parsec a -> Parsec b -> Parsec b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)

  {-# INLINE return #-}
  {-# INLINE (>>=) #-}

raise :: (State -> Error) -> Parsec a
raise :: forall a. (State -> Error) -> Parsec a
raise State -> Error
mkErr = (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
_ Error -> State -> RT r
bad -> (Error -> State -> RT r) -> Error -> State -> RT r
forall r. (Error -> State -> RT r) -> Error -> State -> RT r
useHints Error -> State -> RT r
bad (State -> Error
mkErr State
st) State
st

-- | @since 0.1.0.0
instance Alternative Parsec where
  empty :: Parsec a
  empty :: forall a. Parsec a
empty = (State -> Error) -> Parsec a
forall a. (State -> Error) -> Parsec a
raise (State -> Word -> Error
`emptyErr` Word
0)

  -- FIXME: I feel like there is something missing here with hint merging from ctx.mergeHints
  -- if the hint stack is not real then it lives in the continuation trace, but I don't know... which
  (<|>) :: Parsec a -> Parsec a -> Parsec a
  Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p <|> :: forall a. Parsec a -> Parsec a -> Parsec a
<|> Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q = (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
ok Error -> State -> RT r
bad ->
    let bad' :: Error -> State -> RT r
bad' Error
err State
st'
          | State -> Word
consumed State
st' Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> State -> Word
consumed State
st = Error -> State -> RT r
bad Error
err State
st'
          --  ^ fail if p failed *and* consumed
          | Bool
otherwise    = State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
q State
st' (\a
x State
st'' -> a -> State -> RT r
ok a
x (State -> Error -> State
errorToHints State
st'' Error
err))
                                 (\Error
err' -> Error -> State -> RT r
bad (Error -> Error -> Error
Errors.mergeErr Error
err Error
err'))
    in  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
ok Error -> State -> RT r
bad'

  many :: Parsec a -> Parsec [a]
  many :: forall a. Parsec a -> Parsec [a]
many = (a -> [a] -> [a]) -> [a] -> Parsec a -> Parsec [a]
forall a b. (a -> b -> b) -> b -> Parsec a -> Parsec b
manyr (:) []

  some :: Parsec a -> Parsec [a]
  some :: forall a. Parsec a -> Parsec [a]
some = (a -> [a] -> [a]) -> [a] -> Parsec a -> Parsec [a]
forall a b. (a -> b -> b) -> b -> Parsec a -> Parsec b
somer (:) []

  {-# INLINE empty #-}
  {-# INLINE (<|>) #-}
  {-# INLINE many #-}
  {-# INLINE some #-}

{-|
This combinator will parse the given parser @p@ __zero__ or more times,
combining the results with the function @f@ and base value @k@ from the right.

@p@ will continue to be parsed until it fails having __not consumed__ input.
All of the results generated by the successful parses are then combined in a right-to-left
fashion using the function @f@: the right-most value provided to @f@ is the value @k@.
If this parser does fail at any point having consumed input, this combinator will fail.

==== __Examples__
> many = manyr (:) []

@since 0.3.0.0
-}
{-# INLINE manyr #-}
manyr :: (a -> b -> b) -- ^ @f@, function to apply to each value produced by @p@ starting at the right.
      -> b             -- ^ @k@, the value to use when this parser no longer succeeds.
      -> Parsec a      -- ^ @p@, the parser to repeatedly run zero or more times.
      -> Parsec b      -- ^ a parser which parses @p@ many times and folds the results together with @f@ and @k@ right-associatively.
manyr :: forall a b. (a -> b -> b) -> b -> Parsec a -> Parsec b
manyr a -> b -> b
f b
k Parsec a
p = let go :: Parsec b
go = (a -> b -> b) -> Parsec a -> Parsec b -> Parsec b
forall a b c. (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> b
f Parsec a
p Parsec b
go Parsec b -> Parsec b -> Parsec b
forall a. Parsec a -> Parsec a -> Parsec a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> b -> Parsec b
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
k in Parsec b
go

{-|
This combinator will parse the given parser @p@ __one__ or more times,
combining the results with the function @f@ and base value @k@ from the right.

@p@ will continue to be parsed until it fails having __not consumed__ input.
All of the results generated by the successful parses are then combined in a right-to-left
fashion using the function @f@: the right-most value provided to @f@ is the value @k@.
If this parser does fail at any point having consumed input, this combinator will fail.

==== __Examples__
> some = somer (:) []

@since 0.3.0.0
-}
{-# INLINE somer #-}
somer :: (a -> b -> b) -- ^ function to apply to each value produced by this parser, starting at the right.
      -> b             -- ^ @k@, the value to use when this parser no longer succeeds.
      -> Parsec a      -- ^ @p@, the parser to repeatedly run one or more times.
      -> Parsec b      -- ^ a parser which parses @p@ some times and folds the results together with @f@ and @k@ right-associatively.
somer :: forall a b. (a -> b -> b) -> b -> Parsec a -> Parsec b
somer a -> b -> b
f b
k Parsec a
p = (a -> b -> b) -> Parsec a -> Parsec b -> Parsec b
forall a b c. (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> b
f Parsec a
p ((a -> b -> b) -> b -> Parsec a -> Parsec b
forall a b. (a -> b -> b) -> b -> Parsec a -> Parsec b
manyr a -> b -> b
f b
k Parsec a
p)

-- | @since 0.1.0.0
instance Semigroup m => Semigroup (Parsec m) where
  (<>) :: Parsec m -> Parsec m -> Parsec m
  <> :: Parsec m -> Parsec m -> Parsec m
(<>) = (m -> m -> m) -> Parsec m -> Parsec m -> Parsec m
forall a b c. (a -> b -> c) -> Parsec a -> Parsec b -> Parsec c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>)

  {-# INLINE (<>) #-}

-- | @since 0.1.0.0
instance Monoid m => Monoid (Parsec m) where
  mempty :: Parsec m
  mempty :: Parsec m
mempty = m -> Parsec m
forall a. a -> Parsec a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
forall a. Monoid a => a
mempty

  {-# INLINE mempty #-}

{-|
The 'State' of the parser, containing position information, the input being parsed, and more.

@since 0.1.0.0
-}
type State :: UnliftedDatatype
data State = State {
    -- | the input string, in future this may be generalised
    State -> String
input :: !String,
    -- | has the parser consumed input since the last relevant handler?
    State -> Word
consumed :: {-# UNPACK #-} !Word,
    -- | the current line number (incremented by \n)
    State -> Word
line :: {-# UNPACK #-} !Word,
    -- | the current column number (have to settle on a tab handling scheme)
    State -> Word
col  :: {-# UNPACK #-} !Word,
    -- | the valid for which hints can be used
    State -> Word
hintsValidOffset :: {-# UNPACK #-} !Word,
    -- | the hints at this point in time
    State -> Hints
hints :: Hints,
    -- | Debug nesting
    State -> Int
debugLevel :: {-# UNPACK #-} !Int
  }

emptyState :: String -> State
emptyState :: String -> State
emptyState !String
str = State { input :: String
input = String
str
                        , consumed :: Word
consumed = Word
0
                        , line :: Word
line = Word
1
                        , col :: Word
col = Word
1
                        , hintsValidOffset :: Word
hintsValidOffset = Word
0
                        , hints :: Hints
hints = Hints
Errors.Blank
                        , debugLevel :: Int
debugLevel = Int
0
                        }

emptyErr :: State -> Word -> Error
emptyErr :: State -> Word -> Error
emptyErr State{Int
String
Word
Hints
consumed :: State -> Word
input :: State -> String
line :: State -> Word
col :: State -> Word
hintsValidOffset :: State -> Word
hints :: State -> Hints
debugLevel :: State -> Int
input :: String
consumed :: Word
line :: Word
col :: Word
hintsValidOffset :: Word
hints :: Hints
debugLevel :: Int
..} = Word -> Word -> Word -> Word -> Error
Errors.emptyErr Word
consumed Word
line Word
col

expectedErr :: State -> Set ExpectItem -> Word -> Error
expectedErr :: State -> Set ExpectItem -> Word -> Error
expectedErr State{Int
String
Word
Hints
consumed :: State -> Word
input :: State -> String
line :: State -> Word
col :: State -> Word
hintsValidOffset :: State -> Word
hints :: State -> Hints
debugLevel :: State -> Int
input :: String
consumed :: Word
line :: Word
col :: Word
hintsValidOffset :: Word
hints :: Hints
debugLevel :: Int
..} = String -> Word -> Word -> Word -> Set ExpectItem -> Word -> Error
Errors.expectedErr String
input Word
consumed Word
line Word
col

specialisedErr :: State -> [String] -> CaretWidth -> Error
specialisedErr :: State -> [String] -> CaretWidth -> Error
specialisedErr State{Int
String
Word
Hints
consumed :: State -> Word
input :: State -> String
line :: State -> Word
col :: State -> Word
hintsValidOffset :: State -> Word
hints :: State -> Hints
debugLevel :: State -> Int
input :: String
consumed :: Word
line :: Word
col :: Word
hintsValidOffset :: Word
hints :: Hints
debugLevel :: Int
..} = Word -> Word -> Word -> [String] -> CaretWidth -> Error
Errors.specialisedErr Word
consumed Word
line Word
col

unexpectedErr :: State -> Set ExpectItem -> String -> CaretWidth -> Error
unexpectedErr :: State -> Set ExpectItem -> String -> CaretWidth -> Error
unexpectedErr State{Int
String
Word
Hints
consumed :: State -> Word
input :: State -> String
line :: State -> Word
col :: State -> Word
hintsValidOffset :: State -> Word
hints :: State -> Hints
debugLevel :: State -> Int
input :: String
consumed :: Word
line :: Word
col :: Word
hintsValidOffset :: Word
hints :: Hints
debugLevel :: Int
..} = Word
-> Word -> Word -> Set ExpectItem -> String -> CaretWidth -> Error
Errors.unexpectedErr Word
consumed Word
line Word
col

errorToHints :: State -> Error -> State
errorToHints :: State -> Error -> State
errorToHints st :: State
st@State{Int
String
Word
Hints
consumed :: State -> Word
input :: State -> String
line :: State -> Word
col :: State -> Word
hintsValidOffset :: State -> Word
hints :: State -> Hints
debugLevel :: State -> Int
input :: String
consumed :: Word
line :: Word
col :: Word
hintsValidOffset :: Word
hints :: Hints
debugLevel :: Int
..} Error
err
  | Word
consumed Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Error -> Word
Errors.presentationOffset Error
err
  , Bool -> Bool
not (Error -> Bool
Errors.isExpectedEmpty Error
err) =
    if Word
hintsValidOffset Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
consumed then State
st { hints = Errors.addError (Errors.Blank) err, hintsValidOffset = consumed }
    else                                State
st { hints = Errors.addError hints err }
errorToHints State
st Error
_ = State
st

useHints :: (Error -> State -> RT r) -> (Error -> State -> RT r)
useHints :: forall r. (Error -> State -> RT r) -> Error -> State -> RT r
useHints Error -> State -> RT r
bad Error
err st :: State
st@State{Word
hintsValidOffset :: State -> Word
hintsValidOffset :: Word
hintsValidOffset, Hints
hints :: State -> Hints
hints :: Hints
hints}
  | Word
presentationOffset Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
hintsValidOffset = Error -> State -> RT r
bad (Hints -> Error -> Error
Errors.useHints Hints
hints Error
err) State
st
  | Bool
otherwise                              = Error -> State -> RT r
bad Error
err State
st{ hintsValidOffset = presentationOffset, hints = Errors.Blank }
  where !presentationOffset :: Word
presentationOffset = Error -> Word
Errors.presentationOffset Error
err

adjustErr :: (Error -> Error) -> Parsec a -> Parsec a
adjustErr :: forall a. (Error -> Error) -> Parsec a -> Parsec a
adjustErr Error -> Error
f (Parsec forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p) = (forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a.
(forall r.
 State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
Parsec ((forall r.
  State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
 -> Parsec a)
-> (forall r.
    State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r)
-> Parsec a
forall a b. (a -> b) -> a -> b
$ \State
st a -> State -> RT r
good Error -> State -> RT r
bad -> State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
forall r.
State -> (a -> State -> RT r) -> (Error -> State -> RT r) -> RT r
p State
st a -> State -> RT r
good ((Error -> State -> RT r) -> RT r)
-> (Error -> State -> RT r) -> RT r
forall a b. (a -> b) -> a -> b
$ \Error
err -> Error -> State -> RT r
bad (Error -> Error
f Error
err)