{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A simple text parser with decent errors
module Looksee
  ( Span (..)
  , LineColLookup ()
  , calculateLineCol
  , lookupLineCol
  , Label (..)
  , textSpan
  , Reason (..)
  , ErrF (..)
  , Err (..)
  , errSpan
  , errReason
  , AltPhase (..)
  , InfixPhase (..)
  , ParserT
  , Parser
  , parseT
  , parse
  , parseI
  , spanP
  , throwP
  , altP
  , emptyP
  , endP
  , optP
  , lookP
  , labelP
  , textP
  , textP_
  , charP
  , charP_
  , breakP
  , someBreakP
  , splitP
  , split1P
  , split2P
  , leadP
  , lead1P
  , trailP
  , trail1P
  , infixRP
  , someInfixRP
  , takeP
  , dropP
  , takeExactP
  , dropExactP
  , takeWhileP
  , dropWhileP
  , takeWhile1P
  , dropWhile1P
  , takeAllP
  , dropAllP
  , takeAll1P
  , dropAll1P
  , betweenP
  , repeatP
  , repeat1P
  , sepByP
  , sepBy1P
  , sepBy2P
  , spaceP
  , stripP
  , stripStartP
  , stripEndP
  , measureP
  , unconsP
  , headP
  , signedWithP
  , signedP
  , intP
  , uintP
  , decP
  , udecP
  , sciP
  , usciP
  , numP
  , unumP
  , space1P
  , strip1P
  , stripStart1P
  , stripEnd1P
  , transP
  , scopeP
  , iterP
  , strP
  , doubleStrP
  , singleStrP
  , HasErrMessage (..)
  , errataE
  , renderE
  , printE
  )
where

import Control.Applicative (Alternative (..), liftA2)
import Control.Exception (Exception)
import Control.Monad (ap, void)
import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Identity (Identity (..))
import Control.Monad.Morph (MFunctor (..))
import Control.Monad.Reader (MonadReader (..))
import Control.Monad.State.Strict (MonadState (..), StateT (..), evalStateT, gets, state)
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Writer.Strict (MonadWriter (..))
import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Bifunctor.TH (deriveBifoldable, deriveBifunctor, deriveBitraversable)
import Data.Bitraversable (Bitraversable (..))
import Data.Char (digitToInt, isDigit, isSpace)
import Data.Foldable (toList)
import Data.Functor.Foldable (Base, Corecursive (..), Recursive (..))
import Data.Maybe (fromMaybe, isJust, maybeToList)
import Data.Ratio ((%))
import Data.Scientific (Scientific)
import Data.Scientific qualified as S
import Data.Sequence (Seq (..))
import Data.Sequence qualified as Seq
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Data.Text.Lazy qualified as TL
import Data.Typeable (Typeable)
import Data.Vector (Vector)
import Data.Vector qualified as V
import Data.Void (Void, absurd)
import Errata qualified as E
import Errata.Styles qualified as E
import Errata.Types qualified as E
import System.IO (stderr)

-- | A generic span, used for tracking ranges of offsets or (line, col)
data Span a = Span {forall a. Span a -> a
spanStart :: !a, forall a. Span a -> a
spanEnd :: !a}
  deriving stock (Span a -> Span a -> Bool
forall a. Eq a => Span a -> Span a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Span a -> Span a -> Bool
$c/= :: forall a. Eq a => Span a -> Span a -> Bool
== :: Span a -> Span a -> Bool
$c== :: forall a. Eq a => Span a -> Span a -> Bool
Eq, Span a -> Span a -> Bool
Span a -> Span a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Span a)
forall a. Ord a => Span a -> Span a -> Bool
forall a. Ord a => Span a -> Span a -> Ordering
forall a. Ord a => Span a -> Span a -> Span a
min :: Span a -> Span a -> Span a
$cmin :: forall a. Ord a => Span a -> Span a -> Span a
max :: Span a -> Span a -> Span a
$cmax :: forall a. Ord a => Span a -> Span a -> Span a
>= :: Span a -> Span a -> Bool
$c>= :: forall a. Ord a => Span a -> Span a -> Bool
> :: Span a -> Span a -> Bool
$c> :: forall a. Ord a => Span a -> Span a -> Bool
<= :: Span a -> Span a -> Bool
$c<= :: forall a. Ord a => Span a -> Span a -> Bool
< :: Span a -> Span a -> Bool
$c< :: forall a. Ord a => Span a -> Span a -> Bool
compare :: Span a -> Span a -> Ordering
$ccompare :: forall a. Ord a => Span a -> Span a -> Ordering
Ord, Int -> Span a -> ShowS
forall a. Show a => Int -> Span a -> ShowS
forall a. Show a => [Span a] -> ShowS
forall a. Show a => Span a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Span a] -> ShowS
$cshowList :: forall a. Show a => [Span a] -> ShowS
show :: Span a -> String
$cshow :: forall a. Show a => Span a -> String
showsPrec :: Int -> Span a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Span a -> ShowS
Show, forall a b. a -> Span b -> Span a
forall a b. (a -> b) -> Span a -> Span b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Span b -> Span a
$c<$ :: forall a b. a -> Span b -> Span a
fmap :: forall a b. (a -> b) -> Span a -> Span b
$cfmap :: forall a b. (a -> b) -> Span a -> Span b
Functor, forall a. Eq a => a -> Span a -> Bool
forall a. Num a => Span a -> a
forall a. Ord a => Span a -> a
forall m. Monoid m => Span m -> m
forall a. Span a -> Bool
forall a. Span a -> Int
forall a. Span a -> [a]
forall a. (a -> a -> a) -> Span a -> a
forall m a. Monoid m => (a -> m) -> Span a -> m
forall b a. (b -> a -> b) -> b -> Span a -> b
forall a b. (a -> b -> b) -> b -> Span a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Span a -> a
$cproduct :: forall a. Num a => Span a -> a
sum :: forall a. Num a => Span a -> a
$csum :: forall a. Num a => Span a -> a
minimum :: forall a. Ord a => Span a -> a
$cminimum :: forall a. Ord a => Span a -> a
maximum :: forall a. Ord a => Span a -> a
$cmaximum :: forall a. Ord a => Span a -> a
elem :: forall a. Eq a => a -> Span a -> Bool
$celem :: forall a. Eq a => a -> Span a -> Bool
length :: forall a. Span a -> Int
$clength :: forall a. Span a -> Int
null :: forall a. Span a -> Bool
$cnull :: forall a. Span a -> Bool
toList :: forall a. Span a -> [a]
$ctoList :: forall a. Span a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Span a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Span a -> a
foldr1 :: forall a. (a -> a -> a) -> Span a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Span a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Span a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Span a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Span a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Span a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Span a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Span a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Span a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Span a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Span a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Span a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Span a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Span a -> m
fold :: forall m. Monoid m => Span m -> m
$cfold :: forall m. Monoid m => Span m -> m
Foldable, Functor Span
Foldable Span
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
sequence :: forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
$csequence :: forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
Traversable)

-- | Auxiliary data structure to translate offsets to (line, col)
type LineColLookup = Vector (Int, Int)

