{-# 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
  , spanAroundP
  , throwP
  , altP
  , emptyP
  , explainP
  , endP
  , optP
  , lookP
  , branchP
  , commitP
  , 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 (..))
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
(Span a -> Span a -> Bool)
-> (Span a -> Span a -> Bool) -> Eq (Span a)
forall a. Eq a => Span a -> Span a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Span a -> Span a -> Bool
Eq, Eq (Span a)
Eq (Span a) =>
(Span a -> Span a -> Ordering)
-> (Span a -> Span a -> Bool)
-> (Span a -> Span a -> Bool)
-> (Span a -> Span a -> Bool)
-> (Span a -> Span a -> Bool)
-> (Span a -> Span a -> Span a)
-> (Span a -> Span a -> Span a)
-> Ord (Span a)
Span a -> Span a -> Bool
Span a -> Span a -> Ordering
Span a -> Span a -> Span a
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
$ccompare :: forall a. Ord a => Span a -> Span a -> Ordering
compare :: Span a -> Span a -> Ordering
$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
>= :: Span a -> Span a -> Bool
$cmax :: forall a. Ord a => Span a -> Span a -> Span a
max :: Span a -> Span a -> Span a
$cmin :: forall a. Ord a => Span a -> Span a -> Span a
min :: Span a -> Span a -> Span a
Ord, Int -> Span a -> ShowS
[Span a] -> ShowS
Span a -> String
(Int -> Span a -> ShowS)
-> (Span a -> String) -> ([Span a] -> ShowS) -> Show (Span a)
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
$cshowsPrec :: forall a. Show a => Int -> Span a -> ShowS
showsPrec :: Int -> Span a -> ShowS
$cshow :: forall a. Show a => Span a -> String
show :: Span a -> String
$cshowList :: forall a. Show a => [Span a] -> ShowS
showList :: [Span a] -> ShowS
Show, (forall a b. (a -> b) -> Span a -> Span b)
-> (forall a b. a -> Span b -> Span a) -> Functor Span
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
$cfmap :: forall a b. (a -> b) -> Span a -> Span b
fmap :: forall a b. (a -> b) -> Span a -> Span b
$c<$ :: forall a b. a -> Span b -> Span a
<$ :: forall a b. a -> Span b -> Span a
Functor, (forall m. Monoid m => Span m -> m)
-> (forall m a. Monoid m => (a -> m) -> Span a -> m)
-> (forall m a. Monoid m => (a -> m) -> Span a -> m)
-> (forall a b. (a -> b -> b) -> b -> Span a -> b)
-> (forall a b. (a -> b -> b) -> b -> Span a -> b)
-> (forall b a. (b -> a -> b) -> b -> Span a -> b)
-> (forall b a. (b -> a -> b) -> b -> Span a -> b)
-> (forall a. (a -> a -> a) -> Span a -> a)
-> (forall a. (a -> a -> a) -> Span a -> a)
-> (forall a. Span a -> [a])
-> (forall a. Span a -> Bool)
-> (forall a. Span a -> Int)
-> (forall a. Eq a => a -> Span a -> Bool)
-> (forall a. Ord a => Span a -> a)
-> (forall a. Ord a => Span a -> a)
-> (forall a. Num a => Span a -> a)
-> (forall a. Num a => Span a -> a)
-> Foldable Span
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
$cfold :: forall m. Monoid m => Span m -> m
fold :: forall m. Monoid m => Span m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Span a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Span a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Span a -> a
foldr1 :: forall a. (a -> a -> a) -> Span a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Span a -> a
foldl1 :: forall a. (a -> a -> a) -> Span a -> a
$ctoList :: forall a. Span a -> [a]
toList :: forall a. Span a -> [a]
$cnull :: forall a. Span a -> Bool
null :: forall a. Span a -> Bool
$clength :: forall a. Span a -> Int
length :: forall a. Span a -> Int
$celem :: forall a. Eq a => a -> Span a -> Bool
elem :: forall a. Eq a => a -> Span a -> Bool
$cmaximum :: forall a. Ord a => Span a -> a
maximum :: forall a. Ord a => Span a -> a
$cminimum :: forall a. Ord a => Span a -> a
minimum :: forall a. Ord a => Span a -> a
$csum :: forall a. Num a => Span a -> a
sum :: forall a. Num a => Span a -> a
$cproduct :: forall a. Num a => Span a -> a
product :: forall a. Num a => Span a -> a
Foldable, Functor Span
Foldable Span
(Functor Span, Foldable Span) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Span a -> f (Span b))
-> (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 (m :: * -> *) a. Monad m => Span (m a) -> m (Span a))
-> Traversable 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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Span a -> f (Span b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Span (f a) -> f (Span a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Span a -> m (Span b)
$csequence :: forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
sequence :: forall (m :: * -> *) a. Monad m => Span (m a) -> m (Span a)
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 = Int
-> (((Int, Int), String)
    -> Maybe ((Int, Int), ((Int, Int), String)))
-> ((Int, Int), String)
-> LineColLookup
forall b a. Int -> (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldrN (Text -> Int
T.length Text
t) ((Int, Int), String) -> Maybe ((Int, Int), ((Int, Int), String))
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
      [] -> Maybe ((a, b), ((a, b), String))
forall a. Maybe a
Nothing
      Char
x : String
xs' -> ((a, b), ((a, b), String)) -> Maybe ((a, b), ((a, b), String))
forall a. a -> Maybe a
Just ((a, b)
p, if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then ((a
line a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, b
0), String
xs') else ((a
line, b
col b -> b -> b
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 LineColLookup -> Bool
forall a. Vector a -> Bool
V.null LineColLookup
v
    then (Int
0, Int
0)
    else LineColLookup
v LineColLookup -> Int -> (Int, Int)
forall a. Vector a -> Int -> a
V.! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i (LineColLookup -> Int
forall a. Vector a -> Int
V.length LineColLookup
v Int -> Int -> Int
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
(Int -> Label -> ShowS)
-> (Label -> String) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> String
show :: Label -> String
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
Show)
  deriving newtype (Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
Eq, Eq Label
Eq Label =>
(Label -> Label -> Ordering)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Bool)
-> (Label -> Label -> Label)
-> (Label -> Label -> Label)
-> Ord 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
$ccompare :: Label -> Label -> Ordering
compare :: Label -> Label -> Ordering
$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
>= :: Label -> Label -> Bool
$cmax :: Label -> Label -> Label
max :: Label -> Label -> Label
$cmin :: Label -> Label -> Label
min :: Label -> Label -> Label
Ord, String -> Label
(String -> Label) -> IsString Label
forall a. (String -> a) -> IsString a
$cfromString :: String -> Label
fromString :: String -> Label
IsString)

-- | Create a span from the given text
textSpan :: Text -> Span Int
textSpan :: Text -> Span Int
textSpan Text
t = Int -> Int -> Span Int
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
(St -> St -> Bool) -> (St -> St -> Bool) -> Eq St
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: St -> St -> Bool
== :: St -> St -> Bool
$c/= :: St -> St -> Bool
/= :: St -> St -> Bool
Eq, Eq St
Eq St =>
(St -> St -> Ordering)
-> (St -> St -> Bool)
-> (St -> St -> Bool)
-> (St -> St -> Bool)
-> (St -> St -> Bool)
-> (St -> St -> St)
-> (St -> St -> St)
-> Ord 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
$ccompare :: St -> St -> Ordering
compare :: St -> St -> Ordering
$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
>= :: St -> St -> Bool
$cmax :: St -> St -> St
max :: St -> St -> St
$cmin :: St -> St -> St
min :: St -> St -> St
Ord, Int -> St -> ShowS
[St] -> ShowS
St -> String
(Int -> St -> ShowS)
-> (St -> String) -> ([St] -> ShowS) -> Show St
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> St -> ShowS
showsPrec :: Int -> St -> ShowS
$cshow :: St -> String
show :: St -> String
$cshowList :: [St] -> ShowS
showList :: [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) = ((Text, Text) -> (St, St, St)) -> [(Text, Text)] -> [(St, St, St)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> (St, St, St)
go (HasCallStack => Text -> Text -> [(Text, Text)]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
aLen
        needLen :: Int
needLen = Text -> Int
T.length Text
needle
        rngA :: Span Int
rngA = Int -> Int -> Span Int
forall a. a -> a -> Span a
Span Int
r0 Int
endA
        rngX :: Span Int
rngX = Int -> Int -> Span Int
forall a. a -> a -> Span a
Span Int
endA Int
r1
        rngB :: Span Int
rngB = Int -> Int -> Span Int
forall a. a -> a -> Span a
Span (Int
endA Int -> Int -> Int
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) = HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
needle Text
hay
  in  if Text -> Bool
T.null Text
hayB
        then Maybe (St, St, St)
forall a. Maybe a
Nothing
        else
          let aLen :: Int
aLen = Text -> Int
T.length Text
hayA
              endA :: Int
endA = Int
r0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
aLen
              needLen :: Int
needLen = Text -> Int
T.length Text
needle
              rngA :: Span Int
rngA = Int -> Int -> Span Int
forall a. a -> a -> Span a
Span Int
r0 Int
endA
              rngX :: Span Int
rngX = Int -> Int -> Span Int
forall a. a -> a -> Span a
Span Int
endA Int
r1
              rngB :: Span Int
rngB = Int -> Int -> Span Int
forall a. a -> a -> Span a
Span (Int
endA Int -> Int -> Int
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, St, St) -> Maybe (St, St, St)
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
(AltPhase -> AltPhase -> Bool)
-> (AltPhase -> AltPhase -> Bool) -> Eq AltPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AltPhase -> AltPhase -> Bool
== :: AltPhase -> AltPhase -> Bool
$c/= :: AltPhase -> AltPhase -> Bool
/= :: AltPhase -> AltPhase -> Bool
Eq, Eq AltPhase
Eq AltPhase =>
(AltPhase -> AltPhase -> Ordering)
-> (AltPhase -> AltPhase -> Bool)
-> (AltPhase -> AltPhase -> Bool)
-> (AltPhase -> AltPhase -> Bool)
-> (AltPhase -> AltPhase -> Bool)
-> (AltPhase -> AltPhase -> AltPhase)
-> (AltPhase -> AltPhase -> AltPhase)
-> Ord 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
$ccompare :: AltPhase -> AltPhase -> Ordering
compare :: AltPhase -> AltPhase -> Ordering
$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
>= :: AltPhase -> AltPhase -> Bool
$cmax :: AltPhase -> AltPhase -> AltPhase
max :: AltPhase -> AltPhase -> AltPhase
$cmin :: AltPhase -> AltPhase -> AltPhase
min :: AltPhase -> AltPhase -> AltPhase
Ord, Int -> AltPhase -> ShowS
[AltPhase] -> ShowS
AltPhase -> String
(Int -> AltPhase -> ShowS)
-> (AltPhase -> String) -> ([AltPhase] -> ShowS) -> Show AltPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AltPhase -> ShowS
showsPrec :: Int -> AltPhase -> ShowS
$cshow :: AltPhase -> String
show :: AltPhase -> String
$cshowList :: [AltPhase] -> ShowS
showList :: [AltPhase] -> ShowS
Show, Int -> AltPhase
AltPhase -> Int
AltPhase -> [AltPhase]
AltPhase -> AltPhase
AltPhase -> AltPhase -> [AltPhase]
AltPhase -> AltPhase -> AltPhase -> [AltPhase]
(AltPhase -> AltPhase)
-> (AltPhase -> AltPhase)
-> (Int -> AltPhase)
-> (AltPhase -> Int)
-> (AltPhase -> [AltPhase])
-> (AltPhase -> AltPhase -> [AltPhase])
-> (AltPhase -> AltPhase -> [AltPhase])
-> (AltPhase -> AltPhase -> AltPhase -> [AltPhase])
-> Enum 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
$csucc :: AltPhase -> AltPhase
succ :: AltPhase -> AltPhase
$cpred :: AltPhase -> AltPhase
pred :: AltPhase -> AltPhase
$ctoEnum :: Int -> AltPhase
toEnum :: Int -> AltPhase
$cfromEnum :: AltPhase -> Int
fromEnum :: AltPhase -> Int
$cenumFrom :: AltPhase -> [AltPhase]
enumFrom :: AltPhase -> [AltPhase]
$cenumFromThen :: AltPhase -> AltPhase -> [AltPhase]
enumFromThen :: AltPhase -> AltPhase -> [AltPhase]
$cenumFromTo :: AltPhase -> AltPhase -> [AltPhase]
enumFromTo :: AltPhase -> AltPhase -> [AltPhase]
$cenumFromThenTo :: AltPhase -> AltPhase -> AltPhase -> [AltPhase]
enumFromThenTo :: AltPhase -> AltPhase -> AltPhase -> [AltPhase]
Enum, AltPhase
AltPhase -> AltPhase -> Bounded AltPhase
forall a. a -> a -> Bounded a
$cminBound :: AltPhase
minBound :: AltPhase
$cmaxBound :: AltPhase
maxBound :: AltPhase
Bounded)

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

-- | Whether to hide an underlying error or not
data HideError = HideErrorNo | HideErrorYes
  deriving stock (HideError -> HideError -> Bool
(HideError -> HideError -> Bool)
-> (HideError -> HideError -> Bool) -> Eq HideError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HideError -> HideError -> Bool
== :: HideError -> HideError -> Bool
$c/= :: HideError -> HideError -> Bool
/= :: HideError -> HideError -> Bool
Eq, Eq HideError
Eq HideError =>
(HideError -> HideError -> Ordering)
-> (HideError -> HideError -> Bool)
-> (HideError -> HideError -> Bool)
-> (HideError -> HideError -> Bool)
-> (HideError -> HideError -> Bool)
-> (HideError -> HideError -> HideError)
-> (HideError -> HideError -> HideError)
-> Ord HideError
HideError -> HideError -> Bool
HideError -> HideError -> Ordering
HideError -> HideError -> HideError
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
$ccompare :: HideError -> HideError -> Ordering
compare :: HideError -> HideError -> Ordering
$c< :: HideError -> HideError -> Bool
< :: HideError -> HideError -> Bool
$c<= :: HideError -> HideError -> Bool
<= :: HideError -> HideError -> Bool
$c> :: HideError -> HideError -> Bool
> :: HideError -> HideError -> Bool
$c>= :: HideError -> HideError -> Bool
>= :: HideError -> HideError -> Bool
$cmax :: HideError -> HideError -> HideError
max :: HideError -> HideError -> HideError
$cmin :: HideError -> HideError -> HideError
min :: HideError -> HideError -> HideError
Ord, Int -> HideError -> ShowS
[HideError] -> ShowS
HideError -> String
(Int -> HideError -> ShowS)
-> (HideError -> String)
-> ([HideError] -> ShowS)
-> Show HideError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HideError -> ShowS
showsPrec :: Int -> HideError -> ShowS
$cshow :: HideError -> String
show :: HideError -> String
$cshowList :: [HideError] -> ShowS
showList :: [HideError] -> ShowS
Show, Int -> HideError
HideError -> Int
HideError -> [HideError]
HideError -> HideError
HideError -> HideError -> [HideError]
HideError -> HideError -> HideError -> [HideError]
(HideError -> HideError)
-> (HideError -> HideError)
-> (Int -> HideError)
-> (HideError -> Int)
-> (HideError -> [HideError])
-> (HideError -> HideError -> [HideError])
-> (HideError -> HideError -> [HideError])
-> (HideError -> HideError -> HideError -> [HideError])
-> Enum HideError
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: HideError -> HideError
succ :: HideError -> HideError
$cpred :: HideError -> HideError
pred :: HideError -> HideError
$ctoEnum :: Int -> HideError
toEnum :: Int -> HideError
$cfromEnum :: HideError -> Int
fromEnum :: HideError -> Int
$cenumFrom :: HideError -> [HideError]
enumFrom :: HideError -> [HideError]
$cenumFromThen :: HideError -> HideError -> [HideError]
enumFromThen :: HideError -> HideError -> [HideError]
$cenumFromTo :: HideError -> HideError -> [HideError]
enumFromTo :: HideError -> HideError -> [HideError]
$cenumFromThenTo :: HideError -> HideError -> HideError -> [HideError]
enumFromThenTo :: HideError -> HideError -> HideError -> [HideError]
Enum, HideError
HideError -> HideError -> Bounded HideError
forall a. a -> a -> Bounded a
$cminBound :: HideError
minBound :: HideError
$cmaxBound :: HideError
maxBound :: HideError
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
  | ReasonExplained !Text !HideError r
  deriving stock (Reason e r -> Reason e r -> Bool
(Reason e r -> Reason e r -> Bool)
-> (Reason e r -> Reason e r -> Bool) -> Eq (Reason e r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e r. (Eq e, Eq r) => 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
/= :: Reason e r -> Reason e r -> Bool
Eq, Eq (Reason e r)
Eq (Reason e r) =>
(Reason e r -> Reason e r -> Ordering)
-> (Reason e r -> Reason e r -> Bool)
-> (Reason e r -> Reason e r -> Bool)
-> (Reason e r -> Reason e r -> Bool)
-> (Reason e r -> Reason e r -> Bool)
-> (Reason e r -> Reason e r -> Reason e r)
-> (Reason e r -> Reason e r -> Reason e r)
-> Ord (Reason e r)
Reason e r -> Reason e r -> Bool
Reason e r -> Reason e r -> Ordering
Reason e r -> Reason e r -> Reason e r
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
$ccompare :: forall e r. (Ord e, Ord r) => Reason e r -> Reason e r -> Ordering
compare :: Reason e r -> Reason e r -> Ordering
$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
>= :: Reason e r -> Reason e r -> Bool
$cmax :: 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
$cmin :: 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
Ord, Int -> Reason e r -> ShowS
[Reason e r] -> ShowS
Reason e r -> String
(Int -> Reason e r -> ShowS)
-> (Reason e r -> String)
-> ([Reason e r] -> ShowS)
-> Show (Reason e r)
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
$cshowsPrec :: forall e r. (Show e, Show r) => Int -> Reason e r -> ShowS
showsPrec :: Int -> Reason e r -> ShowS
$cshow :: forall e r. (Show e, Show r) => Reason e r -> String
show :: Reason e r -> String
$cshowList :: forall e r. (Show e, Show r) => [Reason e r] -> ShowS
showList :: [Reason e r] -> ShowS
Show, (forall a b. (a -> b) -> Reason e a -> Reason e b)
-> (forall a b. a -> Reason e b -> Reason e a)
-> Functor (Reason e)
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
$cfmap :: forall e a b. (a -> b) -> Reason e a -> Reason e b
fmap :: forall a b. (a -> b) -> Reason e a -> Reason e b
$c<$ :: forall e a b. a -> Reason e b -> Reason e a
<$ :: forall a b. a -> Reason e b -> Reason e a
Functor, (forall m. Monoid m => Reason e m -> m)
-> (forall m a. Monoid m => (a -> m) -> Reason e a -> m)
-> (forall m a. Monoid m => (a -> m) -> Reason e a -> m)
-> (forall a b. (a -> b -> b) -> b -> Reason e a -> b)
-> (forall a b. (a -> b -> b) -> b -> Reason e a -> b)
-> (forall b a. (b -> a -> b) -> b -> Reason e a -> b)
-> (forall b a. (b -> a -> b) -> b -> Reason e a -> b)
-> (forall a. (a -> a -> a) -> Reason e a -> a)
-> (forall a. (a -> a -> a) -> Reason e a -> a)
-> (forall a. Reason e a -> [a])
-> (forall a. Reason e a -> Bool)
-> (forall a. Reason e a -> Int)
-> (forall a. Eq a => a -> Reason e a -> Bool)
-> (forall a. Ord a => Reason e a -> a)
-> (forall a. Ord a => Reason e a -> a)
-> (forall a. Num a => Reason e a -> a)
-> (forall a. Num a => Reason e a -> a)
-> Foldable (Reason e)
forall a. Eq a => a -> Reason e a -> Bool
forall a. Num a => Reason e a -> a
forall a. Ord a => Reason e a -> a
forall m. Monoid m => Reason e m -> m
forall a. Reason e a -> Bool
forall a. Reason e a -> Int
forall a. Reason e a -> [a]
forall a. (a -> a -> a) -> Reason e a -> a
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 b a. (b -> a -> b) -> b -> Reason e a -> b
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
$cfold :: forall e m. Monoid m => Reason e m -> m
fold :: forall m. Monoid m => Reason e m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Reason e a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Reason e a -> b
$cfoldr1 :: forall e a. (a -> a -> a) -> Reason e a -> a
foldr1 :: forall a. (a -> a -> a) -> Reason e a -> a
$cfoldl1 :: forall e a. (a -> a -> a) -> Reason e a -> a
foldl1 :: forall a. (a -> a -> a) -> Reason e a -> a
$ctoList :: forall e a. Reason e a -> [a]
toList :: forall a. Reason e a -> [a]
$cnull :: forall e a. Reason e a -> Bool
null :: forall a. Reason e a -> Bool
$clength :: forall e a. Reason e a -> Int
length :: forall a. Reason e a -> Int
$celem :: forall e a. Eq a => a -> Reason e a -> Bool
elem :: forall a. Eq a => a -> Reason e a -> Bool
$cmaximum :: forall e a. Ord a => Reason e a -> a
maximum :: forall a. Ord a => Reason e a -> a
$cminimum :: forall e a. Ord a => Reason e a -> a
minimum :: forall a. Ord a => Reason e a -> a
$csum :: forall e a. Num a => Reason e a -> a
sum :: forall a. Num a => Reason e a -> a
$cproduct :: forall e a. Num a => Reason e a -> a
product :: forall a. Num a => Reason e a -> a
Foldable, Functor (Reason e)
Foldable (Reason e)
(Functor (Reason e), Foldable (Reason e)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Reason e a -> f (Reason e b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Reason e (f a) -> f (Reason e a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Reason e a -> m (Reason e b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Reason e (m a) -> m (Reason e a))
-> Traversable (Reason e)
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 (m :: * -> *) a. Monad m => Reason e (m a) -> m (Reason e a)
forall (f :: * -> *) a.
Applicative f =>
Reason e (f a) -> f (Reason e a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Reason e a -> m (Reason e b)
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)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Reason e a -> f (Reason e b)
$csequenceA :: forall e (f :: * -> *) a.
Applicative f =>
Reason e (f a) -> f (Reason e a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Reason e (f a) -> f (Reason e a)
$cmapM :: forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Reason e a -> m (Reason e b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Reason e a -> m (Reason e b)
$csequence :: forall e (m :: * -> *) a.
Monad m =>
Reason e (m a) -> m (Reason e a)
sequence :: forall (m :: * -> *) a. Monad m => Reason e (m a) -> m (Reason e a)
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
(ErrF e r -> ErrF e r -> Bool)
-> (ErrF e r -> ErrF e r -> Bool) -> Eq (ErrF e r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e r. (Eq e, Eq r) => 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
/= :: ErrF e r -> ErrF e r -> Bool
Eq, Eq (ErrF e r)
Eq (ErrF e r) =>
(ErrF e r -> ErrF e r -> Ordering)
-> (ErrF e r -> ErrF e r -> Bool)
-> (ErrF e r -> ErrF e r -> Bool)
-> (ErrF e r -> ErrF e r -> Bool)
-> (ErrF e r -> ErrF e r -> Bool)
-> (ErrF e r -> ErrF e r -> ErrF e r)
-> (ErrF e r -> ErrF e r -> ErrF e r)
-> Ord (ErrF e r)
ErrF e r -> ErrF e r -> Bool
ErrF e r -> ErrF e r -> Ordering
ErrF e r -> ErrF e r -> ErrF e r
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
$ccompare :: forall e r. (Ord e, Ord r) => ErrF e r -> ErrF e r -> Ordering
compare :: ErrF e r -> ErrF e r -> Ordering
$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
>= :: ErrF e r -> ErrF e r -> Bool
$cmax :: 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
$cmin :: 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
Ord, Int -> ErrF e r -> ShowS
[ErrF e r] -> ShowS
ErrF e r -> String
(Int -> ErrF e r -> ShowS)
-> (ErrF e r -> String) -> ([ErrF e r] -> ShowS) -> Show (ErrF e r)
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
$cshowsPrec :: forall e r. (Show e, Show r) => Int -> ErrF e r -> ShowS
showsPrec :: Int -> ErrF e r -> ShowS
$cshow :: forall e r. (Show e, Show r) => ErrF e r -> String
show :: ErrF e r -> String
$cshowList :: forall e r. (Show e, Show r) => [ErrF e r] -> ShowS
showList :: [ErrF e r] -> ShowS
Show, (forall a b. (a -> b) -> ErrF e a -> ErrF e b)
-> (forall a b. a -> ErrF e b -> ErrF e a) -> Functor (ErrF e)
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
$cfmap :: forall e a b. (a -> b) -> ErrF e a -> ErrF e b
fmap :: forall a b. (a -> b) -> ErrF e a -> ErrF e b
$c<$ :: forall e a b. a -> ErrF e b -> ErrF e a
<$ :: forall a b. a -> ErrF e b -> ErrF e a
Functor, (forall m. Monoid m => ErrF e m -> m)
-> (forall m a. Monoid m => (a -> m) -> ErrF e a -> m)
-> (forall m a. Monoid m => (a -> m) -> ErrF e a -> m)
-> (forall a b. (a -> b -> b) -> b -> ErrF e a -> b)
-> (forall a b. (a -> b -> b) -> b -> ErrF e a -> b)
-> (forall b a. (b -> a -> b) -> b -> ErrF e a -> b)
-> (forall b a. (b -> a -> b) -> b -> ErrF e a -> b)
-> (forall a. (a -> a -> a) -> ErrF e a -> a)
-> (forall a. (a -> a -> a) -> ErrF e a -> a)
-> (forall a. ErrF e a -> [a])
-> (forall a. ErrF e a -> Bool)
-> (forall a. ErrF e a -> Int)
-> (forall a. Eq a => a -> ErrF e a -> Bool)
-> (forall a. Ord a => ErrF e a -> a)
-> (forall a. Ord a => ErrF e a -> a)
-> (forall a. Num a => ErrF e a -> a)
-> (forall a. Num a => ErrF e a -> a)
-> Foldable (ErrF e)
forall a. Eq a => a -> ErrF e a -> Bool
forall a. Num a => ErrF e a -> a
forall a. Ord a => ErrF e a -> a
forall m. Monoid m => ErrF e m -> m
forall a. ErrF e a -> Bool
forall a. ErrF e a -> Int
forall a. ErrF e a -> [a]
forall a. (a -> a -> a) -> ErrF e a -> a
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 b a. (b -> a -> b) -> b -> ErrF e a -> b
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
$cfold :: forall e m. Monoid m => ErrF e m -> m
fold :: forall m. Monoid m => ErrF e m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> ErrF e a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> ErrF e a -> b
$cfoldr1 :: forall e a. (a -> a -> a) -> ErrF e a -> a
foldr1 :: forall a. (a -> a -> a) -> ErrF e a -> a
$cfoldl1 :: forall e a. (a -> a -> a) -> ErrF e a -> a
foldl1 :: forall a. (a -> a -> a) -> ErrF e a -> a
$ctoList :: forall e a. ErrF e a -> [a]
toList :: forall a. ErrF e a -> [a]
$cnull :: forall e a. ErrF e a -> Bool
null :: forall a. ErrF e a -> Bool
$clength :: forall e a. ErrF e a -> Int
length :: forall a. ErrF e a -> Int
$celem :: forall e a. Eq a => a -> ErrF e a -> Bool
elem :: forall a. Eq a => a -> ErrF e a -> Bool
$cmaximum :: forall e a. Ord a => ErrF e a -> a
maximum :: forall a. Ord a => ErrF e a -> a
$cminimum :: forall e a. Ord a => ErrF e a -> a
minimum :: forall a. Ord a => ErrF e a -> a
$csum :: forall e a. Num a => ErrF e a -> a
sum :: forall a. Num a => ErrF e a -> a
$cproduct :: forall e a. Num a => ErrF e a -> a
product :: forall a. Num a => ErrF e a -> a
Foldable, Functor (ErrF e)
Foldable (ErrF e)
(Functor (ErrF e), Foldable (ErrF e)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ErrF e a -> f (ErrF e b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ErrF e (f a) -> f (ErrF e a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ErrF e a -> m (ErrF e b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ErrF e (m a) -> m (ErrF e a))
-> Traversable (ErrF e)
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 (m :: * -> *) a. Monad m => ErrF e (m a) -> m (ErrF e a)
forall (f :: * -> *) a.
Applicative f =>
ErrF e (f a) -> f (ErrF e a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ErrF e a -> m (ErrF e b)
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)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ErrF e a -> f (ErrF e b)
$csequenceA :: forall e (f :: * -> *) a.
Applicative f =>
ErrF e (f a) -> f (ErrF e a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ErrF e (f a) -> f (ErrF e a)
$cmapM :: forall e (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ErrF e a -> m (ErrF e b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ErrF e a -> m (ErrF e b)
$csequence :: forall e (m :: * -> *) a. Monad m => ErrF e (m a) -> m (ErrF e a)
sequence :: forall (m :: * -> *) a. Monad m => ErrF e (m a) -> m (ErrF e a)
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
(Err e -> Err e -> Bool) -> (Err e -> Err e -> Bool) -> Eq (Err e)
forall e. Eq e => Err e -> Err e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: Err e -> Err e -> Bool
Eq, Eq (Err e)
Eq (Err e) =>
(Err e -> Err e -> Ordering)
-> (Err e -> Err e -> Bool)
-> (Err e -> Err e -> Bool)
-> (Err e -> Err e -> Bool)
-> (Err e -> Err e -> Bool)
-> (Err e -> Err e -> Err e)
-> (Err e -> Err e -> Err e)
-> Ord (Err e)
Err e -> Err e -> Bool
Err e -> Err e -> Ordering
Err e -> Err e -> Err e
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
$ccompare :: forall e. Ord e => Err e -> Err e -> Ordering
compare :: Err e -> Err e -> Ordering
$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
>= :: Err e -> Err e -> Bool
$cmax :: forall e. Ord e => Err e -> Err e -> Err e
max :: Err e -> Err e -> Err e
$cmin :: forall e. Ord e => Err e -> Err e -> Err e
min :: Err e -> Err e -> Err e
Ord, Int -> Err e -> ShowS
[Err e] -> ShowS
Err e -> String
(Int -> Err e -> ShowS)
-> (Err e -> String) -> ([Err e] -> ShowS) -> Show (Err e)
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
$cshowsPrec :: forall e. Show e => Int -> Err e -> ShowS
showsPrec :: Int -> Err e -> ShowS
$cshow :: forall e. Show e => Err e -> String
show :: Err e -> String
$cshowList :: forall e. Show e => [Err e] -> ShowS
showList :: [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)) = ErrF b (Err b) -> Err b
forall e. ErrF e (Err e) -> Err e
Err (Span Int -> Reason b (Err b) -> ErrF b (Err b)
forall e r. Span Int -> Reason e r -> ErrF e r
ErrF Span Int
ra ((a -> b)
-> (Err a -> Err b) -> Reason a (Err a) -> Reason b (Err b)
forall a b c d. (a -> b) -> (c -> d) -> Reason a c -> Reason b d
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 = (Err a -> b -> b) -> b -> Err a -> b
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 = (a -> b -> b) -> (Err a -> b -> b) -> b -> Reason a (Err a) -> b
forall a c b.
(a -> c -> c) -> (b -> c -> c) -> c -> Reason a b -> c
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)) = (Reason b (Err b) -> Err b) -> f (Reason b (Err b)) -> f (Err b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ErrF b (Err b) -> Err b
forall e. ErrF e (Err e) -> Err e
Err (ErrF b (Err b) -> Err b)
-> (Reason b (Err b) -> ErrF b (Err b))
-> Reason b (Err b)
-> Err b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span Int -> Reason b (Err b) -> ErrF b (Err b)
forall e r. Span Int -> Reason e r -> ErrF e r
ErrF Span Int
ra) ((a -> f b)
-> (Err a -> f (Err b)) -> Reason a (Err a) -> f (Reason b (Err b))
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Reason a b -> f (Reason c d)
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 = Err e -> Base (Err e) (Err e)
Err e -> ErrF e (Err e)
forall e. Err e -> ErrF e (Err e)
unErr

instance Corecursive (Err e) where
  embed :: Base (Err e) (Err e) -> Err e
embed = Base (Err e) (Err e) -> Err e
ErrF e (Err e) -> Err e
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 = ErrF e (Err e) -> Span Int
forall e r. ErrF e r -> Span Int
efSpan (ErrF e (Err e) -> Span Int)
-> (Err e -> ErrF e (Err e)) -> Err e -> Span Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> ErrF e (Err e)
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 = ErrF e (Err e) -> Reason e (Err e)
forall e r. ErrF e r -> Reason e r
efReason (ErrF e (Err e) -> Reason e (Err e))
-> (Err e -> ErrF e (Err e)) -> Err e -> Reason e (Err e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> ErrF e (Err e)
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 -> b) -> T e m a -> T e m b)
-> (forall a b. a -> T e m b -> T e m a) -> Functor (T e m)
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
$cfmap :: forall e (m :: * -> *) a b.
Functor m =>
(a -> b) -> T e m a -> T e m b
fmap :: forall a b. (a -> b) -> T e m a -> T e m b
$c<$ :: forall e (m :: * -> *) a b. Functor m => a -> T e m b -> T e m a
<$ :: forall a b. a -> T e m b -> T e m a
Functor, Functor (T e m)
Functor (T e m) =>
(forall a. a -> T e m a)
-> (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 a b. T e m a -> T e m b -> T e m b)
-> (forall a b. T e m a -> T e m b -> T e m a)
-> Applicative (T e m)
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
$cpure :: forall e (m :: * -> *) a. Monad m => a -> T e m a
pure :: forall a. a -> T e m a
$c<*> :: forall e (m :: * -> *) a b.
Monad m =>
T e m (a -> b) -> T e m a -> T e m b
<*> :: forall a b. T e m (a -> b) -> T e m a -> T e m b
$cliftA2 :: forall e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> T e m a -> T e m b -> T e m c
liftA2 :: forall a b c. (a -> b -> c) -> T e m a -> T e m b -> T e m c
$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 -> 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 a
<* :: forall a b. T e m a -> T e m b -> T e m a
Applicative, Applicative (T e m)
Applicative (T e m) =>
(forall a b. T e m a -> (a -> T e m b) -> T e m b)
-> (forall a b. T e m a -> T e m b -> T e m b)
-> (forall a. a -> T e m a)
-> Monad (T e m)
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
$c>>= :: forall e (m :: * -> *) a b.
Monad m =>
T e m a -> (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 -> T e m b -> T e m b
>> :: forall a b. T e m a -> T e m b -> T e m b
$creturn :: forall e (m :: * -> *) a. Monad m => a -> T e m a
return :: forall a. a -> T e m a
Monad, Monad (T e m)
Monad (T e m) => (forall a. IO a -> T e m a) -> MonadIO (T e m)
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
$cliftIO :: forall e (m :: * -> *) a. MonadIO m => IO a -> T e m a
liftIO :: forall a. 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 = ExceptT (Err e) (StateT St m) a -> T e m a
forall e (m :: * -> *) a.
ExceptT (Err e) (StateT St m) a -> T e m a
T (ExceptT (Err e) (StateT St m) a -> T e m a)
-> (m a -> ExceptT (Err e) (StateT St m) a) -> m a -> T e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT St m a -> ExceptT (Err e) (StateT St m) a
forall (m :: * -> *) a. Monad m => m a -> ExceptT (Err e) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT St m a -> ExceptT (Err e) (StateT St m) a)
-> (m a -> StateT St m a) -> m a -> ExceptT (Err e) (StateT St m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT St m a
forall (m :: * -> *) a. Monad m => m a -> StateT St m a
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) = ExceptT (Err e) (StateT St n) b -> T e n b
forall e (m :: * -> *) a.
ExceptT (Err e) (StateT St m) a -> T e m a
T ((forall a. StateT St m a -> StateT St n a)
-> ExceptT (Err e) (StateT St m) b
-> ExceptT (Err e) (StateT St n) b
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a)
-> ExceptT (Err e) m b -> ExceptT (Err e) n b
hoist ((forall a. m a -> n a) -> StateT St m a -> StateT St n a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> StateT St m b -> StateT St n b
hoist m a -> n a
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 = StateT St m (Either (Err e) a) -> St -> m (Either (Err e) a, St)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (StateT St m (Either (Err e) a) -> St -> m (Either (Err e) a, St))
-> (T e m a -> StateT St m (Either (Err e) a))
-> T e m a
-> St
-> m (Either (Err e) a, St)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT (Err e) (StateT St m) a -> StateT St m (Either (Err e) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Err e) (StateT St m) a -> StateT St m (Either (Err e) a))
-> (T e m a -> ExceptT (Err e) (StateT St m) a)
-> T e m a
-> StateT St m (Either (Err e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T e m a -> ExceptT (Err e) (StateT St m) a
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 = (St -> Err e) -> T e m (Err e)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (\St
st -> ErrF e (Err e) -> Err e
forall e. ErrF e (Err e) -> Err e
Err (Span Int -> Reason e (Err e) -> ErrF e (Err e)
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 = T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St
-> (St -> T e m (Either (Err e) r)) -> T e m (Either (Err e) r)
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st -> m (Either (Err e) r, St) -> T e m (Either (Err e) r, St)
forall (m :: * -> *) a. Monad m => m a -> T e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (T e m r -> St -> m (Either (Err e) r, St)
forall e (m :: * -> *) a. T e m a -> St -> m (Either (Err e) a, St)
runT T e m r
t St
st) T e m (Either (Err e) r, St)
-> ((Either (Err e) r, St) -> T e m (Either (Err e) r))
-> T e m (Either (Err e) r)
forall a b. T e m a -> (a -> T e m b) -> T e m b
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 Either (Err e) r -> T e m () -> T e m (Either (Err e) r)
forall a b. a -> T e m b -> T e m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ St -> T e m ()
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 r. (Either (Err e) b -> T e m r) -> T e m r)
-> ParserT e m b
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 -> (Either (Err e) a -> T e m r) -> T e m r
forall r. (Either (Err e) a -> T e m r) -> T e m r
g (Either (Err e) b -> T e m r
j (Either (Err e) b -> T e m r)
-> (Either (Err e) a -> Either (Err e) b)
-> Either (Err e) a
-> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Either (Err e) a -> Either (Err e) b
forall a b. (a -> b) -> Either (Err e) a -> Either (Err e) b
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 (a -> Either (Err e) a
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
(<*>) = 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 = a -> ParserT e m a
forall a. a -> ParserT e m a
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 r. (Either (Err e) b -> T e m r) -> T e m r)
-> ParserT e m b
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 -> (Either (Err e) a -> T e m r) -> T e m r
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 (Err e -> Either (Err e) b
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 (Either (Err e) b -> T e m r) -> T e m r
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 = ParserT e m a
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 = [ParserT e m a] -> ParserT e m a
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 = (Seq a -> [a]) -> ParserT e m (Seq a) -> ParserT e m [a]
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ParserT e m (Seq a) -> ParserT e m [a])
-> (ParserT e m a -> ParserT e m (Seq a))
-> ParserT e m a
-> ParserT e m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT e m a -> ParserT e m (Seq a)
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 = (Seq a -> [a]) -> ParserT e m (Seq a) -> ParserT e m [a]
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (ParserT e m (Seq a) -> ParserT e m [a])
-> (ParserT e m a -> ParserT e m (Seq a))
-> ParserT e m a
-> ParserT e m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT e m a -> ParserT e m (Seq a)
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> m a -> T e m a
forall (m :: * -> *) a. Monad m => m a -> T e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
ma T e m a -> (a -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (a -> Either (Err e) a) -> a -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Err e) a
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> IO a -> T e m a
forall a. IO a -> T e m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
ma T e m a -> (a -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (a -> Either (Err e) a) -> a -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Err e) a
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 = Reason e (Err e) -> ParserT e m a
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Reason e (Err e) -> ParserT e m a)
-> (String -> Reason e (Err e)) -> String -> ParserT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Reason e (Err e)
forall e r. Text -> Reason e r
ReasonFail (Text -> Reason e (Err e))
-> (String -> Text) -> String -> Reason e (Err e)
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 r. (Either (Err e) r -> T e m r) -> T e m r)
-> ParserT e m r
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 -> T e m r
forall r (m :: * -> *). MonadReader r m => m r
ask T e m r -> (r -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) r -> T e m r
j (Either (Err e) r -> T e m r)
-> (r -> Either (Err e) r) -> r -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Either (Err e) r
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
forall e (m :: * -> *) a.
(forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
ParserT ((r -> r) -> T e m r -> T e m r
forall a. (r -> r) -> T e m a -> T e m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (T e m r -> T e m r)
-> ((Either (Err e) a -> T e m r) -> T e m r)
-> (Either (Err e) a -> T e m r)
-> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Err e) a -> T e m r) -> T e m r
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 r. (Either (Err e) s -> T e m r) -> T e m r)
-> ParserT e m 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) s -> T e m r
j -> m s -> T e m s
forall (m :: * -> *) a. Monad m => m a -> T e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get T e m s -> (s -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) s -> T e m r
j (Either (Err e) s -> T e m r)
-> (s -> Either (Err e) s) -> s -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Either (Err e) s
forall a b. b -> Either a b
Right)
  put :: s -> ParserT e m ()
put s
s = (forall r. (Either (Err e) () -> T e m r) -> T e m r)
-> ParserT e m ()
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 -> m () -> T e m ()
forall (m :: * -> *) a. Monad m => m a -> T e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s) T e m () -> (() -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) () -> T e m r
j (Either (Err e) () -> T e m r)
-> (() -> Either (Err e) ()) -> () -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either (Err e) ()
forall a b. b -> Either a b
Right)
  state :: forall a. (s -> (a, s)) -> ParserT e m a
state s -> (a, s)
f = (forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> m a -> T e m a
forall (m :: * -> *) a. Monad m => m a -> T e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f) T e m a -> (a -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (a -> Either (Err e) a) -> a -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Err e) a
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 = (a -> a -> a) -> ParserT e m a -> ParserT e m a -> ParserT e m a
forall a b c.
(a -> b -> c) -> ParserT e m a -> ParserT e m b -> ParserT e m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) 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 = a -> ParserT e m a
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 = (Either (Err e) a -> T e m a) -> T e m a
forall r. (Either (Err e) a -> T e m r) -> T e m r
g ((Err e -> T e m a) -> (a -> T e m a) -> Either (Err e) a -> T e m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err e -> T e m a
forall a. Err e -> T e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> T e m a
forall a. a -> T e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  in  T e m a -> St -> m (Either (Err e) a, St)
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 r. (Either (Err e) St -> T e m r) -> T e m r)
-> ParserT e m 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) St -> T e m r
j -> T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St -> (St -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) St -> T e m r
j (Either (Err e) St -> T e m r)
-> (St -> Either (Err e) St) -> St -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. St -> Either (Err e) St
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> (St -> a) -> T e m a
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> a
f T e m a -> (a -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (a -> Either (Err e) a) -> a -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Err e) a
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 r. (Either (Err e) () -> T e m r) -> T e m r)
-> ParserT e m ()
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 -> St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st T e m () -> (() -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) () -> T e m r
j (Either (Err e) () -> T e m r)
-> (() -> Either (Err e) ()) -> () -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either (Err e) ()
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> (St -> (a, St)) -> T e m a
forall a. (St -> (a, St)) -> T e m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state St -> (a, St)
f T e m a -> (a -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (a -> Either (Err e) a) -> a -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Err e) a
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> Reason e (Err e) -> T e m (Err e)
forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT Reason e (Err e)
re T e m (Err e) -> (Err e -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (Err e -> Either (Err e) a) -> Err e -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Either (Err e) a
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 = (St -> Int) -> ParserT e m Int
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 Int -> Int -> Int
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 = ((Either (Err e) a, St) -> Either (Err e) a)
-> m (Either (Err e) a, St) -> m (Either (Err e) a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Either (Err e) a, St) -> Either (Err e) a
forall a b. (a, b) -> a
fst (ParserT e m a -> St -> m (Either (Err e) a, St)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> St -> m (Either (Err e) a, St)
finishParserT (ParserT e m a
p ParserT e m a -> ParserT e m () -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
endP) (Text -> Span Int -> Seq Label -> St
St Text
h (Text -> Span Int
textSpan Text
h) Seq Label
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 = Identity (Either (Err e) a) -> Either (Err e) a
forall a. Identity a -> a
runIdentity (Parser e a -> Text -> Identity (Either (Err e) a)
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 = Parser e a -> Text -> Either (Err e) a
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 -> String -> Text -> Err e -> IO ()
forall e. HasErrMessage e => String -> Text -> Err e -> IO ()
printE String
"<interactive>" Text
h Err e
e
    Right a
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Either (Err e) a -> IO (Either (Err e) a)
forall a. a -> IO a
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 (or use 'spanAroundP').
spanP :: (Monad m) => ParserT e m (Span Int)
spanP :: forall (m :: * -> *) e. Monad m => ParserT e m (Span Int)
spanP = (St -> Span Int) -> ParserT e m (Span Int)
forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP St -> Span Int
stSpan

-- | Incorporate span information into a parsed object.
spanAroundP :: (Monad m) => (Span Int -> a -> b) -> ParserT e m a -> ParserT e m b
spanAroundP :: forall (m :: * -> *) a b e.
Monad m =>
(Span Int -> a -> b) -> ParserT e m a -> ParserT e m b
spanAroundP Span Int -> a -> b
f ParserT e m a
p = do
  Span Int
start Int
_ <- ParserT e m (Span Int)
forall (m :: * -> *) e. Monad m => ParserT e m (Span Int)
spanP
  a
a <- ParserT e m a
p
  Span Int
end Int
_ <- ParserT e m (Span Int)
forall (m :: * -> *) e. Monad m => ParserT e m (Span Int)
spanP
  b -> ParserT e m b
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Span Int -> a -> b
f (Int -> Int -> Span Int
forall a. a -> a -> Span a
Span Int
start Int
end) a
a)

-- | 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 = Reason e (Err e) -> ParserT e m a
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Reason e (Err e) -> ParserT e m a)
-> (e -> Reason e (Err e)) -> e -> ParserT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Reason e (Err e)
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 <- ParserT e m Int
forall (m :: * -> *) e. Monad m => ParserT e m Int
leftoverP
  if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then () -> ParserT e m ()
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else Reason e (Err e) -> ParserT e m ()
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Int -> Reason e (Err e)
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 r. (Either (Err e) (Maybe a) -> T e m r) -> T e m r)
-> ParserT e m (Maybe a)
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. (Either (Err e) (Maybe a) -> T e m r) -> T e m r)
 -> ParserT e m (Maybe a))
-> (forall r. (Either (Err e) (Maybe a) -> T e m r) -> T e m r)
-> ParserT e m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Either (Err e) (Maybe a) -> T e m r
j -> do
  St
st0 <- T e m St
forall s (m :: * -> *). MonadState s m => m s
get
  (Either (Err e) a -> T e m r) -> T e m r
forall r. (Either (Err e) a -> T e m r) -> T e m r
g ((Either (Err e) a -> T e m r) -> T e m r)
-> (Either (Err e) a -> T e m r) -> T e m r
forall a b. (a -> b) -> a -> b
$ \case
    Left Err e
_ -> St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 T e m () -> T e m r -> T e m r
forall a b. T e m a -> T e m b -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (Err e) (Maybe a) -> T e m r
j (Maybe a -> Either (Err e) (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing)
    Right a
a -> Either (Err e) (Maybe a) -> T e m r
j (Maybe a -> Either (Err e) (Maybe a)
forall a b. b -> Either a b
Right (a -> Maybe a
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
    [] -> Reason e (Err e) -> T e m (Err e)
forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT (if Seq (AltPhase, Err e) -> Bool
forall a. Seq a -> Bool
Seq.null Seq (AltPhase, Err e)
errs then Reason e (Err e)
forall e r. Reason e r
ReasonEmpty else Seq (AltPhase, Err e) -> Reason e (Err e)
forall e r. Seq (AltPhase, r) -> Reason e r
ReasonAlt Seq (AltPhase, Err e)
errs) T e m (Err e) -> (Err e -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (Err e -> Either (Err e) a) -> Err e -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Either (Err e) a
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 -> (Either (Err e) a -> T e m r) -> T e m r
forall r. (Either (Err e) a -> T e m r) -> T e m r
g ((Either (Err e) a -> T e m r) -> T e m r)
-> (Either (Err e) a -> T e m r) -> T e m r
forall a b. (a -> b) -> a -> b
$ \case
      Left Err e
e -> St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 T e m () -> T e m r -> T e m r
forall a b. T e m a -> T e m b -> T e m b
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 Seq (AltPhase, Err e) -> (AltPhase, Err e) -> Seq (AltPhase, Err e)
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 <- T e m r -> T e m (Either (Err e) r)
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 (a -> Either (Err e) a
forall a b. b -> Either a b
Right a
r))
        case Either (Err e) r
es of
          Left Err e
e -> St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 T e m () -> T e m r -> T e m r
forall a b. T e m a -> T e m b -> T e m b
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 Seq (AltPhase, Err e) -> (AltPhase, Err e) -> Seq (AltPhase, Err e)
forall a. Seq a -> a -> Seq a
:|> (AltPhase
AltPhaseCont, Err e
e)) [ParserT e m a]
rest
          Right r
s -> r -> T e m r
forall a. a -> T e m a
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St -> (St -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> (Either (Err e) a -> T e m r)
-> St -> Seq (AltPhase, Err e) -> [ParserT e m a] -> T e m r
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)
forall a. Seq a
Empty (f (ParserT e m a) -> [ParserT e m a]
forall a. f a -> [a]
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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> Reason e (Err e) -> T e m (Err e)
forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT Reason e (Err e)
forall e r. Reason e r
ReasonEmpty T e m (Err e) -> (Err e -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (Err e -> Either (Err e) a) -> Err e -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Either (Err e) a
forall a b. a -> Either a b
Left)

-- | If things fail and you can give a good message explaining why, this combinator will
-- annotate the error with your explanation. Returning 'True' with message will hide
-- the original error message in textual rendering.
explainP :: (Monad m) => (Reason e (Err e) -> Maybe (Text, Bool)) -> ParserT e m a -> ParserT e m a
explainP :: forall (m :: * -> *) e a.
Monad m =>
(Reason e (Err e) -> Maybe (Text, Bool))
-> ParserT e m a -> ParserT e m a
explainP Reason e (Err e) -> Maybe (Text, Bool)
f (ParserT forall r. (Either (Err e) a -> T e m r) -> T e m r
g) = (forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
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. (Either (Err e) a -> T e m r) -> T e m r)
 -> ParserT e m a)
-> (forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
forall a b. (a -> b) -> a -> b
$ \Either (Err e) a -> T e m r
j -> (Either (Err e) a -> T e m r) -> T e m r
forall r. (Either (Err e) a -> T e m r) -> T e m r
g ((Either (Err e) a -> T e m r) -> T e m r)
-> (Either (Err e) a -> T e m r) -> T e m r
forall a b. (a -> b) -> a -> b
$ \Either (Err e) a
ea ->
  case Either (Err e) a
ea of
    Left e :: Err e
e@(Err (ErrF Span Int
_ Reason e (Err e)
re)) ->
      case Reason e (Err e) -> Maybe (Text, Bool)
f Reason e (Err e)
re of
        Maybe (Text, Bool)
Nothing -> Either (Err e) a -> T e m r
j Either (Err e) a
ea
        Just (Text
msg, Bool
hide) -> do
          Span Int
sp <- (St -> Span Int) -> T e m (Span Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets St -> Span Int
stSpan
          let hide' :: HideError
hide' = if Bool
hide then HideError
HideErrorYes else HideError
HideErrorNo
          let e' :: Err e
e' = ErrF e (Err e) -> Err e
forall e. ErrF e (Err e) -> Err e
Err (Span Int -> Reason e (Err e) -> ErrF e (Err e)
forall e r. Span Int -> Reason e r -> ErrF e r
ErrF Span Int
sp (Text -> HideError -> Err e -> Reason e (Err e)
forall e r. Text -> HideError -> r -> Reason e r
ReasonExplained Text
msg HideError
hide' Err e
e))
          Either (Err e) a -> T e m r
j (Err e -> Either (Err e) a
forall a b. a -> Either a b
Left Err e
e')
    Right a
_ -> Either (Err e) a -> T e m r
j Either (Err e) a
ea

-- | 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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
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. (Either (Err e) a -> T e m r) -> T e m r)
 -> ParserT e m a)
-> (forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
forall a b. (a -> b) -> a -> b
$ \Either (Err e) a -> T e m r
j -> do
  St
st0 <- T e m St
forall s (m :: * -> *). MonadState s m => m s
get
  (Either (Err e) a -> T e m r) -> T e m r
forall r. (Either (Err e) a -> T e m r) -> T e m r
g (\Either (Err e) a
ea -> St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st0 T e m () -> T e m r -> T e m r
forall a b. T e m a -> T e m b -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (Err e) a -> T e m r
j ((Err e -> Err e) -> Either (Err e) a -> Either (Err e) a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ErrF e (Err e) -> Err e
forall e. ErrF e (Err e) -> Err e
Err (ErrF e (Err e) -> Err e)
-> (Err e -> ErrF e (Err e)) -> Err e -> Err e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span Int -> Reason e (Err e) -> ErrF e (Err e)
forall e r. Span Int -> Reason e r -> ErrF e r
ErrF (St -> Span Int
stSpan St
st0) (Reason e (Err e) -> ErrF e (Err e))
-> (Err e -> Reason e (Err e)) -> Err e -> ErrF e (Err e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Reason e (Err e)
forall e r. r -> Reason e r
ReasonLook) Either (Err e) a
ea))

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

-- | Branches guarded by lookahead. Use this for more concise errors.
-- 'altP' will happily tell you about each of the errors it encountered in
-- every branch, but this will quietly prune non-matching branches.
-- Tries until first success (in order), so you can tack on a fallthrough case even if
-- you tried a branch earlier.
branchP :: (Monad m, Foldable f) => f (ParserT e m (), ParserT e m a) -> ParserT e m a
branchP :: forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m (), ParserT e m a) -> ParserT e m a
branchP f (ParserT e m (), ParserT e m a)
falts = (forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m 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 -> T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St -> (St -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> (Either (Err e) a -> T e m r)
-> St
-> Seq (AltPhase, Err e)
-> [(ParserT e m (), ParserT e m a)]
-> T e m r
forall (m :: * -> *) e a r.
Monad m =>
(Either (Err e) a -> T e m r)
-> St
-> Seq (AltPhase, Err e)
-> [(ParserT e m (), ParserT e m a)]
-> T e m r
subBranchP Either (Err e) a -> T e m r
j St
st0 Seq (AltPhase, Err e)
forall a. Seq a
Empty (f (ParserT e m (), ParserT e m a)
-> [(ParserT e m (), ParserT e m a)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (ParserT e m (), ParserT e m a)
falts))

-- | An alternative to 'branchP' that does not backtrack after committing to a branch.
commitP :: (Monad m, Foldable f) => f (ParserT e m (), ParserT e m a) -> ParserT e m a
commitP :: forall (m :: * -> *) (f :: * -> *) e a.
(Monad m, Foldable f) =>
f (ParserT e m (), ParserT e m a) -> ParserT e m a
commitP = [(ParserT e m (), ParserT e m a)] -> ParserT e m a
forall {e} {a} {a}.
[(ParserT e m a, ParserT e m a)] -> ParserT e m a
go ([(ParserT e m (), ParserT e m a)] -> ParserT e m a)
-> (f (ParserT e m (), ParserT e m a)
    -> [(ParserT e m (), ParserT e m a)])
-> f (ParserT e m (), ParserT e m a)
-> ParserT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (ParserT e m (), ParserT e m a)
-> [(ParserT e m (), ParserT e m a)]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
 where
  go :: [(ParserT e m a, ParserT e m a)] -> ParserT e m a
go = \case
    [] -> ParserT e m a
forall (m :: * -> *) e a. Monad m => ParserT e m a
emptyP
    (ParserT e m a
p, ParserT e m a
q) : [(ParserT e m a, ParserT e m a)]
rest -> do
      Maybe a
mx <- ParserT e m a -> ParserT e m (Maybe a)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (ParserT e m a -> ParserT e m a
forall (m :: * -> *) e a. Monad m => ParserT e m a -> ParserT e m a
lookP ParserT e m a
p)
      case Maybe a
mx of
        Maybe a
Nothing -> [(ParserT e m a, ParserT e m a)] -> ParserT e m a
go [(ParserT e m a, ParserT e m a)]
rest
        Just a
_ -> ParserT e m a
q

-- | 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 r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
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. (Either (Err e) a -> T e m r) -> T e m r)
 -> ParserT e m a)
-> (forall r. (Either (Err e) a -> T e m r) -> T e m r)
-> ParserT e m a
forall a b. (a -> b) -> a -> b
$ \Either (Err e) a -> T e m r
j ->
  (Either (Err e) a -> T e m r) -> T e m r
forall r. (Either (Err e) a -> T e m r) -> T e m r
g ((Either (Err e) a -> T e m r) -> T e m r)
-> (Either (Err e) a -> T e m r) -> T e m r
forall a b. (a -> b) -> a -> b
$ \case
    Left Err e
e -> Reason e (Err e) -> T e m (Err e)
forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT (Label -> Err e -> Reason e (Err e)
forall e r. Label -> r -> Reason e r
ReasonLabeled Label
lab Err e
e) T e m (Err e) -> (Err e -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) a -> T e m r
j (Either (Err e) a -> T e m r)
-> (Err e -> Either (Err e) a) -> Err e -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Either (Err e) a
forall a b. a -> Either a b
Left
    Right a
a -> Either (Err e) a -> T e m r
j (a -> Either (Err e) a
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 <- Int -> ParserT e m Text
forall (m :: * -> *) e. Monad m => Int -> ParserT e m Text
takeP (Text -> Int
T.length Text
n)
  if Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
o
    then Text -> ParserT e m Text
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
n
    else Reason e (Err e) -> ParserT e m Text
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Text -> Text -> Reason e (Err e)
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_ = ParserT e m Text -> ParserT e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT e m Text -> ParserT e m ())
-> (Text -> ParserT e m Text) -> Text -> ParserT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParserT e m Text
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 = (Text -> Char) -> ParserT e m Text -> ParserT e m Char
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HasCallStack => Text -> Char
Text -> Char
T.head (ParserT e m Text -> ParserT e m Char)
-> (Char -> ParserT e m Text) -> Char -> ParserT e m Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParserT e m Text
forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP (Text -> ParserT e m Text)
-> (Char -> Text) -> Char -> ParserT e m Text
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_ = ParserT e m Char -> ParserT e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT e m Char -> ParserT e m ())
-> (Char -> ParserT e m Char) -> Char -> ParserT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ParserT e m Char
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 = ((a, ()) -> a) -> ParserT e m (a, ()) -> ParserT e m a
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ()) -> a
forall a b. (a, b) -> a
fst (Text -> ParserT e m a -> ParserT e m () -> ParserT e m (a, ())
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 ()
forall a. a -> ParserT e m a
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 = ((a, ()) -> a) -> ParserT e m (a, ()) -> ParserT e m a
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, ()) -> a
forall a b. (a, b) -> a
fst (Text -> ParserT e m a -> ParserT e m () -> ParserT e m (a, ())
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 ()
forall a. a -> ParserT e m a
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 <- Text
-> ParserT e m a
-> ParserT e m ()
-> ParserT e m (Maybe (a, St, ()))
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 ()
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    case Maybe (a, St, ())
mz of
      Maybe (a, St, ())
Nothing -> ParserT e m a -> ParserT e m (Maybe a)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
pa ParserT e m (Maybe a)
-> (Maybe a -> ParserT e m (Seq a)) -> ParserT e m (Seq a)
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT e m (Seq a)
-> (a -> ParserT e m (Seq a)) -> Maybe a -> ParserT e m (Seq a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq a
acc Seq a -> ParserT e m () -> ParserT e m (Seq a)
forall a b. a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ St -> ParserT e m ()
forall (m :: * -> *) e. Monad m => St -> ParserT e m ()
putP St
st) (Seq a -> ParserT e m (Seq a)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a -> ParserT e m (Seq a))
-> (a -> Seq a) -> a -> ParserT e m (Seq a)
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 Seq a -> a -> Seq a
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 = ParserT e m St
forall (m :: * -> *) e. Monad m => ParserT e m St
getP ParserT e m St
-> (St -> ParserT e m (Seq a)) -> ParserT e m (Seq a)
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
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
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 <- Text
-> ParserT e m a
-> ParserT e m ()
-> ParserT e m (Maybe (a, St, ()))
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 ()
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  case Maybe (a, St, ())
mz of
    Maybe (a, St, ())
Nothing -> (a -> Seq a) -> ParserT e m a -> ParserT e m (Seq a)
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Seq a
forall a. a -> Seq a
Seq.singleton ParserT e m a
pa
    Just (a
a, St
st', ()
_) -> Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
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 (a -> Seq a
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 <- Text -> ParserT e m a -> ParserT e m a
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 <- Text
-> ParserT e m a
-> ParserT e m ()
-> ParserT e m (Maybe (a, St, ()))
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 ()
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  case Maybe (a, St, ())
mz of
    Maybe (a, St, ())
Nothing -> (a -> Seq a) -> ParserT e m a -> ParserT e m (Seq a)
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq a
forall a. Seq a
Empty Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
a0 :|>) ParserT e m a
pa
    Just (a
a1, St
st', ()
_) -> Text -> ParserT e m a -> Seq a -> St -> ParserT e m (Seq a)
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
forall a. Seq a
Empty Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
a0 Seq a -> a -> Seq a
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 <- ParserT e m Text -> ParserT e m (Maybe Text)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Text -> ParserT e m Text
forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
tx)
  case Maybe Text
mu of
    Maybe Text
Nothing -> Seq a -> ParserT e m (Seq a)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
forall a. Seq a
Empty
    Just Text
_ -> Text -> ParserT e m a -> ParserT e m (Seq a)
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 = Text -> ParserT e m Text
forall (m :: * -> *) e. Monad m => Text -> ParserT e m Text
textP Text
tx ParserT e m Text -> ParserT e m (Seq a) -> ParserT e m (Seq a)
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ParserT e m a -> ParserT e m (Seq a)
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 <- Text -> ParserT e m a -> ParserT e m (Seq a)
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 -> Seq a -> ParserT e m (Seq a)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
forall a. Seq a
Empty
    Seq a
_ -> Seq a
as Seq a -> ParserT e m Text -> ParserT e m (Seq a)
forall a b. a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ParserT e m Text
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 = Text -> ParserT e m a -> ParserT e m (Seq a)
forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a)
split1P Text
tx ParserT e m a
pa ParserT e m (Seq a) -> ParserT e m Text -> ParserT e m (Seq a)
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ParserT e m Text
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 Seq (Int, InfixPhase, Err e)
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
      St -> T e m ()
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 (Maybe (a, St, b) -> Either (Err e) (Maybe (a, St, b))
forall a b. b -> Either a b
Right Maybe (a, St, b)
forall a. Maybe a
Nothing)
        Seq (Int, InfixPhase, Err e)
_ -> Reason e (Err e) -> T e m (Err e)
forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT (Seq (Int, InfixPhase, Err e) -> Reason e (Err e)
forall e r. Seq (Int, InfixPhase, r) -> Reason e r
ReasonInfix Seq (Int, InfixPhase, Err e)
errs) T e m (Err e) -> (Err e -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
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 (Either (Err e) (Maybe (a, St, b)) -> T e m r)
-> (Err e -> Either (Err e) (Maybe (a, St, b))) -> Err e -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Either (Err e) (Maybe (a, St, b))
forall a b. a -> Either a b
Left
    (St
stA, St
stX, St
stB) : [(St, St, St)]
sts -> do
      let startX :: Int
startX = Span Int -> Int
forall a. Span a -> a
spanStart (St -> Span Int
stSpan St
stX)
      St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
stA
      ParserT e m a -> forall r. (Either (Err e) a -> T e m r) -> T e m r
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 ParserT e m a -> ParserT e m () -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
endP) ((Either (Err e) a -> T e m r) -> T e m r)
-> (Either (Err e) a -> T e m r) -> T e m r
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 Seq (Int, InfixPhase, Err e)
-> (Int, InfixPhase, Err e) -> Seq (Int, InfixPhase, Err e)
forall a. Seq a -> a -> Seq a
:|> (Int
startX, InfixPhase
InfixPhaseLeft, Err e
errA)) [(St, St, St)]
sts
        Right a
a -> do
          St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
stB
          ParserT e m b -> forall r. (Either (Err e) b -> T e m r) -> T e m r
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 ((Either (Err e) b -> T e m r) -> T e m r)
-> (Either (Err e) b -> T e m r) -> T e m r
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 Seq (Int, InfixPhase, Err e)
-> (Int, InfixPhase, Err e) -> Seq (Int, InfixPhase, Err e)
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 <- T e m r -> T e m (Either (Err e) r)
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 (Maybe (a, St, b) -> Either (Err e) (Maybe (a, St, b))
forall a b. b -> Either a b
Right ((a, St, b) -> Maybe (a, St, b)
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 Seq (Int, InfixPhase, Err e)
-> (Int, InfixPhase, Err e) -> Seq (Int, InfixPhase, Err e)
forall a. Seq a -> a -> Seq a
:|> (Int
startX, InfixPhase
InfixPhaseCont, Err e
errC)) [(St, St, St)]
sts
                Right r
c -> r -> T e m r
forall a. a -> T e m a
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 r.
 (Either (Err e) (Maybe (a, St, b)) -> T e m r) -> T e m r)
-> ParserT e m (Maybe (a, St, b))
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 -> T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St -> (St -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> 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
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)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
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 (Maybe (a, St, b) -> Either (Err e) (Maybe (a, St, b))
forall a b. b -> Either a b
Right Maybe (a, St, b)
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 -> Reason e (Err e) -> T e m (Err e)
forall (m :: * -> *) e.
Monad m =>
Reason e (Err e) -> T e m (Err e)
mkErrT Reason e (Err e)
forall e r. Reason e r
ReasonEmpty T e m (Err e) -> (Err e -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either (Err e) (a, b) -> T e m r
j (Either (Err e) (a, b) -> T e m r)
-> (Err e -> Either (Err e) (a, b)) -> Err e -> T e m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err e -> Either (Err e) (a, b)
forall a b. a -> Either a b
Left
      Just (a
a, St
_, b
b) -> Either (Err e) (a, b) -> T e m r
j ((a, b) -> Either (Err e) (a, b)
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 (Err e -> Either (Err e) (a, b)
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 r. (Either (Err e) (a, b) -> T e m r) -> T e m r)
-> ParserT e m (a, b)
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 -> T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St -> (St -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> 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
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) (a, b) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
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) (Maybe (St, St, St) -> [(St, St, St)]
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 r. (Either (Err e) (a, b) -> T e m r) -> T e m r)
-> ParserT e m (a, b)
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 -> T e m St
forall s (m :: * -> *). MonadState s m => m s
get T e m St -> (St -> T e m r) -> T e m r
forall a b. T e m a -> (a -> T e m b) -> T e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> 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
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) (a, b) -> T e m r)
-> Either (Err e) (Maybe (a, St, b)) -> T e m r
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 = (St -> (Text, St)) -> ParserT e m Text
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Text, St)) -> ParserT e m Text)
-> (St -> (Text, St)) -> ParserT e m Text
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 = spanStart r + l}
      st' :: St
st' = St
st {stHay = h', stSpan = 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 <- (St -> (Either Int Text, St)) -> ParserT e m (Either Int Text)
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Either Int Text, St)) -> ParserT e m (Either Int Text))
-> (St -> (Either Int Text, St)) -> ParserT e m (Either Int Text)
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 = spanStart r + T.length o}
        st' :: St
st' = St
st {stHay = h', stSpan = r'}
    in  if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then (Text -> Either Int Text
forall a b. b -> Either a b
Right Text
o, St
st') else (Int -> Either Int Text
forall a b. a -> Either a b
Left Int
l, St
st)
  case Either Int Text
et of
    Left Int
l -> Reason e (Err e) -> ParserT e m Text
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Int -> Int -> Reason e (Err e)
forall e r. Int -> Int -> Reason e r
ReasonDemand Int
i Int
l)
    Right Text
a -> Text -> ParserT e m Text
forall a. a -> ParserT e m 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 = (Text -> Int) -> ParserT e m Text -> ParserT e m Int
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length (ParserT e m Text -> ParserT e m Int)
-> (Int -> ParserT e m Text) -> Int -> ParserT e m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ParserT e m Text
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 = ParserT e m Text -> ParserT e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParserT e m Text -> ParserT e m ())
-> (Int -> ParserT e m Text) -> Int -> ParserT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ParserT e m Text
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 = (St -> (Text, St)) -> ParserT e m Text
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Text, St)) -> ParserT e m Text)
-> (St -> (Text, St)) -> ParserT e m Text
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 = spanStart r + l}
      st' :: St