-- | Construct an offset lookup from a document
calculateLineCol :: Text -> LineColLookup
calculateLineCol :: Text -> LineColLookup
calculateLineCol Text
t = forall b a. Int -> (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldrN (Text -> Int
T.length Text
t) forall {a} {b}.
(Num a, Num b) =>
((a, b), String) -> Maybe ((a, b), ((a, b), String))
go ((Int
0, Int
0), Text -> String
T.unpack Text
t)
 where
  go :: ((a, b), String) -> Maybe ((a, b), ((a, b), String))
go (p :: (a, b)
p@(!a
line, !b
col), String
xs) =
    case String
xs of
      [] -> forall a. Maybe a
Nothing
      Char
x : String
xs' -> forall a. a -> Maybe a
Just ((a, b)
p, if Char
x forall a. Eq a => a -> a -> Bool
== Char
'\n' then ((a
line forall a. Num a => a -> a -> a
+ a
1, b
0), String
xs') else ((a
line, b
col forall a. Num a => a -> a -> a
+ b
1), String
xs'))

-- | Returns 0-based (line, col) for the given offset.
-- Clamps to the valid range of offsets, returning (0, 0) for
-- empty text. Note that the valid range is from before the first
-- character to before the last, so a 3 character string has
-- three valid offsets (0, 1, and 2).
lookupLineCol :: Int -> LineColLookup -> (Int, Int)
lookupLineCol :: Int -> LineColLookup -> (Int, Int)
lookupLineCol Int
i LineColLookup
v =
  if forall a. Vector a -> Bool
V.null LineColLookup
v
    then (Int
0, Int
0)
    else LineColLookup
v forall a. Vector a -> Int -> a
V.! forall a. Ord a => a -> a -> a
max Int
0 (forall a. Ord a => a -> a -> a
min Int
i (forall a. Vector a -> Int
V.length LineColLookup
v forall a. Num a => a -> a -> a
- Int
1))

-- | A parser label (for error reporting)
newtype Label = Label {Label -> Text
unLabel :: Text}
  deriving stock (Int -> Label -> ShowS
[Label] -> ShowS
Label -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Label] -> ShowS
$cshowList :: [Label] -> ShowS
show :: Label -> String
$cshow :: Label -> String
showsPrec :: Int -> Label -> ShowS
$cshowsPrec :: Int -> Label -> ShowS
Show)
  deriving newtype (Label -> Label -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c== :: Label -> Label -> Bool
Eq, Eq Label
Label -> Label -> Bool
Label -> Label -> Ordering
Label -> Label -> Label
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmax :: Label -> Label -> Label
>= :: Label -> Label -> Bool
$c>= :: Label -> Label -> Bool
> :: Label -> Label -> Bool
$c> :: Label -> Label -> Bool
<= :: Label -> Label -> Bool
$c<= :: Label -> Label -> Bool
< :: Label -> Label -> Bool
$c< :: Label -> Label -> Bool
compare :: Label -> Label -> Ordering
$ccompare :: Label -> Label -> Ordering
Ord, String -> Label
forall a. (String -> a) -> IsString a
fromString :: String -> Label
$cfromString :: String -> Label
IsString)

-- | Create a span from the given text
textSpan :: Text -> Span Int
textSpan :: Text -> Span Int
textSpan Text
t = forall a. a -> a -> Span a
Span Int
0 (Text -> Int
T.length Text
t)

-- private
-- Parser state
data St = St
  { St -> Text
stHay :: !Text
  , St -> Span Int
stSpan :: !(Span Int)
  , St -> Seq Label
stLabels :: !(Seq Label)
  }
  deriving stock (St -> St -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: St -> St -> Bool
$c/= :: St -> St -> Bool
== :: St -> St -> Bool
$c== :: St -> St -> Bool
Eq, Eq St
St -> St -> Bool
St -> St -> Ordering
St -> St -> St
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: St -> St -> St
$cmin :: St -> St -> St
max :: St -> St -> St
$cmax :: St -> St -> St
>= :: St -> St -> Bool
$c>= :: St -> St -> Bool
> :: St -> St -> Bool
$c> :: St -> St -> Bool
<= :: St -> St -> Bool
$c<= :: St -> St -> Bool
< :: St -> St -> Bool
$c< :: St -> St -> Bool
compare :: St -> St -> Ordering
$ccompare :: St -> St -> Ordering
Ord, Int -> St -> ShowS
[St] -> ShowS
St -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [St] -> ShowS
$cshowList :: [St] -> ShowS
show :: St -> String
$cshow :: St -> String
showsPrec :: Int -> St -> ShowS
$cshowsPrec :: Int -> St -> ShowS
Show)

-- private
-- Returns list of possible break points with positions
-- (startStream, breakPt) (breakPt, endStream) (breakPt + needLen, endStream)
breakAllRP :: Text -> St -> [(St, St, St)]
breakAllRP :: Text -> St -> [(St, St, St)]
breakAllRP Text
needle (St Text
hay (Span Int
r0 Int
r1) Seq Label
labs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> (St, St, St)
go (Text -> Text -> [(Text, Text)]
T.breakOnAll Text
needle Text
hay)
 where
  go :: (Text, Text) -> (St, St, St)
go (Text
hayA, Text
hayB) =
    let aLen :: Int
aLen = Text -> Int
T.length Text
hayA
        endA :: Int
endA = Int
r0 forall a. Num a => a -> a -> a
+ Int
aLen
        needLen :: Int
needLen = Text -> Int
T.length Text
needle
        rngA :: Span Int
rngA = forall a. a -> a -> Span a
Span Int
r0 Int
endA
        rngX :: Span Int
rngX = forall a. a -> a -> Span a
Span Int
endA Int
r1
        rngB :: Span Int
rngB = forall a. a -> a -> Span a
Span (Int
endA forall a. Num a => a -> a -> a
+ Int
needLen) Int
r1
        stA :: St
stA = Text -> Span Int -> Seq Label -> St
St Text
hayA Span Int
rngA Seq Label
labs
        stX :: St
stX = Text -> Span Int -> Seq Label -> St
St (Int -> Text -> Text
T.drop Int
aLen Text
hay) Span Int
rngX Seq Label
labs
        stB :: St
stB = Text -> Span Int -> Seq Label -> St
St (Int -> Text -> Text
T.drop Int
needLen Text
hayB) Span Int
rngB Seq Label
labs
    in  (St
stA, St
stX, St
stB)

-- private
breakRP :: Text -> St -> Maybe (St, St, St)
breakRP :: Text -> St -> Maybe (St, St, St)
breakRP Text
needle (St Text
hay (Span Int
r0 Int
r1) Seq Label
labs) =
  let (Text
hayA, Text
hayB) = Text -> Text -> (Text, Text)
T.breakOn Text
needle Text
hay
  in  if Text -> Bool
T.null Text
hayB
        then forall a. Maybe a
Nothing
        else
          let aLen :: Int
aLen = Text -> Int
T.length Text
hayA
              endA :: Int
endA = Int
r0 forall a. Num a => a -> a -> a
+ Int
aLen
              needLen :: Int
needLen = Text -> Int
T.length Text
needle
              rngA :: Span Int
rngA = forall a. a -> a -> Span a
Span Int
r0 Int
endA
              rngX :: Span Int
rngX = forall a. a -> a -> Span a
Span Int
endA Int
r1
              rngB :: Span Int
rngB = forall a. a -> a -> Span a
Span (Int
endA forall a. Num a => a -> a -> a
+ Int
needLen) Int
r1
              stA :: St
stA = Text -> Span Int -> Seq Label -> St
St Text
hayA Span Int
rngA Seq Label
labs
              stX :: St
stX = Text -> Span Int -> Seq Label -> St
St (Int -> Text -> Text
T.drop Int
aLen Text
hay) Span Int
rngX Seq Label
labs
              stB :: St
stB = Text -> Span Int -> Seq Label -> St
St (Int -> Text -> Text
T.drop Int
needLen Text
hayB) Span Int
rngB Seq Label
labs
          in  forall a. a -> Maybe a
Just (St
stA, St
stX, St
stB)

-- | Phase of alternative parsing (for error reporting)
data AltPhase = AltPhaseBranch | AltPhaseCont
  deriving stock (AltPhase -> AltPhase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AltPhase -> AltPhase -> Bool
$c/= :: AltPhase -> AltPhase -> Bool
== :: AltPhase -> AltPhase -> Bool
$c== :: AltPhase -> AltPhase -> Bool
Eq, Eq AltPhase
AltPhase -> AltPhase -> Bool
AltPhase -> AltPhase -> Ordering
AltPhase -> AltPhase -> AltPhase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AltPhase -> AltPhase -> AltPhase
$cmin :: AltPhase -> AltPhase -> AltPhase
max :: AltPhase -> AltPhase -> AltPhase
$cmax :: AltPhase -> AltPhase -> AltPhase
>= :: AltPhase -> AltPhase -> Bool
$c>= :: AltPhase -> AltPhase -> Bool
> :: AltPhase -> AltPhase -> Bool
$c> :: AltPhase -> AltPhase -> Bool
<= :: AltPhase -> AltPhase -> Bool
$c<= :: AltPhase -> AltPhase -> Bool
< :: AltPhase -> AltPhase -> Bool
$c< :: AltPhase -> AltPhase -> Bool
compare :: AltPhase -> AltPhase -> Ordering
$ccompare :: AltPhase -> AltPhase -> Ordering
Ord, Int -> AltPhase -> ShowS
[AltPhase] -> ShowS
AltPhase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltPhase] -> ShowS
$cshowList :: [AltPhase] -> ShowS
show :: AltPhase -> String
$cshow :: AltPhase -> String
showsPrec :: Int -> AltPhase -> ShowS
$cshowsPrec :: Int -> AltPhase -> ShowS
Show, Int -> AltPhase
AltPhase -> Int
AltPhase -> [AltPhase]
AltPhase -> AltPhase
AltPhase -> AltPhase -> [AltPhase]
AltPhase -> AltPhase -> AltPhase -> [AltPhase]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AltPhase -> AltPhase -> AltPhase -> [AltPhase]
$cenumFromThenTo :: AltPhase -> AltPhase -> AltPhase -> [AltPhase]
enumFromTo :: AltPhase -> AltPhase -> [AltPhase]
$cenumFromTo :: AltPhase -> AltPhase -> [AltPhase]
enumFromThen :: AltPhase -> AltPhase -> [AltPhase]
$cenumFromThen :: AltPhase -> AltPhase -> [AltPhase]
enumFrom :: AltPhase -> [AltPhase]
$cenumFrom :: AltPhase -> [AltPhase]
fromEnum :: AltPhase -> Int
$cfromEnum :: AltPhase -> Int
toEnum :: Int -> AltPhase
$ctoEnum :: Int -> AltPhase
pred :: AltPhase -> AltPhase
$cpred :: AltPhase -> AltPhase
succ :: AltPhase -> AltPhase
$csucc :: AltPhase -> AltPhase
Enum, AltPhase
forall a. a -> a -> Bounded a
maxBound :: AltPhase
$cmaxBound :: AltPhase
minBound :: AltPhase
$cminBound :: AltPhase
Bounded)

-- | Phase of infix/split parsing (for error reporting)
data InfixPhase = InfixPhaseLeft | InfixPhaseRight | InfixPhaseCont
  deriving stock (InfixPhase -> InfixPhase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfixPhase -> InfixPhase -> Bool
$c/= :: InfixPhase -> InfixPhase -> Bool
== :: InfixPhase -> InfixPhase -> Bool
$c== :: InfixPhase -> InfixPhase -> Bool
Eq, Eq InfixPhase
InfixPhase -> InfixPhase -> Bool
InfixPhase -> InfixPhase -> Ordering
InfixPhase -> InfixPhase -> InfixPhase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InfixPhase -> InfixPhase -> InfixPhase
$cmin :: InfixPhase -> InfixPhase -> InfixPhase
max :: InfixPhase -> InfixPhase -> InfixPhase
$cmax :: InfixPhase -> InfixPhase -> InfixPhase
>= :: InfixPhase -> InfixPhase -> Bool
$c>= :: InfixPhase -> InfixPhase -> Bool
> :: InfixPhase -> InfixPhase -> Bool
$c> :: InfixPhase -> InfixPhase -> Bool
<= :: InfixPhase -> InfixPhase -> Bool
$c<= :: InfixPhase -> InfixPhase -> Bool
< :: InfixPhase -> InfixPhase -> Bool
$c< :: InfixPhase -> InfixPhase -> Bool
compare :: InfixPhase -> InfixPhase -> Ordering
$ccompare :: InfixPhase -> InfixPhase -> Ordering
Ord, Int -> InfixPhase -> ShowS
[InfixPhase] -> ShowS
InfixPhase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InfixPhase] -> ShowS
$cshowList :: [InfixPhase] -> ShowS
show :: InfixPhase -> String
$cshow :: InfixPhase -> String
showsPrec :: Int -> InfixPhase -> ShowS
$cshowsPrec :: Int -> InfixPhase -> ShowS
Show, Int -> InfixPhase
InfixPhase -> Int
InfixPhase -> [InfixPhase]
InfixPhase -> InfixPhase
InfixPhase -> InfixPhase -> [InfixPhase]
InfixPhase -> InfixPhase -> InfixPhase -> [InfixPhase]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InfixPhase -> InfixPhase -> InfixPhase -> [InfixPhase]
$cenumFromThenTo :: InfixPhase -> InfixPhase -> InfixPhase -> [InfixPhase]
enumFromTo :: InfixPhase -> InfixPhase -> [InfixPhase]
$cenumFromTo :: InfixPhase -> InfixPhase -> [InfixPhase]
enumFromThen :: InfixPhase -> InfixPhase -> [InfixPhase]
$cenumFromThen :: InfixPhase -> InfixPhase -> [InfixPhase]
enumFrom :: InfixPhase -> [InfixPhase]
$cenumFrom :: InfixPhase -> [InfixPhase]
fromEnum :: InfixPhase -> Int
$cfromEnum :: InfixPhase -> Int
toEnum :: Int -> InfixPhase
$ctoEnum :: Int -> InfixPhase
pred :: InfixPhase -> InfixPhase
$cpred :: InfixPhase -> InfixPhase
succ :: InfixPhase -> InfixPhase
$csucc :: InfixPhase -> InfixPhase
Enum, InfixPhase
forall a. a -> a -> Bounded a
maxBound :: InfixPhase
$cmaxBound :: InfixPhase
minBound :: InfixPhase
$cminBound :: InfixPhase
Bounded)