st' = St
st {stHay = h', stSpan = 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 <- (St -> (Maybe Text, St)) -> ParserT e m (Maybe Text)
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Maybe Text, St)) -> ParserT e m (Maybe Text))
-> (St -> (Maybe Text, St)) -> ParserT e m (Maybe Text)
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 = spanStart r + l}
        st' :: St
st' = St
st {stHay = h', stSpan = r'}
    in  if Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (Maybe Text
forall a. Maybe a
Nothing, St
st) else (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
o, St
st')
  case Maybe Text
mt of
    Maybe Text
Nothing -> Reason e (Err e) -> ParserT e m Text
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP Reason e (Err e)
forall e r. Reason e r
ReasonTakeNone
    Just Text
a -> Text -> ParserT e m Text
forall a. a -> ParserT e m 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 = (Text -> Int) -> ParserT e m Text -> ParserT e m Int
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length (ParserT e m Text -> ParserT e m Int)
-> ((Char -> Bool) -> ParserT e m Text)
-> (Char -> Bool)
-> ParserT e m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParserT e m Text
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 = (Text -> Int) -> ParserT e m Text -> ParserT e m Int
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length (ParserT e m Text -> ParserT e m Int)
-> ((Char -> Bool) -> ParserT e m Text)
-> (Char -> Bool)
-> ParserT e m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ParserT e m Text
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 = (St -> (Text, St)) -> ParserT e m Text
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Text, St)) -> ParserT e m Text)
-> (St -> (Text, St)) -> ParserT e m Text
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 = spanEnd r}
      st' :: St