-- | Reason for parse failure
data Reason e r
  = ReasonCustom !e
  | ReasonExpect !Text !Text
  | ReasonDemand !Int !Int
  | ReasonLeftover !Int
  | ReasonAlt !(Seq (AltPhase, r))
  | ReasonInfix !(Seq (Int, InfixPhase, r))
  | ReasonFail !Text
  | ReasonLabeled !Label r
  | ReasonLook r
  | ReasonTakeNone
  | ReasonEmpty
  deriving stock (Reason e r -> Reason e r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e r. (Eq e, Eq r) => Reason e r -> Reason e r -> Bool
/= :: Reason e r -> Reason e r -> Bool
$c/= :: forall e r. (Eq e, Eq r) => Reason e r -> Reason e r -> Bool
== :: Reason e r -> Reason e r -> Bool
$c== :: forall e r. (Eq e, Eq r) => Reason e r -> Reason e r -> Bool
Eq, Reason e r -> Reason e r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e} {r}. (Ord e, Ord r) => Eq (Reason e r)
forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Bool
forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Ordering
forall e r.
(Ord e, Ord r) =>
Reason e r -> Reason e r -> Reason e r
min :: Reason e r -> Reason e r -> Reason e r
$cmin :: forall e r.
(Ord e, Ord r) =>
Reason e r -> Reason e r -> Reason e r
max :: Reason e r -> Reason e r -> Reason e r
$cmax :: forall e r.
(Ord e, Ord r) =>
Reason e r -> Reason e r -> Reason e r
>= :: Reason e r -> Reason e r -> Bool
$c>= :: forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Bool
> :: Reason e r -> Reason e r -> Bool
$c> :: forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Bool
<= :: Reason e r -> Reason e r -> Bool
$c<= :: forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Bool
< :: Reason e r -> Reason e r -> Bool
$c< :: forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Bool
compare :: Reason e r -> Reason e r -> Ordering
$ccompare :: forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Ordering
Ord, Int -> Reason e r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e r. (Show e, Show r) => Int -> Reason e r -> ShowS
forall e r. (Show e, Show r) => [Reason e r] -> ShowS
forall e r. (Show e, Show r) => Reason e r -> String
showList :: [Reason e r] -> ShowS
$cshowList :: forall e r. (Show e, Show r) => [Reason e r] -> ShowS
show :: Reason e r -> String
$cshow :: forall e r. (Show e, Show r) => Reason e r -> String
showsPrec :: Int -> Reason e r -> ShowS
$cshowsPrec :: forall e r. (Show e, Show r) => Int -> Reason e r -> ShowS
Show, forall a b. a -> Reason e b -> Reason e a
forall a b. (a -> b) -> Reason e a -> Reason e b
forall e a b. a -> Reason e b -> Reason e a
forall e a b. (a -> b) -> Reason e a -> Reason e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Reason e b -> Reason e a
$c<$ :: forall e a b. a -> Reason e b -> Reason e a
fmap :: forall a b. (a -> b) -> Reason e a -> Reason e b
$cfmap :: forall e a b. (a -> b) -> Reason e a -> Reason e b
Functor, forall a. Reason e a -> Bool
forall e a. Eq a => a -> Reason e a -> Bool
forall e a. Num a => Reason e a -> a
forall e a. Ord a => Reason e a -> a
forall m a. Monoid m => (a -> m) -> Reason e a -> m
forall e m. Monoid m => Reason e m -> m
forall e a. Reason e a -> Bool
forall e a. Reason e a -> Int
forall e a. Reason e a -> [a]
forall a b. (a -> b -> b) -> b -> Reason e a -> b
forall e a. (a -> a -> a) -> Reason e a -> a
forall e m a. Monoid m => (a -> m) -> Reason e a -> m
forall e b a. (b -> a -> b) -> b -> Reason e a -> b
forall e a b. (a -> b -> b) -> b -> Reason e a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Reason e a -> a
$cproduct :: forall e a. Num a => Reason e a -> a
sum :: forall a. Num a => Reason e a -> a
$csum :: forall e a. Num a => Reason e a -> a
minimum :: forall a. Ord a => Reason e a -> a
$cminimum :: forall e a. Ord a => Reason e a -> a
maximum :: forall a. Ord a => Reason e a -> a
$cmaximum :: forall e a. Ord a => Reason e a -> a
elem :: forall a. Eq a => a -> Reason e a -> Bool
$celem :: forall e a. Eq a => a -> Reason e a -> Bool
length :: forall a. Reason e a -> Int
$clength :: forall e a. Reason e a -> Int
null :: forall a. Reason e a -> Bool
$cnull :: forall e a. Reason e a -> Bool
toList :: forall a. Reason e a -> [a]
$ctoList :: forall e a. Reason e a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Reason e a -> a
$cfoldl1 :: forall e a. (a -> a -> a) -> Reason e a -> a
foldr1 :: forall a. (a -> a -> a) -> Reason e a -> a
$cfoldr1 :: forall e a. (a -> a -> a) -> Reason e a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Reason e a -> b
$cfoldl' :: forall e b a. (b -> a -> b) -> b -> Reason e a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Reason e a -> b
$cfoldl :: forall e b a. (b -> a -> b) -> b -> Reason e a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Reason e a -> b
$cfoldr' :: forall e a b. (a -> b -> b) -> b -> Reason e a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Reason e a -> b
$cfoldr :: forall e a b. (a -> b -> b) -> b -> Reason e a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Reason e a -> m
$cfoldMap' :: forall e m a. Monoid m => (a -> m) -> Reason e a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Reason e a -> m
$cfoldMap :: forall e m a. Monoid m => (a -> m) -> Reason e a -> m
fold :: forall m. Monoid m => Reason e m -> m
$cfold :: forall e m. Monoid m => Reason e m -> m
Foldable, forall e. Functor (Reason e)
forall e. Foldable (Reason e)
forall e (m :: * -> *) a.
Monad m =>
Reason e (m a) -> m (Reason e a)
forall e (f :: * -> *) a.
Applicative f =>
Reason e (f a) -> f (Reason e a)
forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Reason e a -> m (Reason e b)
forall e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Reason e a -> f (Reason e b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Reason e a -> f (Reason e b)
sequence :: forall (m :: * -> *) a. Monad m => Reason e (m a) -> m (Reason e a)
$csequence :: forall e (m :: * -> *) a.
Monad m =>
Reason e (m a) -> m (Reason e a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Reason e a -> m (Reason e b)
$cmapM :: forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Reason e a -> m (Reason e b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Reason e (f a) -> f (Reason e a)
$csequenceA :: forall e (f :: * -> *) a.
Applicative f =>
Reason e (f a) -> f (Reason e a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Reason e a -> f (Reason e b)
$ctraverse :: forall e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Reason e a -> f (Reason e b)
Traversable)

deriveBifunctor ''Reason
deriveBifoldable ''Reason
deriveBitraversable ''Reason

-- | Base functor for 'Err' containing the range and reason for the error
data ErrF e r = ErrF
  { forall e r. ErrF e r -> Span Int
efSpan :: !(Span Int)
  , forall e r. ErrF e r -> Reason e r
efReason :: !(Reason e r)
  }
  deriving stock (ErrF e r -> ErrF e r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e r. (Eq e, Eq r) => ErrF e r -> ErrF e r -> Bool
/= :: ErrF e r -> ErrF e r -> Bool
$c/= :: forall e r. (Eq e, Eq r) => ErrF e r -> ErrF e r -> Bool
== :: ErrF e r -> ErrF e r -> Bool
$c== :: forall e r. (Eq e, Eq r) => ErrF e r -> ErrF e r -> Bool
Eq, ErrF e r -> ErrF e r -> Bool
ErrF e r -> ErrF e r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e} {r}. (Ord e, Ord r) => Eq (ErrF e r)
forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Bool
forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Ordering
forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> ErrF e r
min :: ErrF e r -> ErrF e r -> ErrF e r
$cmin :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> ErrF e r
max :: ErrF e r -> ErrF e r -> ErrF e r
$cmax :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> ErrF e r
>= :: ErrF e r -> ErrF e r -> Bool
$c>= :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Bool
> :: ErrF e r -> ErrF e r -> Bool
$c> :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Bool
<= :: ErrF e r -> ErrF e r -> Bool
$c<= :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Bool
< :: ErrF e r -> ErrF e r -> Bool
$c< :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Bool
compare :: ErrF e r -> ErrF e r -> Ordering
$ccompare :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Ordering
Ord, Int -> ErrF e r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e r. (Show e, Show r) => Int -> ErrF e r -> ShowS
forall e r. (Show e, Show r) => [ErrF e r] -> ShowS
forall e r. (Show e, Show r) => ErrF e r -> String
showList :: [ErrF e r] -> ShowS
$cshowList :: forall e r. (Show e, Show r) => [ErrF e r] -> ShowS
show :: ErrF e r -> String
$cshow :: forall e r. (Show e, Show r) => ErrF e r -> String
showsPrec :: Int -> ErrF e r -> ShowS
$cshowsPrec :: forall e r. (Show e, Show r) => Int -> ErrF e r -> ShowS
Show, forall a b. a -> ErrF e b -> ErrF e a
forall a b. (a -> b) -> ErrF e a -> ErrF e b
forall e a b. a -> ErrF e b -> ErrF e a
forall e a b. (a -> b) -> ErrF e a -> ErrF e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ErrF e b -> ErrF e a
$c<$ :: forall e a b. a -> ErrF e b -> ErrF e a
fmap :: forall a b. (a -> b) -> ErrF e a -> ErrF e b
$cfmap :: forall e a b. (a -> b) -> ErrF e a -> ErrF e b
Functor, forall a. ErrF e a -> Bool
forall e a. Eq a => a -> ErrF e a -> Bool
forall e a. Num a => ErrF e a -> a
forall e a. Ord a => ErrF e a -> a
forall m a. Monoid m => (a -> m) -> ErrF e a -> m
forall e m. Monoid m => ErrF e m -> m
forall e a. ErrF e a -> Bool
forall e a. ErrF e a -> Int
forall e a. ErrF e a -> [a]
forall a b. (a -> b -> b) -> b -> ErrF e a -> b
forall e a. (a -> a -> a) -> ErrF e a -> a
forall e m a. Monoid m => (a -> m) -> ErrF e a -> m
forall e b a. (b -> a -> b) -> b -> ErrF e a -> b
forall e a b. (a -> b -> b) -> b -> ErrF e a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => ErrF e a -> a
$cproduct :: forall e a. Num a => ErrF e a -> a
sum :: forall a. Num a => ErrF e a -> a
$csum :: forall e a. Num a => ErrF e a -> a
minimum :: forall a. Ord a => ErrF e a -> a
$cminimum :: forall e a. Ord a => ErrF e a -> a
maximum :: forall a. Ord a => ErrF e a -> a
$cmaximum :: forall e a. Ord a => ErrF e a -> a
elem :: forall a. Eq a => a -> ErrF e a -> Bool
$celem :: forall e a. Eq a => a -> ErrF e a -> Bool
length :: forall a. ErrF e a -> Int
$clength :: forall e a. ErrF e a -> Int
null :: forall a. ErrF e a -> Bool
$cnull :: forall e a. ErrF e a -> Bool
toList :: forall a. ErrF e a -> [a]
$ctoList :: forall e a. ErrF e a -> [a]
foldl1 :: forall a. (a -> a -> a) -> ErrF e a -> a
$cfoldl1 :: forall e a. (a -> a -> a) -> ErrF e a -> a
foldr1 :: forall a. (a -> a -> a) -> ErrF e a -> a
$cfoldr1 :: forall e a. (a -> a -> a) -> ErrF e a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> ErrF e a -> b
$cfoldl' :: forall e b a. (b -> a -> b) -> b -> ErrF e a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ErrF e a -> b
$cfoldl :: forall e b a. (b -> a -> b) -> b -> ErrF e a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ErrF e a -> b
$cfoldr' :: forall e a b. (a -> b -> b) -> b -> ErrF e a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ErrF e a -> b
$cfoldr :: forall e a b. (a -> b -> b) -> b -> ErrF e a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> ErrF e a -> m
$cfoldMap' :: forall e m a. Monoid m => (a -> m) -> ErrF e a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ErrF e a -> m
$cfoldMap :: forall e m a. Monoid m => (a -> m) -> ErrF e a -> m
fold :: forall m. Monoid m => ErrF e m -> m
$cfold :: forall e m. Monoid m => ErrF e m -> m
Foldable, forall e. Functor (ErrF e)
forall e. Foldable (ErrF e)
forall e (m :: * -> *) a. Monad m => ErrF e (m a) -> m (ErrF e a)
forall e (f :: * -> *) a.
Applicative f =>
ErrF e (f a) -> f (ErrF e a)
forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ErrF e a -> m (ErrF e b)
forall e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrF e a -> f (ErrF e b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrF e a -> f (ErrF e b)
sequence :: forall (m :: * -> *) a. Monad m => ErrF e (m a) -> m (ErrF e a)
$csequence :: forall e (m :: * -> *) a. Monad m => ErrF e (m a) -> m (ErrF e a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ErrF e a -> m (ErrF e b)
$cmapM :: forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ErrF e a -> m (ErrF e b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ErrF e (f a) -> f (ErrF e a)
$csequenceA :: forall e (f :: * -> *) a.
Applicative f =>
ErrF e (f a) -> f (ErrF e a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrF e a -> f (ErrF e b)
$ctraverse :: forall e (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrF e a -> f (ErrF e b)
Traversable)

deriveBifunctor ''ErrF
deriveBifoldable ''ErrF
deriveBitraversable ''ErrF

-- | A parse error, which may contain multiple sub-errors
newtype Err e = Err {forall e. Err e -> ErrF e (Err e)
unErr :: ErrF e (Err e)}
  deriving stock (Err e -> Err e -> Bool
forall e. Eq e => Err e -> Err e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Err e -> Err e -> Bool
$c/= :: forall e. Eq e => Err e -> Err e -> Bool
== :: Err e -> Err e -> Bool
$c== :: forall e. Eq e => Err e -> Err e -> Bool
Eq, Err e -> Err e -> Bool
Err e -> Err e -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {e}. Ord e => Eq (Err e)
forall e. Ord e => Err e -> Err e -> Bool
forall e. Ord e => Err e -> Err e -> Ordering
forall e. Ord e => Err e -> Err e -> Err e
min :: Err e -> Err e -> Err e
$cmin :: forall e. Ord e => Err e -> Err e -> Err e
max :: Err e -> Err e -> Err e
$cmax :: forall e. Ord e => Err e -> Err e -> Err e
>= :: Err e -> Err e -> Bool
$c>= :: forall e. Ord e => Err e -> Err e -> Bool
> :: Err e -> Err e -> Bool
$c> :: forall e. Ord e => Err e -> Err e -> Bool
<= :: Err e -> Err e -> Bool
$c<= :: forall e. Ord e => Err e -> Err e -> Bool
< :: Err e -> Err e -> Bool
$c< :: forall e. Ord e => Err e -> Err e -> Bool
compare :: Err e -> Err e -> Ordering
$ccompare :: forall e. Ord e => Err e -> Err e -> Ordering
Ord, Int -> Err e -> ShowS
forall e. Show e => Int -> Err e -> ShowS
forall e. Show e => [Err e] -> ShowS
forall e. Show e => Err e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Err e] -> ShowS
$cshowList :: forall e. Show e => [Err e] -> ShowS
show :: Err e -> String
$cshow :: forall e. Show e => Err e -> String
showsPrec :: Int -> Err e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Err e -> ShowS
Show)

instance Functor Err where
  fmap :: forall a b. (a -> b) -> Err a -> Err b
fmap a -> b
f = Err a -> Err b
go
   where
    go :: Err a -> Err b
go (Err (ErrF Span Int
ra Reason a (Err a)
re)) = forall e. ErrF e (Err e) -> Err e
Err (forall e r. Span Int -> Reason e r -> ErrF e r
ErrF Span Int
ra (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f Err a -> Err b
go Reason a (Err a)
re))

instance Foldable Err where
  foldr :: forall a b. (a -> b -> b) -> b -> Err a -> b
foldr a -> b -> b
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip Err a -> b -> b
go
   where
    go :: Err a -> b -> b
go (Err (ErrF Span Int
_ Reason a (Err a)
re)) b
z = forall (p :: * -> * -> *) a c b.
Bifoldable p =>
(a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c
bifoldr a -> b -> b
f Err a -> b -> b
go b
z Reason a (Err a)
re

instance Traversable Err where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Err a -> f (Err b)
traverse a -> f b
f = Err a -> f (Err b)
go
   where
    go :: Err a -> f (Err b)
go (Err (ErrF Span Int
ra Reason a (Err a)
re)) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall e. ErrF e (Err e) -> Err e
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e r. Span Int -> Reason e r -> ErrF e r
ErrF Span Int
ra) (forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f b
f Err a -> f (Err b)
go Reason a (Err a)
re)

instance (Typeable e, Show e) => Exception (Err e)

type instance Base (Err e) = ErrF e

instance Recursive (Err e) where
  project :: Err e -> Base (Err e) (Err e)
project = forall e. Err e -> ErrF e (Err e)
unErr

instance Corecursive (Err e) where
  embed :: Base (Err e) (Err e) -> Err e
embed = forall e. ErrF e (Err e) -> Err e
Err

-- | Span of a parse error
errSpan :: Err e -> Span Int
errSpan :: forall e. Err e -> Span Int
errSpan = forall e r. ErrF e r -> Span Int
efSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Err e -> ErrF e (Err e)
unErr

-- | Reason for a parse error
errReason :: Err e -> Reason e (Err e)
errReason :: forall e. Err e -> Reason e (Err e)
errReason = forall e r. ErrF e r -> Reason e r
efReason forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Err e -> ErrF e (Err e)
unErr

-- private
newtype T e m a = T {forall e (m :: * -> *) a.
T e m a -> ExceptT (Err e) (StateT St m) a
unT :: ExceptT (Err e) (StateT St m) a}
  deriving newtype (forall a b. a -> T e m b -> T e m a
forall a b. (a -> b) -> T e m a -> T e m b
forall e (m :: * -> *) a b. Functor m => a -> T e m b -> T e m a
forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> T e m a -> T e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> T e m b -> T e m a
$c<$ :: forall e (m :: * -> *) a b. Functor m => a -> T e m b -> T e m a
fmap :: forall a b. (a -> b) -> T e m a -> T e m b
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> T e m a -> T e m b
Functor, forall a. a -> T e m a
forall a b. T e m a -> T e m b -> T e m a
forall a b. T e m a -> T e m b -> T e m b
forall a b. T e m (a -> b) -> T e m a -> T e m b
forall a b c. (a -> b -> c) -> T e m a -> T e m b -> T e m c
forall {e} {m :: * -> *}. Monad m => Functor (T e m)
forall e (m :: * -> *) a. Monad m => a -> T e m a
forall e (m :: * -> *) a b.
Monad m =>
T e m a -> T e m b -> T e m a
forall e (m :: * -> *) a b.
Monad m =>
T e m a -> T e m b -> T e m b
forall e (m :: * -> *) a b.
Monad m =>
T e m (a -> b) -> T e m a -> T e m b
forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> T e m a -> T e m b -> T e m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. T e m a -> T e m b -> T e m a
$c<* :: forall e (m :: * -> *) a b.
Monad m =>
T e m a -> T e m b -> T e m a
*> :: forall a b. T e m a -> T e m b -> T e m b
$c*> :: forall e (m :: * -> *) a b.
Monad m =>
T e m a -> T e m b -> T e m b
liftA2 :: forall a b c. (a -> b -> c) -> T e m a -> T e m b -> T e m c
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> T e m a -> T e m b -> T e m c
<*> :: forall a b. T e m (a -> b) -> T e m a -> T e m b
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
T e m (a -> b) -> T e m a -> T e m b
pure :: forall a. a -> T e m a
$cpure :: forall e (m :: * -> *) a. Monad m => a -> T e m a
Applicative, forall a. a -> T e m a
forall a b. T e m a -> T e m b -> T e m b
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall e (m :: * -> *). Monad m => Applicative (T e m)
forall e (m :: * -> *) a. Monad m => a -> T e m a
forall e (m :: * -> *) a b.
Monad m =>
T e m a -> T e m b -> T e m b
forall e (m :: * -> *) a b.
Monad m =>
T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> T e m a
$creturn :: forall e (m :: * -> *) a. Monad m => a -> T e m a
>> :: forall a b. T e m a -> T e m b -> T e m b
$c>> :: forall e (m :: * -> *) a b.
Monad m =>
T e m a -> T e m b -> T e m b
>>= :: forall a b. T e m a -> (a -> T e m b) -> T e m b
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
T e m a -> (a -> T e m b) -> T e m b
Monad, forall a. IO a -> T e m a
forall {e} {m :: * -> *}. MonadIO m => Monad (T e m)
forall e (m :: * -> *) a. MonadIO m => IO a -> T e m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> T e m a
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> T e m a
MonadIO, MonadState St, MonadError (Err e))

instance MonadTrans (T e) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> T e m a
lift = forall e (m :: * -> *) a.
ExceptT (Err e) (StateT St m) a -> T e m a
T forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MFunctor (T e) where
  hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> T e m b -> T e n b
hoist forall a. m a -> n a
mn (T ExceptT (Err e) (StateT St m) b
x) = forall e (m :: * -> *) a.
ExceptT (Err e) (StateT St m) a -> T e m a
T (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> n a
mn) ExceptT (Err e) (StateT St m) b
x)

deriving instance MonadReader r m => MonadReader r (T e m)

deriving instance MonadWriter w m => MonadWriter w (T e m)

-- private
runT :: T e m a -> St -> m (Either (Err e) a, St)
runT :: forall e (m :: * -> *) a. T e m a -> St -> m (Either (Err e) a, St)
runT = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a.
T e m a -> ExceptT (Err e) (StateT St m) a
unT

-- private
mkErrT :: Monad m => Reason e (Err e) -> T e m (Err e)
mkErrT :: forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT Reason e (Err e)
re = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\St
st -> forall e. ErrF e (Err e) -> Err e
Err (forall e r. Span Int -> Reason e r -> ErrF e r
ErrF (St -> Span Int
stSpan St
st) Reason e (Err e)
re))

-- private
-- errT :: Monad m => Reason e (Err e) -> T e m a
-- errT = mkErrT >=> throwError

-- private
tryT :: Monad m => T e m r -> T e m (Either (Err e) r)
tryT :: forall (m :: * -> *) e r.
Monad m =>
T e m r -> T e m (Either (Err e) r)
tryT T e m r
t = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall e (m :: * -> *) a. T e m a -> St -> m (Either (Err e) a, St)
runT T e m r
t St
st) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Either (Err e) r
er, St
st') -> Either (Err e) r
er forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st'

-- | The parser monad transformer
newtype ParserT e m a = ParserT {forall e (m :: * -> *) a.
ParserT e m a -> forall r. (Either (Err e) a -> T e m r) -> T e m r
unParserT :: forall r. (Either (Err e) a -> T e m r) -> T e m r}

instance Functor (ParserT e m) where
  fmap :: forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
fmap a -> b
f (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) b -> T e m r
j -> forall r. (Either (Err e) a -> T e m r) -> T e m r
g (Either (Err e) b -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f))

instance Applicative (ParserT e m) where
  pure :: forall a. a -> ParserT e m a
pure a
a = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> Either (Err e) a -> T e m r
j (forall a b. b -> Either a b
Right a
a))
  <*> :: forall a b. ParserT e m (a -> b) -> ParserT e m a -> ParserT e m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (ParserT e m) where
  return :: forall a. a -> ParserT e m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g >>= :: forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
>>= a -> ParserT e m b
f = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) b -> T e m r
j -> forall r. (Either (Err e) a -> T e m r) -> T e m r
g (\case Left Err e
e -> Either (Err e) b -> T e m r
j (forall a b. a -> Either a b
Left Err e
e); Right a
a -> let ParserT forall r. (Either (Err e) b -> T e m r) -> T e m r
h = a -> ParserT e m b
f a
a in forall r. (Either (Err e) b -> T e m r) -> T e m r
h Either (Err e) b -> T e m r
j))