st' = St
st {stHay = T.empty, stSpan = 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 <- (St -> (Maybe Text, St)) -> ParserT e m (Maybe Text)
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Maybe Text, St)) -> ParserT e m (Maybe Text))
-> (St -> (Maybe Text, St)) -> ParserT e m (Maybe Text)
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 = spanEnd r}
        st' :: St
st' = St
st {stHay = T.empty, stSpan = r'}
    in  if Text -> Bool
T.null Text
h then (Maybe Text
forall a. Maybe a
Nothing, St
st) else (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
h, St
st')
  case Maybe Text
mt of
    Maybe Text
Nothing -> Reason e (Err e) -> ParserT e m Text
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Int -> Int -> Reason e (Err e)
forall e r. Int -> Int -> Reason e r
ReasonDemand Int
1 Int
0)
    Just Text
a -> Text -> ParserT e m Text
forall a. a -> ParserT e m 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 = (Text -> Int) -> ParserT e m Text -> ParserT e m Int
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length ParserT e m Text
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 = (Text -> Int) -> ParserT e m Text -> ParserT e m Int
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
T.length ParserT e m Text
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 r. (Either (Err e) b -> T e m r) -> T e m r)
-> ParserT e m b
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. (Either (Err e) b -> T e m r) -> T e m r)
 -> ParserT e m b)
-> (forall r. (Either (Err e) b -> T e m r) -> T e m r)
-> ParserT e m b
forall a b. (a -> b) -> a -> b
$ \Either (Err e) b -> T e m r
j -> do
  St
st0 <- T e m St
forall s (m :: * -> *). MonadState s m => m s
get
  (Either (Err e) r
ea, St
st1) <- m (Either (Err e) r, St) -> T e m (Either (Err e) r, St)
forall (m :: * -> *) a. Monad m => m a -> T e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t m (Either (Err e) r, St) -> m (Either (Err e) r, St)
forall a. t m a -> m a
f (T e (t m) r -> St -> t m (Either (Err e) r, St)
forall e (m :: * -> *) a. T e m a -> St -> m (Either (Err e) a, St)
runT ((Either (Err e) b -> T e (t m) r) -> T e (t m) r
forall r. (Either (Err e) b -> T e (t m) r) -> T e (t m) r
g ((forall a. m a -> t m a) -> T e m r -> T e (t m) r
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> T e m b -> T e n b
hoist m a -> t m a
forall a. m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (T e m r -> T e (t m) r)
-> (Either (Err e) b -> T e m r) -> Either (Err e) b -> T e (t m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Err e) b -> T e m r
j)) St
st0))
  St -> T e m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st1
  (Err e -> T e m r) -> (r -> T e m r) -> Either (Err e) r -> T e m r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Err e -> T e m r