instance Monad m => Alternative (ParserT e m) where
  empty :: forall a. ParserT e m a
empty = forall (m :: * -> *) e a. Monad m => ParserT e m a
emptyP
  ParserT e m a
p1 <|> :: forall a. ParserT e m a -> ParserT e m a -> ParserT e m a
<|> ParserT e m a
p2 = forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP [ParserT e m a
p1, ParserT e m a
p2]
  many :: forall a. ParserT e m a -> ParserT e m [a]
many = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
repeatP
  some :: forall a. ParserT e m a -> ParserT e m [a]
some = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
repeat1P

-- | The parser monad
type Parser e = ParserT e Identity

instance MonadTrans (ParserT e) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ParserT e m a
lift m a
ma = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

instance MonadIO m => MonadIO (ParserT e m) where
  liftIO :: forall a. IO a -> ParserT e m a
liftIO IO a
ma = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

instance Monad m => MonadFail (ParserT e m) where
  fail :: forall a. String -> ParserT e m a
fail = forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e r. Text -> Reason e r
ReasonFail forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance MonadReader r m => MonadReader r (ParserT e m) where
  ask :: ParserT e m r
ask = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) r -> T e m r
j -> forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) r -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  local :: forall a. (r -> r) -> ParserT e m a -> ParserT e m a
local r -> r
f (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. (Either (Err e) a -> T e m r) -> T e m r
g)

instance MonadState s m => MonadState s (ParserT e m) where
  get :: ParserT e m s
get = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) s -> T e m r
j -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) s -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  put :: s -> ParserT e m ()
put s
s = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) () -> T e m r
j -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) () -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)
  state :: forall a. (s -> (a, s)) -> ParserT e m a
state s -> (a, s)
f = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

instance Semigroup a => Semigroup (ParserT e m a) where
  ParserT e m a
p <> :: ParserT e m a -> ParserT e m a -> ParserT e m a
<> ParserT e m a
q = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) ParserT e m a
p ParserT e m a
q

instance Monoid a => Monoid (ParserT e m a) where
  mempty :: ParserT e m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

-- private
finishParserT :: Monad m => ParserT e m a -> St -> m (Either (Err e) a, St)
finishParserT :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> St -> m (Either (Err e) a, St)
finishParserT (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) St
st =
  let t :: T e m a
t = forall r. (Either (Err e) a -> T e m r) -> T e m r
g (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  in  forall e (m :: * -> *) a. T e m a -> St -> m (Either (Err e) a, St)
runT T e m a
t St
st

-- private
getP :: Monad m => ParserT e m St
getP :: forall (m :: * -> *) e. Monad m => ParserT e m St
getP = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) St -> T e m r
j -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) St -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

-- private
getsP :: Monad m => (St -> a) -> ParserT e m a
getsP :: forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP St -> a
f = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

-- private
putP :: Monad m => St -> ParserT e m ()
putP :: forall (m :: * -> *) e. Monad m => St -> ParserT e m ()
putP St
st = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) () -> T e m r
j -> forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) () -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

-- private
stateP :: Monad m => (St -> (a, St)) -> ParserT e m a
stateP :: forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP St -> (a, St)
f = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state St -> (a, St)
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right)

-- private
errP :: Monad m => Reason e (Err e) -> ParserT e m a
errP :: forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP Reason e (Err e)
re = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT Reason e (Err e)
re forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- private
leftoverP :: Monad m => ParserT e m Int
leftoverP :: forall (m :: * -> *) e. Monad m => ParserT e m Int
leftoverP = forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP (\St
st -> let Span Int
s Int
e = St -> Span Int
stSpan St
st in Int
e forall a. Num a => a -> a -> a
- Int
s)

-- | Run a parser transformer. You must consume all input or this will error!
-- If you really don't care about the rest of the input, you can always
-- discard it with 'dropAllP'.
parseT :: Monad m => ParserT e m a -> Text -> m (Either (Err e) a)
parseT :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> Text -> m (Either (Err e) a)
parseT ParserT e m a
p Text
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> St -> m (Either (Err e) a, St)
finishParserT (ParserT e m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
endP) (Text -> Span Int -> Seq Label -> St
St Text
h (Text -> Span Int
textSpan Text
h) forall a. Seq a
Empty))