forall a. Err e -> T e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError r -> T e m r
forall a. a -> T e m a
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 a. StateT s m a -> m a)
-> ParserT e (StateT s m) a -> ParserT e m a
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 (StateT s m a -> s -> m a
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 ParserT e m (Maybe a)
-> (Maybe a -> ParserT e m a) -> ParserT e m a
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT e m a -> (a -> ParserT e m a) -> Maybe a -> ParserT e m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ParserT e m a
go a -> ParserT e m a
forall a. a -> ParserT e m a
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
  Text -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Text -> ParserT e m ()
textP_ (Char -> Text
T.singleton Char
d)
  StrState -> ParserT e (StateT StrState m) Text -> ParserT e m Text
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 Seq Char
forall a. Seq a
Empty) (ParserT e (StateT StrState m) Text -> ParserT e m Text)
-> ParserT e (StateT StrState m) Text -> ParserT e m Text
forall a b. (a -> b) -> a -> b
$ ParserT e (StateT StrState m) (Maybe Text)
-> ParserT e (StateT StrState m) Text
forall e (m :: * -> *) a. ParserT e m (Maybe a) -> ParserT e m a
iterP (ParserT e (StateT StrState m) (Maybe Text)
 -> ParserT e (StateT StrState m) Text)
-> ParserT e (StateT StrState m) (Maybe Text)
-> ParserT e (StateT StrState m) Text
forall a b. (a -> b) -> a -> b
$ do
    Char
c <- ParserT e (StateT StrState m) Char
forall (m :: * -> *) e. Monad m => ParserT e m Char
headP
    (StrState -> (Maybe Text, StrState))
-> ParserT e (StateT StrState m) (Maybe Text)
forall a.
(StrState -> (a, StrState)) -> ParserT e (StateT StrState m) a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((StrState -> (Maybe Text, StrState))
 -> ParserT e (StateT StrState m) (Maybe Text))
-> (StrState -> (Maybe Text, StrState))
-> ParserT e (StateT StrState m) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \ss :: StrState
ss@(StrState Bool
esc Seq Char
buf) ->
      if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
d
        then
          if Bool
esc
            then (Maybe Text
forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
False (Seq Char
buf Seq Char -> Char -> Seq Char
forall a. Seq a -> a -> Seq a
:|> Char
c))
            else (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack (Seq Char -> String
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Char
buf)), StrState
ss)
        else
          if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
            then
              if Bool
esc
                then (Maybe Text
forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
False (Seq Char
buf Seq Char -> Char -> Seq Char
forall a. Seq a -> a -> Seq a
:|> Char
c))
                else (Maybe Text
forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
True Seq Char
buf)
            else (Maybe Text
forall a. Maybe a
Nothing, Bool -> Seq Char -> StrState
StrState Bool
False (Seq Char
buf Seq Char -> Char -> Seq Char
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 = Char -> ParserT e m Text
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 = Char -> ParserT e m Text
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 ParserT e m x -> ParserT e m a -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
pa ParserT e m a -> ParserT e m y -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
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 <- ParserT e m a -> ParserT e m (Maybe a)
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 -> Seq a -> ParserT e m (Seq a)
forall a. a -> ParserT e m a
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 Seq a -> a -> Seq a
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 = ParserT e m a -> Seq a -> ParserT e m (Seq a)
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
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 ParserT e m a -> (a -> ParserT e m (Seq a)) -> ParserT e m (Seq a)
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT e m a -> Seq a -> ParserT e m (Seq a)
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))
-> (a -> Seq a) -> a -> ParserT e m (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Seq a
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 <- ParserT e m a -> ParserT e m (Maybe a)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (ParserT e m ()
pu ParserT e m () -> ParserT e m a -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
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 -> Seq a -> ParserT e m (Seq a)
forall a. a -> ParserT e m a
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 Seq a -> a -> Seq a
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 = ParserT e m a -> ParserT e m (Maybe a)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
pa ParserT e m (Maybe a)
-> (Maybe a -> ParserT e m (Seq a)) -> ParserT e m (Seq a)
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT e m (Seq a)
-> (a -> ParserT e m (Seq a)) -> Maybe a -> ParserT e m (Seq a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Seq a -> ParserT e m (Seq a)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
forall a. Seq a
Empty) (ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
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))
-> (a -> Seq a) -> a -> ParserT e m (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Seq a
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 ParserT e m a -> (a -> ParserT e m (Seq a)) -> ParserT e m (Seq a)
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
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))
-> (a -> Seq a) -> a -> ParserT e m (Seq a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Seq a
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
  ParserT e m () -> ParserT e m a -> Seq a -> ParserT e m (Seq a)
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
forall a. Seq a
Empty Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
:|> a
a0 Seq a -> a -> Seq a
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 = ParserT e m Int -> ParserT e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Char -> Bool) -> ParserT e m Int
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 = ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP ParserT e m () -> ParserT e m a -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
p ParserT e m a -> ParserT e m () -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m ()
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 = ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
spaceP ParserT e m () -> ParserT e m a -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
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 ParserT e m a -> ParserT e m () -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m ()
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 <- (St -> Int) -> ParserT e m Int
forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP (Span Int -> Int
forall a. Span a -> a
spanStart (Span Int -> Int) -> (St -> Span Int) -> St -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. St -> Span Int
stSpan)
  a