-- | Run a parser (see 'parseT')
parse :: Parser e a -> Text -> Either (Err e) a
parse :: forall e a. Parser e a -> Text -> Either (Err e) a
parse Parser e a
p Text
h = forall a. Identity a -> a
runIdentity (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> Text -> m (Either (Err e) a)
parseT Parser e a
p Text
h)

-- | Run a parser and print any errors that occur
parseI :: HasErrMessage e => Parser e a -> Text -> IO (Either (Err e) a)
parseI :: forall e a.
HasErrMessage e =>
Parser e a -> Text -> IO (Either (Err e) a)
parseI Parser e a
p Text
h = do
  let ea :: Either (Err e) a
ea = forall e a. Parser e a -> Text -> Either (Err e) a
parse Parser e a
p Text
h
  case Either (Err e) a
ea of
    Left Err e
e -> forall e. HasErrMessage e => String -> Text -> Err e -> IO ()
printE String
"<interactive>" Text
h Err e
e
    Right a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Either (Err e) a
ea

-- | Get the span (in character offset) at the current point representing
-- the entire parseable range. At the start of parsing this will be `Span 0 n` for
-- an `n`-character document. The start offset will increase as input is consumed,
-- and the end offset will decrease as lookahead delimits the range. To evaluate
-- the "real" range of characters consumed by a parser, construct a span with the
-- starting offsets before and after executing a subparser.
spanP :: Monad m => ParserT e m (Span Int)
spanP :: forall (m :: * -> *) e. Monad m => ParserT e m (Span Int)
spanP = forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP St -> Span Int
stSpan

-- | Throw a custom parse error
throwP :: Monad m => e -> ParserT e m a
throwP :: forall (m :: * -> *) e a. Monad m => e -> ParserT e m a
throwP = forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e r. e -> Reason e r
ReasonCustom

-- | Succeed if this is the end of input
endP :: Monad m => ParserT e m ()
endP :: forall (m :: * -> *) e. Monad m => ParserT e m ()
endP = do
  Int
l <- forall (m :: * -> *) e. Monad m => ParserT e m Int
leftoverP
  if Int
l forall a. Eq a => a -> a -> Bool
== Int
0
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (forall e r. Int -> Reason e r
ReasonLeftover Int
l)

-- | Makes parse success optional
optP :: Monad m => ParserT e m a -> ParserT e m (Maybe a)
optP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT forall a b. (a -> b) -> a -> b
$ \Either (Err e) (Maybe a) -> T e m r
j -> do
  St
st0 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall r. (Either (Err e) a -> T e m r) -> T e m r
g forall a b. (a -> b) -> a -> b
$ \case
    Left Err e
_ -> forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (Err e) (Maybe a) -> T e m r
j (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
    Right a
a -> Either (Err e) (Maybe a) -> T e m r
j (forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just a
a))

-- private
subAltP
  :: Monad m
  => (Either (Err e) a -> T e m r)
  -> St
  -> Seq (AltPhase, Err e)
  -> [ParserT e m a]
  -> T e m r
subAltP :: forall (m :: * -> *) e a r.
Monad m =>
(Either (Err e) a -> T e m r)
-> St -> Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
subAltP Either (Err e) a -> T e m r
j St
st0 = Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
go
 where
  go :: Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
go !Seq (AltPhase, Err e)
errs = \case
    [] -> forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT (if forall a. Seq a -> Bool
Seq.null Seq (AltPhase, Err e)
errs then forall e r. Reason e r
ReasonEmpty else forall e r. Seq (AltPhase, r) -> Reason e r
ReasonAlt Seq (AltPhase, Err e)
errs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g : [ParserT e m a]
rest -> forall r. (Either (Err e) a -> T e m r) -> T e m r
g forall a b. (a -> b) -> a -> b
$ \case
      Left Err e
e -> forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
go (Seq (AltPhase, Err e)
errs forall a. Seq a -> a -> Seq a
:|> (AltPhase
AltPhaseBranch, Err e
e)) [ParserT e m a]
rest
      Right a
r -> do
        Either (Err e) r
es <- forall (m :: * -> *) e r.
Monad m =>
T e m r -> T e m (Either (Err e) r)
tryT (Either (Err e) a -> T e m r
j (forall a b. b -> Either a b
Right a
r))
        case Either (Err e) r
es of
          Left Err e
e -> forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
go (Seq (AltPhase, Err e)
errs forall a. Seq a -> a -> Seq a
:|> (AltPhase
AltPhaseCont, Err e
e)) [ParserT e m a]
rest
          Right r
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure r
s

-- | Parse with many possible branches
altP :: (Monad m, Foldable f) => f (ParserT e m a) -> ParserT e m a
altP :: forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m a) -> ParserT e m a
altP f (ParserT e m a)
falts = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> forall (m :: * -> *) e a r.
Monad m =>
(Either (Err e) a -> T e m r)
-> St -> Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
subAltP Either (Err e) a -> T e m r
j St
st0 forall a. Seq a
Empty (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (ParserT e m a)
falts))

-- | Fail with no results
emptyP :: Monad m => ParserT e m a
emptyP :: forall (m :: * -> *) e a. Monad m => ParserT e m a
emptyP = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) a -> T e m r
j -> forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT forall e r. Reason e r
ReasonEmpty forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left)

-- | Lookahead - rewinds state if the parser succeeds, otherwise throws error
lookP :: Monad m => ParserT e m a -> ParserT e m a
lookP :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
lookP (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT forall a b. (a -> b) -> a -> b
$ \Either (Err e) a -> T e m r
j -> do
  St
st0 <- forall s (m :: * -> *). MonadState s m => m s
get
  forall r. (Either (Err e) a -> T e m r) -> T e m r
g (\Either (Err e) a
ea -> forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (Err e) a -> T e m r
j (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall e. ErrF e (Err e) -> Err e
Err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e r. Span Int -> Reason e r -> ErrF e r
ErrF (St -> Span Int
stSpan St
st0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e r. r -> Reason e r
ReasonLook) Either (Err e) a
ea))

-- | Labels parse errors
labelP :: Monad m => Label -> ParserT e m a -> ParserT e m a
labelP :: forall (m :: * -> *) e a.
Monad m =>
Label -> ParserT e m a -> ParserT e m a
labelP Label
lab (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT forall a b. (a -> b) -> a -> b
$ \Either (Err e) a -> T e m r
j ->
  forall r. (Either (Err e) a -> T e m r) -> T e m r
g forall a b. (a -> b) -> a -> b
$ \case
    Left Err e
e -> forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT (forall e r. Label -> r -> Reason e r
ReasonLabeled Label
lab Err e
e) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    Right a
a -> Either (Err e) a -> T e m r
j (forall a b. b -> Either a b
Right a
a)

-- | Expect the given text at the start of the range
textP :: Monad m => Text -> ParserT e m Text
textP :: forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
n = do
  Text
o <- forall (m :: * -> *) e. Monad m => Int -> ParserT e m Text
takeP (Text -> Int
T.length Text
n)
  if Text
n forall a. Eq a => a -> a -> Bool
== Text
o
    then forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
    else forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (forall e r. Text -> Text -> Reason e r
ReasonExpect Text
n Text
o)

-- | Saves you from importing 'void'
textP_ :: Monad m => Text -> ParserT e m ()
textP_ :: forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP

-- | Expect the given character at the start of the range
charP :: Monad m => Char -> ParserT e m Char
charP :: forall (m :: * -> *) e. Monad m => Char -> ParserT e m Char
charP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Char
T.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

-- | Saves you from importing 'void'
charP_ :: Monad m => Char -> ParserT e m ()
charP_ :: forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e. Monad m => Char -> ParserT e m Char
charP

-- | Split once on the delimiter (first argument), parsing everything before it with a narrowed range.
-- Chooses first split from START to END of range (see 'infixRP').
breakP :: Monad m => Text -> ParserT e m a -> ParserT e m a
breakP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m a
breakP Text
tx ParserT e m a
pa = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (forall (m :: * -> *) e a b.
Monad m =>
Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
infixRP Text
tx ParserT e m a
pa (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

-- | Split once on the delimiter (first argument), parsing everything before it with a narrowed range.
-- Chooses splits from START to END of range (see 'someInfixRP').
someBreakP :: Monad m => Text -> ParserT e m a -> ParserT e m a
someBreakP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m a
someBreakP Text
tx ParserT e m a
pa = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst (forall (m :: * -> *) e a b.
Monad m =>
Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
someInfixRP Text
tx ParserT e m a
pa (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))

-- private
splitTailP :: Monad m => Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
splitTailP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
splitTailP Text
tx ParserT e m a
pa = Seq a -> St -> ParserT e m (Seq a)
go
 where
  go :: Seq a -> St -> ParserT e m (Seq a)
go !Seq a
acc !St
st = do
    Maybe (a, St, ())
mz <- forall (m :: * -> *) e a b.
Monad m =>
Text
-> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))
optInfixRP Text
tx ParserT e m a
pa (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    case Maybe (a, St, ())
mz of
      Maybe (a, St, ())
Nothing -> forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
pa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq a
acc forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) e. Monad m => St -> ParserT e m ()
putP St
st) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq a
acc :|>))
      Just (a
a, St
st', ()
_) -> Seq a -> St -> ParserT e m (Seq a)
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
a) St
st'

-- | Split on the delimiter, parsing segments with a narrowed range, until parsing fails.
-- Returns the sequence of successes with state at the delimiter preceding the failure (or end of input),
-- Note that this will always succeed, sometimes consuming no input and yielding empty results.
splitP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
splitP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
splitP Text
tx ParserT e m a
pa = forall (m :: * -> *) e. Monad m => ParserT e m St
getP forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
splitTailP Text
tx ParserT e m a
pa forall a. Seq a
Empty

-- | Like 'splitP' but ensures the sequence is at least length 1.
split1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
split1P :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
split1P Text
tx ParserT e m a
pa = do
  Maybe (a, St, ())
mz <- forall (m :: * -> *) e a b.
Monad m =>
Text
-> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))
optInfixRP Text
tx ParserT e m a
pa (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  case Maybe (a, St, ())
mz of
    Maybe (a, St, ())
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Seq a
Seq.singleton ParserT e m a
pa
    Just (a
a, St
st', ()
_) -> forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
splitTailP Text
tx ParserT e m a
pa (forall a. a -> Seq a
Seq.singleton a
a) St
st'

-- | Like 'splitP' but ensures the sequence is at least length 2.
-- (This ensures there is at least one delimiter included.)
split2P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
split2P :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
split2P Text
tx ParserT e m a
pa = do
  a
a0 <- forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m a
someBreakP Text
tx ParserT e m a
pa
  Maybe (a, St, ())
mz <- forall (m :: * -> *) e a b.
Monad m =>
Text
-> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))
optInfixRP Text
tx ParserT e m a
pa (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  case Maybe (a, St, ())
mz of
    Maybe (a, St, ())
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Seq a
Empty forall a. Seq a -> a -> Seq a
:|> a
a0 :|>) ParserT e m a
pa
    Just (a
a1, St
st', ()
_) -> forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
splitTailP Text
tx ParserT e m a
pa (forall a. Seq a
Empty forall a. Seq a -> a -> Seq a
:|> a
a0 forall a. Seq a -> a -> Seq a
:|> a
a1) St
st'

-- | Like 'splitP' but ensures a leading delimiter
leadP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
leadP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
leadP Text
tx ParserT e m a
pa = do
  Maybe Text
mu <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
tx)
  case Maybe Text
mu of
    Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Seq a
Empty
    Just Text
_ -> forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
split1P Text
tx ParserT e m a
pa

-- | Like 'split1P' but ensures a leading delimiter
lead1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
lead1P :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
lead1P Text
tx ParserT e m a
pa = forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
tx forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
split1P Text
tx ParserT e m a
pa

-- | Like 'splitP' but ensures a trailing delimiter
trailP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
trailP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
trailP Text
tx ParserT e m a
pa = do
  Seq a
as <- forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
splitP Text
tx ParserT e m a
pa
  case Seq a
as of
    Seq a
Empty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Seq a
Empty
    Seq a
_ -> Seq a
as forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
tx

-- | Like 'split1P' but ensures a trailing delimiter
trail1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a)
trail1P :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
trail1P Text
tx ParserT e m a
pa = forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
split1P Text
tx ParserT e m a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
tx