a <- ParserT e m a
p
  Int
end <- (St -> Int) -> ParserT e m Int
forall (m :: * -> *) a e. Monad m => (St -> a) -> ParserT e m a
getsP (Span Int -> Int
forall a. Span a -> a
spanStart (Span Int -> Int) -> (St -> Span Int) -> St -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. St -> Span Int
stSpan)
  (a, Int) -> ParserT e m (a, Int)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
a, Int
end Int -> Int -> Int
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 = (St -> (Maybe Char, St)) -> ParserT e m (Maybe Char)
forall (m :: * -> *) a e.
Monad m =>
(St -> (a, St)) -> ParserT e m a
stateP ((St -> (Maybe Char, St)) -> ParserT e m (Maybe Char))
-> (St -> (Maybe Char, St)) -> ParserT e m (Maybe Char)
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 -> (Maybe Char
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 = spanStart r + 1}
              st' :: St
st' = St
st {stHay = y, stSpan = r'}
          in  (Char -> Maybe Char
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 = ParserT e m (Maybe Char)
forall (m :: * -> *) e. Monad m => ParserT e m (Maybe Char)
unconsP ParserT e m (Maybe Char)
-> (Maybe Char -> ParserT e m Char) -> ParserT e m Char
forall a b. ParserT e m a -> (a -> ParserT e m b) -> ParserT e m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParserT e m Char
-> (Char -> ParserT e m Char) -> Maybe Char -> ParserT e m Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Reason e (Err e) -> ParserT e m Char
forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (Int -> Int -> Reason e (Err e)
forall e r. Int -> Int -> Reason e r
ReasonDemand Int
1 Int
0)) Char -> ParserT e m Char
forall a. a -> ParserT e m a
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 <- ParserT e m Char -> ParserT e m (Maybe Char)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Char -> ParserT e m Char
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
_ -> (a -> a) -> ParserT e m a -> ParserT e m a
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
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 = (a -> a) -> ParserT e m a -> ParserT e m a
forall (m :: * -> *) a e.
Monad m =>
(a -> a) -> ParserT e m a -> ParserT e m a
signedWithP a -> a
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 = ParserT e m Integer -> ParserT e m Integer
forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP ParserT e m Integer
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 = (Integer -> Char -> Integer) -> Integer -> Text -> Integer
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (\Integer
n Char
d -> Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
d)) Integer
0 (Text -> Integer) -> ParserT e m Text -> ParserT e m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParserT e m Text
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 = ParserT e m Rational -> ParserT e m Rational
forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP ParserT e m Rational
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 <- (Integer -> Rational)
-> ParserT e m Integer -> ParserT e m Rational
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Rational
forall a. Num a => Integer -> a
fromInteger ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
  Bool
hasDot <- (Maybe Char -> Bool)
-> ParserT e m (Maybe Char) -> ParserT e m Bool
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (ParserT e m Char -> ParserT e m (Maybe Char)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Char -> ParserT e m Char
forall (m :: * -> *) e. Monad m => Char -> ParserT e m Char
charP Char
'.'))
  if Bool
hasDot
    then do
      (Integer
numerator, Int
places) <- ParserT e m Integer -> ParserT e m (Integer, Int)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
      let denominator :: Integer
denominator = Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
places
          part :: Rational
part = Integer
numerator Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
denominator
      Rational -> ParserT e m Rational
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational
whole Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
part)
    else Rational -> ParserT e m Rational
forall a. a -> ParserT e m a
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 = ParserT e m Scientific -> ParserT e m Scientific
forall (m :: * -> *) a e.
(Monad m, Num a) =>
ParserT e m a -> ParserT e m a
signedP ParserT e m Scientific
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 <- ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
  Bool
hasDot <- (Maybe () -> Bool) -> ParserT e m (Maybe ()) -> ParserT e m Bool
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (ParserT e m () -> ParserT e m (Maybe ())
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Char -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'.'))
  (Integer
frac, Int
places) <- if Bool
hasDot then ParserT e m Integer -> ParserT e m (Integer, Int)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP else (Integer, Int) -> ParserT e m (Integer, Int)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
0, Int
0)
  Bool
hasEx <- (Maybe () -> Bool) -> ParserT e m (Maybe ()) -> ParserT e m Bool
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (ParserT e m () -> ParserT e m (Maybe ())
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Char -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'e' ParserT e m () -> ParserT e m () -> ParserT e m ()
forall a. ParserT e m a -> ParserT e m a -> ParserT e m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'E'))
  Int
ex <- if Bool
hasEx then (Integer -> Int) -> ParserT e m Integer -> ParserT e m Int
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP else Int -> ParserT e m Int
forall a. a -> ParserT e m a
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
places)
  Scientific -> ParserT e m Scientific
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific
wholeS Scientific -> Scientific -> Scientific
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 = (Either Integer Scientific -> Either Integer Scientific)
-> ParserT e m (Either Integer Scientific)
-> ParserT e m (Either Integer Scientific)
forall (m :: * -> *) a e.
Monad m =>
(a -> a) -> ParserT e m a -> ParserT e m a
signedWithP ((Integer -> Integer)
-> (Scientific -> Scientific)
-> Either Integer Scientific
-> Either Integer Scientific
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Integer -> Integer
forall a. Num a => a -> a
negate Scientific -> Scientific
forall a. Num a => a -> a
negate) ParserT e m (Either Integer Scientific)
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 <- ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP
  Bool
hasDot <- (Maybe () -> Bool) -> ParserT e m (Maybe ()) -> ParserT e m Bool
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (ParserT e m () -> ParserT e m (Maybe ())
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Char -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'.'))
  Maybe (Integer, Int)
mayFracPlaces <- if Bool
hasDot then ((Integer, Int) -> Maybe (Integer, Int))
-> ParserT e m (Integer, Int) -> ParserT e m (Maybe (Integer, Int))
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Int) -> Maybe (Integer, Int)
forall a. a -> Maybe a
Just (ParserT e m Integer -> ParserT e m (Integer, Int)
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (a, Int)
measureP ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
uintP) else Maybe (Integer, Int) -> ParserT e m (Maybe (Integer, Int))
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Integer, Int)
forall a. Maybe a
Nothing
  Bool
hasEx <- (Maybe () -> Bool) -> ParserT e m (Maybe ()) -> ParserT e m Bool
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (ParserT e m () -> ParserT e m (Maybe ())
forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (Char -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'e' ParserT e m () -> ParserT e m () -> ParserT e m ()
forall a. ParserT e m a -> ParserT e m a -> ParserT e m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParserT e m ()
forall (m :: * -> *) e. Monad m => Char -> ParserT e m ()
charP_ Char
'E'))
  Maybe Int
mayEx <- if Bool
hasEx then (Integer -> Maybe Int)
-> ParserT e m Integer -> ParserT e m (Maybe Int)
forall a b. (a -> b) -> ParserT e m a -> ParserT e m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Integer -> Int) -> Integer -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ParserT e m Integer
forall (m :: * -> *) e. Monad m => ParserT e m Integer
intP else Maybe Int -> ParserT e m (Maybe Int)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing
  case (Maybe (Integer, Int)
mayFracPlaces, Maybe Int
mayEx) of
    (Maybe (Integer, Int)
Nothing, Maybe Int
Nothing) -> Either Integer Scientific
-> ParserT e m (Either Integer Scientific)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Either Integer Scientific
forall a b. a -> Either a b
Left Integer
whole)
    (Maybe (Integer, Int), Maybe Int)
_ -> do
      let (Integer
frac, Int
places) = (Integer, Int) -> Maybe (Integer, Int) -> (Integer, Int)
forall a. a -> Maybe a -> a
fromMaybe (Integer
0, Int
0) Maybe (Integer, Int)
mayFracPlaces
          ex :: Int
ex = Int -> Maybe Int -> Int
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
places)
      Either Integer Scientific
-> ParserT e m (Either Integer Scientific)
forall a. a -> ParserT e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Either Integer Scientific
forall a b. b -> Either a b
Right (Scientific
wholeS Scientific -> Scientific -> Scientific
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 = ParserT e m Int -> ParserT e m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Char -> Bool) -> ParserT e m Int
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 = ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P ParserT e m () -> ParserT e m a -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParserT e m a
p ParserT e m a -> ParserT e m () -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m ()
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 = ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P ParserT e m () -> ParserT e m a -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m b
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 ParserT e m a -> ParserT e m () -> ParserT e m a
forall a b. ParserT e m a -> ParserT e m b -> ParserT e m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m ()
forall (m :: * -> *) e. Monad m => ParserT e m ()
space1P

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

instance HasErrMessage Void where
  getErrMessage :: (Int -> Text) -> Void -> [Text]
getErrMessage = (Void -> [Text]) -> (Int -> Text) -> Void -> [Text]
forall a b. a -> b -> a
const Void -> [Text]
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i) Text
" " in (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
s <>)

instance (HasErrMessage e) => HasErrMessage (Err e) where
  getErrMessage :: (Int -> Text) -> Err e -> [Text]
getErrMessage Int -> Text
repPos = Err e -> [Text]
go
   where
    go :: Err e -> [Text]
go (Err (ErrF (Span Int
start Int
end) Reason e (Err e)
re)) =
      let pos :: Text
pos = Text
"Error in range " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
repPos Int
start Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
repPos Int
end Text -> Text -> Text
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 ((Int -> Text) -> e -> [Text]
forall e. HasErrMessage e => (Int -> Text) -> e -> [Text]
getErrMessage Int -> Text
repPos e
e)
              in  Text
hd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
tl
            ReasonExpect Text
expected Text
actual ->
              [Text
"Expected text: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' but found: '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"]
            ReasonDemand Int
expected Int
actual ->
              [Text
"Expected count: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
expected) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
actual)]
            ReasonLeftover Int
count ->
              [Text
"Expected end but had leftover count: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
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 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ do
                    (AltPhase
_, Err e
e) <- Seq (AltPhase, Err e) -> [(AltPhase, Err e)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (AltPhase, Err e)
errs
                    Text
"Tried:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
indent Int
1 (Err e -> [Text]
go Err e
e)
              in  Text
hd Text -> [Text] -> [Text]
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 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ do
                    (Int
i, InfixPhase
_, Err e
e) <- Seq (Int, InfixPhase, Err e) -> [(Int, InfixPhase, Err e)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq (Int, InfixPhase, Err e)
errs
                    let x :: Text
x = Text
"Tried position: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)
                    Text
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Int -> [Text] -> [Text]
indent Int
1 (Err e -> [Text]
go Err e
e)
              in  Text
hd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
tl
            ReasonFail Text
msg -> [Text
"User reported failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg]
            ReasonLabeled Label
lab Err e
e ->
              let hd :: Text
hd = Text
"Label: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
unLabel Label
lab
                  tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 (Err e -> [Text]
go Err e
e)
              in  Text
hd Text -> [Text] -> [Text]
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 (Err e -> [Text]
go Err e
e)
              in  Text
hd Text -> [Text] -> [Text]
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"]
            ReasonExplained Text
msg HideError
hide Err e
e ->
              case HideError
hide of
                HideError
HideErrorNo ->
                  let tl :: [Text]
tl = Int -> [Text] -> [Text]
indent Int
1 (Err e -> [Text]
go Err e
e)
                  in  Text
msg Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
tl
                HideError
HideErrorYes -> [Text
msg]
      in  Text
pos Text -> [Text] -> [Text]
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 (Span Int -> Int
forall a. Span a -> a
spanStart (Err e -> Span Int
forall e. Err e -> Span Int
errSpan Err e
e))
      repP :: Int -> Text
repP Int
i = let (Int
l, Int
c) = Int -> (Int, Int)
mkP Int
i in Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
l) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      msg :: [Text]
msg = (Int -> Text) -> Err e -> [Text]
forall e. HasErrMessage e => (Int -> Text) -> e -> [Text]
getErrMessage Int -> Text
repP 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 Maybe Text
forall a. Maybe a
Nothing (Int
line, Int
col, Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Maybe Text
forall a. Maybe a
Nothing) (Text -> Maybe Text
forall a. a -> Maybe a
Just ([Text] -> Text
T.unlines [Text]
msg))
  in  [Maybe Text -> [Block] -> Maybe Text -> Errata
E.Errata Maybe Text
forall a. Maybe a
Nothing [Block
block] Maybe Text
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
  in  Text -> Text
TL.toStrict (Text -> [Errata] -> Text
forall source. Source source => source -> [Errata] -> Text
E.prettyErrors Text
h (String -> (Int -> (Int, Int)) -> Err e -> [Errata]
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 (String -> Text -> Err e -> Text
forall e. HasErrMessage e => String -> Text -> Err e -> Text
renderE String
fp Text
h Err e
e)