-- private
subInfixP
  :: Monad m
  => St
  -> ParserT e m a
  -> ParserT e m b
  -> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
  -> [(St, St, St)]
  -> T e m r
subInfixP :: forall (m :: * -> *) e a b r.
Monad m =>
St
-> ParserT e m a
-> ParserT e m b
-> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> [(St, St, St)]
-> T e m r
subInfixP St
st0 ParserT e m a
pa ParserT e m b
pb Either (Err e) (Maybe (a, St, b)) -> T e m r
j = Seq (Int, InfixPhase, Err e) -> [(St, St, St)] -> T e m r
go forall a. Seq a
Empty
 where
  go :: Seq (Int, InfixPhase, Err e) -> [(St, St, St)] -> T e m r
go !Seq (Int, InfixPhase, Err e)
errs = \case
    [] -> do
      forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0
      case Seq (Int, InfixPhase, Err e)
errs of
        Seq (Int, InfixPhase, Err e)
Empty -> Either (Err e) (Maybe (a, St, b)) -> T e m r
j (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)
        Seq (Int, InfixPhase, Err e)
_ -> forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT (forall e r. Seq (Int, InfixPhase, r) -> Reason e r
ReasonInfix Seq (Int, InfixPhase, Err e)
errs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) (Maybe (a, St, b)) -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
    (St
stA, St
stX, St
stB) : [(St, St, St)]
sts -> do
      let startX :: Int
startX = forall a. Span a -> a
spanStart (St -> Span Int
stSpan St
stX)
      forall s (m :: * -> *). MonadState s m => s -> m ()
put St
stA
      forall e (m :: * -> *) a.
ParserT e m a -> forall r. (Either (Err e) a -> T e m r) -> T e m r
unParserT (ParserT e m a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
endP) forall a b. (a -> b) -> a -> b
$ \case
        Left Err e
errA -> Seq (Int, InfixPhase, Err e) -> [(St, St, St)] -> T e m r
go (Seq (Int, InfixPhase, Err e)
errs forall a. Seq a -> a -> Seq a
:|> (Int
startX, InfixPhase
InfixPhaseLeft, Err e
errA)) [(St, St, St)]
sts
        Right a
a -> do
          forall s (m :: * -> *). MonadState s m => s -> m ()
put St
stB
          forall e (m :: * -> *) a.
ParserT e m a -> forall r. (Either (Err e) a -> T e m r) -> T e m r
unParserT ParserT e m b
pb forall a b. (a -> b) -> a -> b
$ \case
            Left Err e
errB -> Seq (Int, InfixPhase, Err e) -> [(St, St, St)] -> T e m r
go (Seq (Int, InfixPhase, Err e)
errs forall a. Seq a -> a -> Seq a
:|> (Int
startX, InfixPhase
InfixPhaseRight, Err e
errB)) [(St, St, St)]
sts
            Right b
b -> do
              Either (Err e) r
ec <- forall (m :: * -> *) e r.
Monad m =>
T e m r -> T e m (Either (Err e) r)
tryT (Either (Err e) (Maybe (a, St, b)) -> T e m r
j (forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just (a
a, St
stX, b
b))))
              case Either (Err e) r
ec of
                Left Err e
errC -> Seq (Int, InfixPhase, Err e) -> [(St, St, St)] -> T e m r
go (Seq (Int, InfixPhase, Err e)
errs forall a. Seq a -> a -> Seq a
:|> (Int
startX, InfixPhase
InfixPhaseCont, Err e
errC)) [(St, St, St)]
sts
                Right r
c -> forall (f :: * -> *) a. Applicative f => a -> f a
pure r
c

-- private
optInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))
optInfixRP :: forall (m :: * -> *) e a b.
Monad m =>
Text
-> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, St, b))
optInfixRP Text
tx ParserT e m a
pa ParserT e m b
pb = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) (Maybe (a, St, b)) -> T e m r
j -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> forall (m :: * -> *) e a b r.
Monad m =>
St
-> ParserT e m a
-> ParserT e m b
-> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> [(St, St, St)]
-> T e m r
subInfixP St
st0 ParserT e m a
pa ParserT e m b
pb (forall e a b (m :: * -> *) r.
(Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
optInfixFn Either (Err e) (Maybe (a, St, b)) -> T e m r
j) (Text -> St -> [(St, St, St)]
breakAllRP Text
tx St
st0))

-- private
optInfixFn
  :: (Either (Err e) (Maybe (a, St, b)) -> T e m r)
  -> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
optInfixFn :: forall e a b (m :: * -> *) r.
(Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
optInfixFn Either (Err e) (Maybe (a, St, b)) -> T e m r
j Either (Err e) (Maybe (a, St, b))
e = case Either (Err e) (Maybe (a, St, b))
e of
  Right Maybe (a, St, b)
_ -> Either (Err e) (Maybe (a, St, b)) -> T e m r
j Either (Err e) (Maybe (a, St, b))
e
  Left Err e
_ -> Either (Err e) (Maybe (a, St, b)) -> T e m r
j (forall a b. b -> Either a b
Right forall a. Maybe a
Nothing)

-- private
requireInfixFn
  :: Monad m
  => (Either (Err e) (a, b) -> T e m r)
  -> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
requireInfixFn :: forall (m :: * -> *) e a b r.
Monad m =>
(Either (Err e) (a, b) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
requireInfixFn Either (Err e) (a, b) -> T e m r
j = \case
  Right Maybe (a, St, b)
mxab ->
    case Maybe (a, St, b)
mxab of
      Maybe (a, St, b)
Nothing -> forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT forall e r. Reason e r
ReasonEmpty forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) (a, b) -> T e m r
j forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
      Just (a
a, St
_, b
b) -> Either (Err e) (a, b) -> T e m r
j (forall a b. b -> Either a b
Right (a
a, b
b))
  Left Err e
e -> Either (Err e) (a, b) -> T e m r
j (forall a b. a -> Either a b
Left Err e
e)

-- | Right-associative infix parsing. Searches for the operator from START to END of range,
-- trying only the first break point.
infixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
infixRP :: forall (m :: * -> *) e a b.
Monad m =>
Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
infixRP Text
tx ParserT e m a
pa ParserT e m b
pb = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) (a, b) -> T e m r
j -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> forall (m :: * -> *) e a b r.
Monad m =>
St
-> ParserT e m a
-> ParserT e m b
-> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> [(St, St, St)]
-> T e m r
subInfixP St
st0 ParserT e m a
pa ParserT e m b
pb (forall (m :: * -> *) e a b r.
Monad m =>
(Either (Err e) (a, b) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
requireInfixFn Either (Err e) (a, b) -> T e m r
j) (forall a. Maybe a -> [a]
maybeToList (Text -> St -> Maybe (St, St, St)
breakRP Text
tx St
st0)))

-- | Right-associative infix parsing. Searches for the operator from START to END of range,
-- trying subsequent break points until success.
someInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
someInfixRP :: forall (m :: * -> *) e a b.
Monad m =>
Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
someInfixRP Text
tx ParserT e m a
pa ParserT e m b
pb = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT (\Either (Err e) (a, b) -> T e m r
j -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> forall (m :: * -> *) e a b r.
Monad m =>
St
-> ParserT e m a
-> ParserT e m b
-> (Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> [(St, St, St)]
-> T e m r
subInfixP St
st0 ParserT e m a
pa ParserT e m b
pb (forall (m :: * -> *) e a b r.
Monad m =>
(Either (Err e) (a, b) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
requireInfixFn Either (Err e) (a, b) -> T e m r
j) (Text -> St -> [(St, St, St)]
breakAllRP Text
tx St
st0))

-- | Take the given number of characters from the start of the range, or fewer if empty
takeP :: Monad m => Int -> ParserT e m Text
takeP :: forall (m :: * -> *) e. Monad m => Int -> ParserT e m Text
takeP Int
i = forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
  let h :: Text
h = St -> Text
stHay St
st
      (Text
o, Text
h') = Int -> Text -> (Text, Text)
T.splitAt Int
i Text
h
      l :: Int
l = Text -> Int
T.length Text
o
      r :: Span Int
r = St -> Span Int
stSpan St
st
      r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanStart Span Int
r forall a. Num a => a -> a -> a
+ Int
l}
      st' :: St
st' = St
st {stHay :: Text
stHay = Text
h', stSpan :: Span Int
stSpan = Span Int
r'}
  in  (Text
o, St
st')

-- | Take exactly the given number of characters from the start of the range, or error
takeExactP :: Monad m => Int -> ParserT e m Text
takeExactP :: forall (m :: * -> *) e. Monad m => Int -> ParserT e m Text
takeExactP Int
i = do
  Either Int Text
et <- forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
    let h :: Text
h = St -> Text
stHay St
st
        (Text
o, Text
h') = Int -> Text -> (Text, Text)
T.splitAt Int
i Text
h
        l :: Int
l = Text -> Int
T.length Text
o
        r :: Span Int
r = St -> Span Int
stSpan St
st
        r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanStart Span Int
r forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
o}
        st' :: St
st' = St
st {stHay :: Text
stHay = Text
h', stSpan :: Span Int
stSpan = Span Int
r'}
    in  if Int
l forall a. Eq a => a -> a -> Bool
== Int
i then (forall a b. b -> Either a b
Right Text
o, St
st') else (forall a b. a -> Either a b
Left Int
l, St
st)
  case Either Int Text
et of
    Left Int
l -> forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (forall e r. Int -> Int -> Reason e r
ReasonDemand Int
i Int
l)
    Right Text
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a

-- | Drop the given number of characters from the start of the range, or fewer if empty
dropP :: Monad m => Int -> ParserT e m Int
dropP :: forall (m :: * -> *) e. Monad m => Int -> ParserT e m Int
dropP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e. Monad m => Int -> ParserT e m Text
takeP

-- | Drop exactly the given number of characters from the start of the range, or error
dropExactP :: Monad m => Int -> ParserT e m ()
dropExactP :: forall (m :: * -> *) e. Monad m => Int -> ParserT e m ()
dropExactP = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e. Monad m => Int -> ParserT e m Text
takeExactP

-- | Take characters from the start of the range satisfying the predicate
takeWhileP :: Monad m => (Char -> Bool) -> ParserT e m Text
takeWhileP :: forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhileP Char -> Bool
f = forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
  let h :: Text
h = St -> Text
stHay St
st
      o :: Text
o = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
f Text
h
      l :: Int
l = Text -> Int
T.length Text
o
      h' :: Text
h' = Int -> Text -> Text
T.drop Int
l Text
h
      r :: Span Int
r = St -> Span Int
stSpan St
st
      r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanStart Span Int
r forall a. Num a => a -> a -> a
+ Int
l}
      st' :: St
st' = St
st {stHay :: Text
stHay = Text
h', stSpan :: Span Int
stSpan = Span Int
r'}
  in  (Text
o, St
st')

-- | Like 'takeWhileP' but ensures at least 1 character has been taken
takeWhile1P :: Monad m => (Char -> Bool) -> ParserT e m Text
takeWhile1P :: forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhile1P Char -> Bool
f = do
  Maybe Text
mt <- forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
    let h :: Text
h = St -> Text
stHay St
st
        o :: Text
o = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
f Text
h
        l :: Int
l = Text -> Int
T.length Text
o
        h' :: Text
h' = Int -> Text -> Text
T.drop Int
l Text
h
        r :: Span Int
r = St -> Span Int
stSpan St
st
        r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanStart Span Int
r forall a. Num a => a -> a -> a
+ Int
l}
        st' :: St
st' = St
st {stHay :: Text
stHay = Text
h', stSpan :: Span Int
stSpan = Span Int
r'}
    in  if Int
l forall a. Eq a => a -> a -> Bool
== Int
0 then (forall a. Maybe a
Nothing, St
st) else (forall a. a -> Maybe a
Just Text
o, St
st')
  case Maybe Text
mt of
    Maybe Text
Nothing -> forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP forall e r. Reason e r
ReasonTakeNone
    Just Text
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a

-- | Drop characters from the start of the range satisfying the predicate
dropWhileP :: Monad m => (Char -> Bool) -> ParserT e m Int
dropWhileP :: forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Int
dropWhileP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhileP

-- | Like 'dropWhileP' but ensures at least 1 character has been dropped
dropWhile1P :: Monad m => (Char -> Bool) -> ParserT e m Int
dropWhile1P :: forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Int
dropWhile1P = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhile1P

-- | Take the remaining range, leaving it empty
takeAllP :: Monad m => ParserT e m Text
takeAllP :: forall (m :: * -> *) e. Monad m => ParserT e m Text
takeAllP = forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
  let h :: Text
h = St -> Text
stHay St
st
      r :: Span Int
r = St -> Span Int
stSpan St
st
      r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanEnd Span Int
r}
      st' :: St
st' = St
st {stHay :: Text
stHay = Text
T.empty, stSpan :: Span Int
stSpan = Span Int
r'}
  in  (Text
h, St
st')

-- | Like 'takeAllP' but ensures at least 1 character has been taken
takeAll1P :: Monad m => ParserT e m Text
takeAll1P :: forall (m :: * -> *) e. Monad m => ParserT e m Text
takeAll1P = do
  Maybe Text
mt <- forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
    let h :: Text
h = St -> Text
stHay St
st
        r :: Span Int
r = St -> Span Int
stSpan St
st
        r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanEnd Span Int
r}
        st' :: St
st' = St
st {stHay :: Text
stHay = Text
T.empty, stSpan :: Span Int
stSpan = Span Int
r'}
    in  if Text -> Bool
T.null Text
h then (forall a. Maybe a
Nothing, St
st) else (forall a. a -> Maybe a
Just Text
h, St
st')
  case Maybe Text
mt of
    Maybe Text
Nothing -> forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (forall e r. Int -> Int -> Reason e r
ReasonDemand Int
1 Int
0)
    Just Text
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
a

-- | Drop the remaining range, leaving it empty
dropAllP :: Monad m => ParserT e m Int
dropAllP :: forall (m :: * -> *) e. Monad m => ParserT e m Int
dropAllP = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length forall (m :: * -> *) e. Monad m => ParserT e m Text
takeAllP

-- | Like 'dropAllP' but ensures at least 1 character has been dropped
dropAll1P :: Monad m => ParserT e m Int
dropAll1P :: forall (m :: * -> *) e. Monad m => ParserT e m Int
dropAll1P = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length forall (m :: * -> *) e. Monad m => ParserT e m Text
takeAll1P

-- | Unwrap a monad transformer layer (see 'scopeP' for use)
transP :: (MonadTrans t, Monad m) => (forall a. t m a -> m a) -> ParserT e (t m) b -> ParserT e m b
transP :: forall (t :: (* -> *) -> * -> *) (m :: * -> *) e b.
(MonadTrans t, Monad m) =>
(forall a. t m a -> m a) -> ParserT e (t m) b -> ParserT e m b
transP forall a. t m a -> m a
f (ParserT forall r. (Either (Err e) b -> T e (t m) r) -> T e (t m) r
g) = forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT forall a b. (a -> b) -> a -> b
$ \Either (Err e) b -> T e m r
j -> do
  St
st0 <- forall s (m :: * -> *). MonadState s m => m s
get
  (Either (Err e) r
ea, St
st1) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall a. t m a -> m a
f (forall e (m :: * -> *) a. T e m a -> St -> m (Either (Err e) a, St)
runT (forall r. (Either (Err e) b -> T e (t m) r) -> T e (t m) r
g (forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Err e) b -> T e m r
j)) St
st0))
  forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st1
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure Either (Err e) r
ea

-- | Parse with some local state
scopeP :: Monad m => s -> ParserT e (StateT s m) a -> ParserT e m a
scopeP :: forall (m :: * -> *) s e a.
Monad m =>
s -> ParserT e (StateT s m) a -> ParserT e m a
scopeP s
s0 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) e b.
(MonadTrans t, Monad m) =>
(forall a. t m a -> m a) -> ParserT e (t m) b -> ParserT e m b
transP (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
`evalStateT` s
s0)

-- | Repeats the parser until it returns a 'Just' value
iterP :: ParserT e m (Maybe a) -> ParserT e m a
iterP :: forall e (m :: * -> *) a. ParserT e m (Maybe a) -> ParserT e m a
iterP ParserT e m (Maybe a)
p = ParserT e m a
go
 where
  go :: ParserT e m a
go = ParserT e m (Maybe a)
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ParserT e m a
go forall (f :: * -> *) a. Applicative f => a -> f a
pure

data StrState = StrState !Bool !(Seq Char)

-- | Parse a string with a custom quote character. Supports backslash-escaping.
strP :: Monad m => Char -> ParserT e m Text
strP :: forall (m :: * -> *) e. Monad m => Char -> ParserT e m Text
strP Char
d = do
  forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ (Char -> Text
T.singleton Char
d)
  forall (m :: * -> *) s e a.
Monad m =>
s -> ParserT e (StateT s m) a -> ParserT e m a
scopeP (Bool -> Seq Char -> StrState
StrState Bool
False forall a. Seq a
Empty) forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ParserT e m (Maybe a) -> ParserT e m a
iterP forall a b. (a -> b) -> a -> b
$ do
    Char
c <- forall (m :: * -> *) e. Monad m => ParserT e m Char
headP
    forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \ss :: StrState
ss@(StrState Bool
esc Seq Char
buf) ->
      if Char
c forall a. Eq a => a -> a -> Bool
== Char
d
        then
          if Bool
esc
            then (forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
False (Seq Char
buf forall a. Seq a -> a -> Seq a
:|> Char
c))
            else (forall a. a -> Maybe a
Just (String -> Text
T.pack (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Char
buf)), StrState
ss)
        else
          if Char
c forall a. Eq a => a -> a -> Bool
== Char
'\\'
            then
              if Bool
esc
                then (forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
False (Seq Char
buf forall a. Seq a -> a -> Seq a
:|> Char
c))
                else (forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
True Seq Char
buf)
            else (forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
False (Seq Char
buf forall a. Seq a -> a -> Seq a
:|> Char
c))

-- | Parse a double-quoted string
doubleStrP :: Monad m => ParserT e m Text
doubleStrP :: forall (m :: * -> *) e. Monad m => ParserT e m Text
doubleStrP = forall (m :: * -> *) e. Monad m => Char -> ParserT e m Text
strP Char
'"'

-- | Parse a single-quoted string
singleStrP :: Monad m => ParserT e m Text
singleStrP :: forall (m :: * -> *) e. Monad m => ParserT e m Text
singleStrP = forall (m :: * -> *) e. Monad m => Char -> ParserT e m Text
strP Char
'\''

-- | Parse between an opening delimiter (first parser) and a closing delimited (second parser)
betweenP :: ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP :: forall e (m :: * -> *) x y a.
ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
betweenP ParserT e m x
px ParserT e m y
py ParserT e m a
pa = ParserT e m x
px forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m y
py

repeatTailP :: Monad m => ParserT e m a -> Seq a -> ParserT e m (Seq a)
repeatTailP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> Seq a -> ParserT e m (Seq a)
repeatTailP ParserT e m a
p = Seq a -> ParserT e m (Seq a)
go
 where
  go :: Seq a -> ParserT e m (Seq a)
go !Seq a
acc = do
    Maybe a
ma <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
p
    case Maybe a
ma of
      Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
acc
      Just a
a -> Seq a -> ParserT e m (Seq a)
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
a)

-- | Repeat a parser until it fails, collecting the results.
repeatP :: Monad m => ParserT e m a -> ParserT e m (Seq a)
repeatP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
repeatP ParserT e m a
p = forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> Seq a -> ParserT e m (Seq a)
repeatTailP ParserT e m a
p forall a. Seq a
Empty

-- | Like 'repeatP' but ensures at least one result.
repeat1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)
repeat1P :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
repeat1P ParserT e m a
p = ParserT e m a
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> Seq a -> ParserT e m (Seq a)
repeatTailP ParserT e m a
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton

-- private
sepByTailP :: Monad m => ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
sepByTailP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
sepByTailP ParserT e m ()
pu ParserT e m a
pa = Seq a -> ParserT e m (Seq a)
go
 where
  go :: Seq a -> ParserT e m (Seq a)
go !Seq a
acc = do
    Maybe a
ma <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (ParserT e m ()
pu forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParserT e m a
pa)
    case Maybe a
ma of
      Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
acc
      Just a
a -> Seq a -> ParserT e m (Seq a)
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
a)

-- | Parse a sequence of items delimited by the first parser
sepByP :: Monad m => ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepByP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepByP ParserT e m ()
pu ParserT e m a
pa = forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
pa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Seq a
Empty) (forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
sepByTailP ParserT e m ()
pu ParserT e m a
pa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton)

-- | Like 'sepByP' but ensures at least one result.
sepBy1P :: Monad m => ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepBy1P :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepBy1P ParserT e m ()
pu ParserT e m a
pa = ParserT e m a
pa forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
sepByTailP ParserT e m ()
pu ParserT e m a
pa forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton

-- | Like 'sepByP' but ensures at least two results (and at least one delimiter).
sepBy2P :: Monad m => ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepBy2P :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> ParserT e m (Seq a)
sepBy2P ParserT e m ()
pu ParserT e m a
pa = do
  a
a0 <- ParserT e m a
pa
  ParserT e m ()
pu
  a
a1 <- ParserT e m a
pa
  forall (m :: * -> *) e a.
Monad m =>
ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
sepByTailP ParserT e m ()
pu ParserT e m a
pa (forall a. Seq a
Empty forall a. Seq a -> a -> Seq a
:|> a
a0 forall a. Seq a -> a -> Seq a
:|> a
a1)

-- | Consumes many spaces at the start of the range
spaceP :: Monad m => ParserT e m ()
spaceP :: forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Int
dropWhileP Char -> Bool
isSpace)

-- | Strips spaces before and after parsing
stripP :: Monad m => ParserT e m a -> ParserT e m a
stripP :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripP ParserT e m a
p = forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP

-- | Strips spaces before parsing
stripStartP :: Monad m => ParserT e m a -> ParserT e m a
stripStartP :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripStartP ParserT e m a
p = forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
p

-- | Strips spaces after parsing
stripEndP :: Monad m => ParserT e m a -> ParserT e m a
stripEndP :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEndP ParserT e m a
p = ParserT e m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP

-- | Parses and returns the length of the consumed input along with the result
measureP :: Monad m => ParserT e m a -> ParserT e m (a, Int)
measureP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP ParserT e m a
p = do
  Int
start <- forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP (forall a. Span a -> a
spanStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. St -> Span Int
stSpan)
  a
a <- ParserT e m a
p
  Int
end <- forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP (forall a. Span a -> a
spanStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. St -> Span Int
stSpan)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Int
end forall a. Num a => a -> a -> a
- Int
start)

-- | Takes exactly 1 character from the start of the range, returning Nothing
-- if at end of input
unconsP :: Monad m => ParserT e m (Maybe Char)
unconsP :: forall (m :: * -> *) e. Monad m => ParserT e m (Maybe Char)
unconsP = forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP forall a b. (a -> b) -> a -> b
$ \St
st ->
  let h :: Text
h = St -> Text
stHay St
st
      mxy :: Maybe (Char, Text)
mxy = Text -> Maybe (Char, Text)
T.uncons Text
h
  in  case Maybe (Char, Text)
mxy of
        Maybe (Char, Text)
Nothing -> (forall a. Maybe a
Nothing, St
st)
        Just (Char
x, Text
y) ->
          let r :: Span Int
r = St -> Span Int
stSpan St
st
              r' :: Span Int
r' = Span Int
r {spanStart :: Int
spanStart = forall a. Span a -> a
spanStart Span Int
r forall a. Num a => a -> a -> a
+ Int
1}
              st' :: St
st' = St
st {stHay :: Text
stHay = Text
y, stSpan :: Span Int
stSpan = Span Int
r'}
          in  (forall a. a -> Maybe a
Just Char
x, St
st')

-- | Takes exactly 1 character from the start of the range, throwing error
-- if at end of input
headP :: Monad m => ParserT e m Char
headP :: forall (m :: * -> *) e. Monad m => ParserT e m Char
headP = forall (m :: * -> *) e. Monad m => ParserT e m (Maybe Char)
unconsP forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (forall e r. Int -> Int -> Reason e r
ReasonDemand Int
1 Int
0)) forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Add signed-ness to any parser with a negate function
signedWithP :: Monad m => (a -> a) -> ParserT e m a -> ParserT e m a
signedWithP :: forall (m :: * -> *) a e.
Monad m =>
(a -> a) -> ParserT e m a -> ParserT e m a
signedWithP a -> a
neg ParserT e m a
p = do
  Maybe Char
ms <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Char -> ParserT e m Char
charP Char
'-')
  case Maybe Char
ms of
    Maybe Char
Nothing -> ParserT e m a
p
    Just Char
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
neg ParserT e m a
p

-- | Add signed-ness to any numeric parser
signedP :: (Monad m, Num a) => ParserT e m a -> ParserT e m a
signedP :: forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP = forall (m :: * -> *) a e.
Monad m =>
(a -> a) -> ParserT e m a -> ParserT e m a
signedWithP forall a. Num a => a -> a
negate

-- | Parse an signed integer
intP :: Monad m => ParserT e m Integer
intP :: forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP = forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP

-- | Parse an unsigned integer
uintP :: Monad m => ParserT e m Integer
uintP :: forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP = forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Integer
n Char
d -> Integer
n forall a. Num a => a -> a -> a
* Integer
10 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
d)) Integer
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Text
takeWhile1P Char -> Bool
isDigit

-- | Parse a signed decimal
decP :: Monad m => ParserT e m Rational
decP :: forall (m :: * -> *) e. Monad m => ParserT e m Rational
decP = forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP forall (m :: * -> *) e. Monad m => ParserT e m Rational
udecP

-- | Parse an unsigned decimal
udecP :: Monad m => ParserT e m Rational
udecP :: forall (m :: * -> *) e. Monad m => ParserT e m Rational
udecP = do
  Rational
whole <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => Integer -> a
fromInteger forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
  Bool
hasDot <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Char -> ParserT e m Char
charP Char
'.'))
  if Bool
hasDot
    then do
      (Integer
numerator, Int
places) <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
      let denominator :: Integer
denominator = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
places
          part :: Rational
part = Integer
numerator forall a. Integral a => a -> a -> Ratio a
% Integer
denominator
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational
whole forall a. Num a => a -> a -> a
+ Rational
part)
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure Rational
whole

-- | Parse a signed scientific number
sciP :: Monad m => ParserT e m Scientific
sciP :: forall (m :: * -> *) e. Monad m => ParserT e m Scientific
sciP = forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP forall (m :: * -> *) e. Monad m => ParserT e m Scientific
usciP

-- | Parse an unsigned scientific  number
usciP :: Monad m => ParserT e m Scientific
usciP :: forall (m :: * -> *) e. Monad m => ParserT e m Scientific
usciP = do
  Integer
whole <- forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
  Bool
hasDot <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'.'))
  (Integer
frac, Int
places) <- if Bool
hasDot then forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
0, Int
0)
  Bool
hasEx <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'e' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'E'))
  Int
ex <- if Bool
hasEx then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP else forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
  let wholeS :: Scientific
wholeS = Integer -> Int -> Scientific
S.scientific Integer
whole Int
ex
      partS :: Scientific
partS = Integer -> Int -> Scientific
S.scientific Integer
frac (Int
ex forall a. Num a => a -> a -> a
- Int
places)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific
wholeS forall a. Num a => a -> a -> a
+ Scientific
partS)

-- | Parse a signed integer/scientific number, defaulting to integer if possible.
numP :: Monad m => ParserT e m (Either Integer Scientific)
numP :: forall (m :: * -> *) e.
Monad m =>
ParserT e m (Either Integer Scientific)
numP = forall (m :: * -> *) a e.
Monad m =>
(a -> a) -> ParserT e m a -> ParserT e m a
signedWithP (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Num a => a -> a
negate forall a. Num a => a -> a
negate) forall (m :: * -> *) e.
Monad m =>
ParserT e m (Either Integer Scientific)
unumP

-- | Parse an unsigned integer/scientific number, defaulting to integer if possible.
unumP :: Monad m => ParserT e m (Either Integer Scientific)
unumP :: forall (m :: * -> *) e.
Monad m =>
ParserT e m (Either Integer Scientific)
unumP = do
  Integer
whole <- forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
  Bool
hasDot <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'.'))
  Maybe (Integer, Int)
mayFracPlaces <- if Bool
hasDot then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP) else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  Bool
hasEx <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isJust (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'e' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'E'))
  Maybe Int
mayEx <- if Bool
hasEx then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
  case (Maybe (Integer, Int)
mayFracPlaces, Maybe Int
mayEx) of
    (Maybe (Integer, Int)
Nothing, Maybe Int
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left Integer
whole)
    (Maybe (Integer, Int), Maybe Int)
_ -> do
      let (Integer
frac, Int
places) = forall a. a -> Maybe a -> a
fromMaybe (Integer
0, Int
0) Maybe (Integer, Int)
mayFracPlaces
          ex :: Int
ex = forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
mayEx
          wholeS :: Scientific
wholeS = Integer -> Int -> Scientific
S.scientific Integer
whole Int
ex
          partS :: Scientific
partS = Integer -> Int -> Scientific
S.scientific Integer
frac (Int
ex forall a. Num a => a -> a -> a
- Int
places)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right (Scientific
wholeS forall a. Num a => a -> a -> a
+ Scientific
partS))

-- | Like 'spaceP' but ensures at least 1 space removed
space1P :: Monad m => ParserT e m ()
space1P :: forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P = forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (m :: * -> *) e.
Monad m =>
(Char -> Bool) -> ParserT e m Int
dropWhile1P Char -> Bool
isSpace)

-- | Like 'stripP' but ensures at least 1 space removed
strip1P :: Monad m => ParserT e m a -> ParserT e m a
strip1P :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
strip1P ParserT e m a
p = forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P

-- | Like 'stripStartP' but ensures at least 1 space removed
stripStart1P :: Monad m => ParserT e m a -> ParserT e m a
stripStart1P :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripStart1P ParserT e m a
p = forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
p

-- | Like 'stripEndP' but ensures at least 1 space removed
stripEnd1P :: Monad m => ParserT e m a -> ParserT e m a
stripEnd1P :: forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
stripEnd1P ParserT e m a
p = ParserT e m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P

-- | Implement this to format custom errors. The list will be joined with `unlines`.
class HasErrMessage e where
  getErrMessage :: e -> [Text]

instance HasErrMessage Void where
  getErrMessage :: Void -> [Text]
getErrMessage = forall a. Void -> a
absurd

-- private
indent :: Int -> [Text] -> [Text]
indent :: Int -> [Text] -> [Text]
indent Int
i = let s :: Text
s = Int -> Text -> Text
T.replicate (Int
2 forall a. Num a => a -> a -> a
* Int
i) Text
" " in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
s <>)

instance HasErrMessage e => HasErrMessage (Err e) where
  getErrMessage :: Err e -> [Text]
getErrMessage (Err (ErrF (Span Int
start Int
end) Reason e (Err e)
re)) =
    let pos :: Text
pos = Text
"Error in range: (" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
start) forall a. Semigroup a => a -> a -> a
<> Text
", " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
end) forall a. Semigroup a => a -> a -> a
<> Text
")"
        body :: [Text]
body = case Reason e (Err e)
re of
          ReasonCustom e
e ->
            let hd :: Text
hd = Text
"Custom error:"
                tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 (forall e. HasErrMessage e => e -> [Text]
getErrMessage e
e)
            in  Text
hd forall a. a -> [a] -> [a]
: [Text]
tl
          ReasonExpect Text
expected Text
actual ->
            [Text
"Expected text: '" forall a. Semigroup a => a -> a -> a
<> Text
expected forall a. Semigroup a => a -> a -> a
<> Text
"' but found: '" forall a. Semigroup a => a -> a -> a
<> Text
actual forall a. Semigroup a => a -> a -> a
<> Text
"'"]
          ReasonDemand Int
expected Int
actual ->
            [Text
"Expected count: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
expected) forall a. Semigroup a => a -> a -> a
<> Text
" but got: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
actual)]
          ReasonLeftover Int
count ->
            [Text
"Expected end but had leftover count: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
count)]
          ReasonAlt Seq (AltPhase, Err e)
errs ->
            let hd :: Text
hd = Text
"Alternatives:"
                tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 forall a b. (a -> b) -> a -> b
$ do
                  (AltPhase
_, Err e
e) <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (AltPhase, Err e)
errs
                  Text
"Tried:" forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
indent Int
1 (forall e. HasErrMessage e => e -> [Text]
getErrMessage Err e
e)
            in  Text
hd forall a. a -> [a] -> [a]
: [Text]
tl
          ReasonInfix Seq (Int, InfixPhase, Err e)
errs ->
            let hd :: Text
hd = Text
"Infix/split failed:"
                tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 forall a b. (a -> b) -> a -> b
$ do
                  (Int
i, InfixPhase
_, Err e
e) <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Int, InfixPhase, Err e)
errs
                  let x :: Text
x = Text
"Tried position: " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Int
i)
                  Text
x forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
indent Int
1 (forall e. HasErrMessage e => e -> [Text]
getErrMessage Err e
e)
            in  Text
hd forall a. a -> [a] -> [a]
: [Text]
tl
          ReasonFail Text
msg -> [Text
"User reported failure: " forall a. Semigroup a => a -> a -> a
<> Text
msg]
          ReasonLabeled Label
lab Err e
e ->
            let hd :: Text
hd = Text
"Labeled parser: " forall a. Semigroup a => a -> a -> a
<> Label -> Text
unLabel Label
lab
                tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 (forall e. HasErrMessage e => e -> [Text]
getErrMessage Err e
e)
            in  Text
hd forall a. a -> [a] -> [a]
: [Text]
tl
          ReasonLook Err e
e ->
            let hd :: Text
hd = Text
"Error in lookahead:"
                tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 (forall e. HasErrMessage e => e -> [Text]
getErrMessage Err e
e)
            in  Text
hd forall a. a -> [a] -> [a]
: [Text]
tl
          Reason e (Err e)
ReasonTakeNone -> [Text
"Took/dropped no elements"]
          Reason e (Err e)
ReasonEmpty -> [Text
"No parse results"]
    in  Text
pos forall a. a -> [a] -> [a]
: [Text]
body

-- | Create 'Errata' formatting a parse error
errataE :: HasErrMessage e => FilePath -> (Int -> (E.Line, E.Column)) -> Err e -> [E.Errata]
errataE :: forall e.
HasErrMessage e =>
String -> (Int -> (Int, Int)) -> Err e -> [Errata]
errataE String
fp Int -> (Int, Int)
mkP Err e
e =
  let (Int
line, Int
col) = Int -> (Int, Int)
mkP (forall a. Span a -> a
spanStart (forall e. Err e -> Span Int
errSpan Err e
e))
      msg :: [Text]
msg = forall e. HasErrMessage e => e -> [Text]
getErrMessage Err e
e
      block :: Block
block = Style
-> PointerStyle
-> String
-> Maybe Text
-> (Int, Int, Int, Maybe Text)
-> Maybe Text
-> Block
E.blockSimple Style
E.basicStyle PointerStyle
E.basicPointer String
fp forall a. Maybe a
Nothing (Int
line, Int
col, Int
col forall a. Num a => a -> a -> a
+ Int
1, forall a. Maybe a
Nothing) (forall a. a -> Maybe a
Just ([Text] -> Text
T.unlines [Text]
msg))
  in  [Maybe Text -> [Block] -> Maybe Text -> Errata
E.Errata forall a. Maybe a
Nothing [Block
block] forall a. Maybe a
Nothing]

-- | Render a formatted error to text
renderE :: HasErrMessage e => FilePath -> Text -> Err e -> Text
renderE :: forall e. HasErrMessage e => String -> Text -> Err e -> Text
renderE String
fp Text
h Err e
e =
  let v :: LineColLookup
v = Text -> LineColLookup
calculateLineCol Text
h
      mkP :: Int -> (Int, Int)
mkP Int
i = let (Int
l, Int
c) = Int -> LineColLookup -> (Int, Int)
lookupLineCol Int
i LineColLookup
v in (Int
l forall a. Num a => a -> a -> a
+ Int
1, Int
c forall a. Num a => a -> a -> a
+ Int
1)
  in  Text -> Text
TL.toStrict (forall source. Source source => source -> [Errata] -> Text
E.prettyErrors Text
h (forall e.
HasErrMessage e =>
String -> (Int -> (Int, Int)) -> Err e -> [Errata]
errataE String
fp Int -> (Int, Int)
mkP Err e
e))

-- | Print a formatted error to stderr
printE :: HasErrMessage e => FilePath -> Text -> Err e -> IO ()
printE :: forall e. HasErrMessage e => String -> Text -> Err e -> IO ()
printE String
fp Text
h Err e
e = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (forall e. HasErrMessage e => String -> Text -> Err e -> Text
renderE String
fp Text
h Err e
e)