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

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

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

-- private
type OffsetVec = Vector (Int, Int)

-- private
mkOffsetVec :: Text -> OffsetVec
mkOffsetVec :: Text -> OffsetVec
mkOffsetVec Text
t = forall b a. Int -> (b -> Maybe (a, b)) -> b -> Vector a
V.unfoldrN (Text -> Int
T.length Text
t) forall {a} {b}.
(Num a, Num b) =>
((a, b), [Char]) -> Maybe ((a, b), ((a, b), [Char]))
go ((Int
0, Int
0), Text -> [Char]
T.unpack Text
t)
 where
  go :: ((a, b), [Char]) -> Maybe ((a, b), ((a, b), [Char]))
go (p :: (a, b)
p@(!a
line, !b
col), [Char]
xs) =
    case [Char]
xs of
      [] -> forall a. Maybe a
Nothing
      Char
x : [Char]
xs' -> forall a. a -> Maybe a
Just ((a, b)
p, if Char
x forall a. Eq a => a -> a -> Bool
== Char
'\n' then ((a
line forall a. Num a => a -> a -> a
+ a
1, b
0), [Char]
xs') else ((a
line, b
col forall a. Num a => a -> a -> a
+ b
1), [Char]
xs'))

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

-- | Range in text character offset
data Range = Range {Range -> Int
rangeStart :: !Int, Range -> Int
rangeEnd :: !Int}
  deriving stock (Range -> Range -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c== :: Range -> Range -> Bool
Eq, Eq Range
Range -> Range -> Bool
Range -> Range -> Ordering
Range -> Range -> Range
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Range -> Range -> Range
$cmin :: Range -> Range -> Range
max :: Range -> Range -> Range
$cmax :: Range -> Range -> Range
>= :: Range -> Range -> Bool
$c>= :: Range -> Range -> Bool
> :: Range -> Range -> Bool
$c> :: Range -> Range -> Bool
<= :: Range -> Range -> Bool
$c<= :: Range -> Range -> Bool
< :: Range -> Range -> Bool
$c< :: Range -> Range -> Bool
compare :: Range -> Range -> Ordering
$ccompare :: Range -> Range -> Ordering
Ord, Int -> Range -> ShowS
[Range] -> ShowS
Range -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Range] -> ShowS
$cshowList :: [Range] -> ShowS
show :: Range -> [Char]
$cshow :: Range -> [Char]
showsPrec :: Int -> Range -> ShowS
$cshowsPrec :: Int -> Range -> ShowS
Show)

-- | Create a range from the given text
range :: Text -> Range
range :: Text -> Range
range Text
t = Int -> Int -> Range
Range Int
0 (Text -> Int
T.length Text
t)

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

-- private
-- Returns list of possible break points with positions
-- (startStream, breakPt) breakPt (breakPt + needLen, endStream)
breakAllRP :: Text -> St -> [(St, Int, St)]
breakAllRP :: Text -> St -> [(St, Int, St)]
breakAllRP Text
needle (St Text
hay (Range Int
r0 Int
r1) Seq Label
labs) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> (St, Int, St)
go (Text -> Text -> [(Text, Text)]
T.breakOnAll Text
needle Text
hay)
 where
  go :: (Text, Text) -> (St, Int, St)
go (Text
hay1, Text
hay2) =
    let end1 :: Int
end1 = Int
r0 forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
hay1
        needLen :: Int
needLen = Text -> Int
T.length Text
needle
        rng1 :: Range
rng1 = Int -> Int -> Range
Range Int
r0 Int
end1
        rng2 :: Range
rng2 = Int -> Int -> Range
Range (Int
end1 forall a. Num a => a -> a -> a
+ Int
needLen) Int
r1
        st1 :: St
st1 = Text -> Range -> Seq Label -> St
St Text
hay1 Range
rng1 Seq Label
labs
        st2 :: St
st2 = Text -> Range -> Seq Label -> St
St (Int -> Text -> Text
T.drop Int
needLen Text
hay2) Range
rng2 Seq Label
labs
    in  (St
st1, Int
end1, St
st2)

-- private
breakRP :: Text -> St -> Maybe (St, Int, St)
breakRP :: Text -> St -> Maybe (St, Int, St)
breakRP Text
needle (St Text
hay (Range Int
r0 Int
r1) Seq Label
labs) =
  let (Text
hay1, Text
hay2) = Text -> Text -> (Text, Text)
T.breakOn Text
needle Text
hay
  in  if Text -> Bool
T.null Text
hay2
        then forall a. Maybe a
Nothing
        else
          let end1 :: Int
end1 = Int
r0 forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
hay1
              needLen :: Int
needLen = Text -> Int
T.length Text
needle
              rng1 :: Range
rng1 = Int -> Int -> Range
Range Int
r0 Int
end1
              rng2 :: Range
rng2 = Int -> Int -> Range
Range (Int
end1 forall a. Num a => a -> a -> a
+ Int
needLen) Int
r1
              st1 :: St
st1 = Text -> Range -> Seq Label -> St
St Text
hay1 Range
rng1 Seq Label
labs
              st2 :: St
st2 = Text -> Range -> Seq Label -> St
St (Int -> Text -> Text
T.drop Int
needLen Text
hay2) Range
rng2 Seq Label
labs
          in  forall a. a -> Maybe a
Just (St
st1, Int
end1, St
st2)

-- private
splitRP :: Text -> St -> [(St, Int)]
splitRP :: Text -> St -> [(St, Int)]
splitRP Text
needle (St Text
hay (Range Int
r0 Int
_) Seq Label
labs) = [Text] -> [(St, Int)]
goHead (Text -> Text -> [Text]
T.splitOn Text
needle Text
hay)
 where
  needLen :: Int
needLen = Text -> Int
T.length Text
needle
  mkSt :: Int -> Int -> Text -> St
mkSt Int
start Int
end Text
hayN = Text -> Range -> Seq Label -> St
St Text
hayN (Int -> Int -> Range
Range Int
start Int
end) Seq Label
labs
  goHead :: [Text] -> [(St, Int)]
goHead = \case
    [] -> []
    Text
hay0 : [Text]
hays ->
      let end0 :: Int
end0 = Int
r0 forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
hay0
      in  (Int -> Int -> Text -> St
mkSt Int
r0 Int
end0 Text
hay0, Int
0) forall a. a -> [a] -> [a]
: Int -> [Text] -> [(St, Int)]
goTail Int
end0 [Text]
hays
  goTail :: Int -> [Text] -> [(St, Int)]
goTail !Int
endN1 = \case
    [] -> []
    Text
hayN : [Text]
hays ->
      let startN :: Int
startN = Int
endN1 forall a. Num a => a -> a -> a
+ Int
needLen
          endN :: Int
endN = Int
startN forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
hayN
      in  (Int -> Int -> Text -> St
mkSt Int
startN Int
endN Text
hayN, Int
endN1) forall a. a -> [a] -> [a]
: Int -> [Text] -> [(St, Int)]
goTail Int
endN [Text]
hays

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

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

data SplitComp = SplitCompEQ | SplitCompGE | SplitCompGT
  deriving stock (SplitComp -> SplitComp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SplitComp -> SplitComp -> Bool
$c/= :: SplitComp -> SplitComp -> Bool
== :: SplitComp -> SplitComp -> Bool
$c== :: SplitComp -> SplitComp -> Bool
Eq, Eq SplitComp
SplitComp -> SplitComp -> Bool
SplitComp -> SplitComp -> Ordering
SplitComp -> SplitComp -> SplitComp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SplitComp -> SplitComp -> SplitComp
$cmin :: SplitComp -> SplitComp -> SplitComp
max :: SplitComp -> SplitComp -> SplitComp
$cmax :: SplitComp -> SplitComp -> SplitComp
>= :: SplitComp -> SplitComp -> Bool
$c>= :: SplitComp -> SplitComp -> Bool
> :: SplitComp -> SplitComp -> Bool
$c> :: SplitComp -> SplitComp -> Bool
<= :: SplitComp -> SplitComp -> Bool
$c<= :: SplitComp -> SplitComp -> Bool
< :: SplitComp -> SplitComp -> Bool
$c< :: SplitComp -> SplitComp -> Bool
compare :: SplitComp -> SplitComp -> Ordering
$ccompare :: SplitComp -> SplitComp -> Ordering
Ord, Int -> SplitComp -> ShowS
[SplitComp] -> ShowS
SplitComp -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SplitComp] -> ShowS
$cshowList :: [SplitComp] -> ShowS
show :: SplitComp -> [Char]
$cshow :: SplitComp -> [Char]
showsPrec :: Int -> SplitComp -> ShowS
$cshowsPrec :: Int -> SplitComp -> ShowS
Show, Int -> SplitComp
SplitComp -> Int
SplitComp -> [SplitComp]
SplitComp -> SplitComp
SplitComp -> SplitComp -> [SplitComp]
SplitComp -> SplitComp -> SplitComp -> [SplitComp]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SplitComp -> SplitComp -> SplitComp -> [SplitComp]
$cenumFromThenTo :: SplitComp -> SplitComp -> SplitComp -> [SplitComp]
enumFromTo :: SplitComp -> SplitComp -> [SplitComp]
$cenumFromTo :: SplitComp -> SplitComp -> [SplitComp]
enumFromThen :: SplitComp -> SplitComp -> [SplitComp]
$cenumFromThen :: SplitComp -> SplitComp -> [SplitComp]
enumFrom :: SplitComp -> [SplitComp]
$cenumFrom :: SplitComp -> [SplitComp]
fromEnum :: SplitComp -> Int
$cfromEnum :: SplitComp -> Int
toEnum :: Int -> SplitComp
$ctoEnum :: Int -> SplitComp
pred :: SplitComp -> SplitComp
$cpred :: SplitComp -> SplitComp
succ :: SplitComp -> SplitComp
$csucc :: SplitComp -> SplitComp
Enum, SplitComp
forall a. a -> a -> Bounded a
maxBound :: SplitComp
$cmaxBound :: SplitComp
minBound :: SplitComp
$cminBound :: SplitComp
Bounded)

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

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

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

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

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

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

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

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

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

type instance Base (Err e) = ErrF e

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

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

-- | Range of a parse error
errRange :: Err e -> Range
errRange :: forall e. Err e -> Range
errRange = forall e r. ErrF e r -> Range
efRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Err e -> ErrF e (Err e)
unErr

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Parse repeatedly until the parser fails
greedyP :: Monad m => ParserT e m a -> ParserT e m (Seq a)
greedyP :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
greedyP ParserT e m a
p = Seq a -> ParserT e m (Seq a)
go forall a. Seq a
Empty
 where
  go :: Seq a -> ParserT e m (Seq a)
go !Seq a
acc = do
    Maybe a
ma <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
p
    case Maybe a
ma of
      Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
acc
      Just a
a -> Seq a -> ParserT e m (Seq a)
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
a)

-- | Same as 'greedyP' but ensure at least one result
greedy1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)
greedy1P :: forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
greedy1P ParserT e m a
p = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Seq a -> Seq a
(:<|) ParserT e m a
p (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
greedyP ParserT e m a
p)

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

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

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

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

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

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

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

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

-- private
subSplitP
  :: Monad m
  => St
  -> ParserT e m a
  -> (Either (Err e) (Seq a, Bool) -> T e m r)
  -> [(St, Int)]
  -> T e m r
subSplitP :: forall (m :: * -> *) e a r.
Monad m =>
St
-> ParserT e m a
-> (Either (Err e) (Seq a, Bool) -> T e m r)
-> [(St, Int)]
-> T e m r
subSplitP St
st0 ParserT e m a
pa Either (Err e) (Seq a, Bool) -> T e m r
j = Seq a -> [(St, Int)] -> T e m r
go forall a. Seq a
Empty
 where
  go :: Seq a -> [(St, Int)] -> T e m r
go !Seq a
acc = \case
    [] -> Either (Err e) (Seq a, Bool) -> T e m r
j (forall a b. b -> Either a b
Right (Seq a
acc, Bool
True))
    (St
st, Int
start') : [(St, Int)]
sts -> do
      forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st
      forall e (m :: * -> *) a.
ParserT e m a -> forall r. (Either (Err e) a -> T e m r) -> T e m r
unParserT (ParserT e m a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *) e. Monad m => ParserT e m ()
endP) forall a b. (a -> b) -> a -> b
$ \case
        Left Err e
_ -> do
          let rng :: Range
rng = St -> Range
stRange St
st0
              start :: Int
start = Range -> Int
rangeStart Range
rng
              hay' :: Text
hay' = Int -> Text -> Text
T.drop (Int
start' forall a. Num a => a -> a -> a
- Int
start) (St -> Text
stHay St
st0)
              range' :: Range
range' = Range
rng {rangeStart :: Int
rangeStart = Int
start'}
              st' :: St
st' = St
st0 {stHay :: Text
stHay = Text
hay', stRange :: Range
stRange = Range
range'}
          forall s (m :: * -> *). MonadState s m => s -> m ()
put St
st'
          Either (Err e) (Seq a, Bool) -> T e m r
j (forall a b. b -> Either a b
Right (Seq a
acc, Bool
False))
        Right a
a -> Seq a -> [(St, Int)] -> T e m r
go (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
a) [(St, Int)]
sts

-- | 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),
-- and True if there are no more delimiters in the tail.
splitP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
splitP :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
splitP Text
tx ParserT e m a
pa = 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) (Seq a, Bool) -> T e m r
j -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \St
st0 -> forall (m :: * -> *) e a r.
Monad m =>
St
-> ParserT e m a
-> (Either (Err e) (Seq a, Bool) -> T e m r)
-> [(St, Int)]
-> T e m r
subSplitP St
st0 ParserT e m a
pa Either (Err e) (Seq a, Bool) -> T e m r
j (Text -> St -> [(St, Int)]
splitRP Text
tx St
st0))

splitCompP :: Monad m => SplitComp -> Int -> Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
splitCompP :: forall (m :: * -> *) e a.
Monad m =>
SplitComp
-> Int -> Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
splitCompP SplitComp
comp Int
n Text
tx ParserT e m a
pa = do
  p :: (Seq a, Bool)
p@(Seq a
as, Bool
_) <- forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
splitP Text
tx ParserT e m a
pa
  let len :: Int
len = forall a. Seq a -> Int
Seq.length Seq a
as
      ok :: Bool
ok = case SplitComp
comp of
        SplitComp
SplitCompEQ -> Int
len forall a. Eq a => a -> a -> Bool
== Int
n
        SplitComp
SplitCompGE -> Int
len forall a. Ord a => a -> a -> Bool
>= Int
n
        SplitComp
SplitCompGT -> Int
len forall a. Ord a => a -> a -> Bool
> Int
n
  if Bool
ok then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq a, Bool)
p else forall (m :: * -> *) e a.
Monad m =>
Reason e (Err e) -> ParserT e m a
errP (forall e r. SplitComp -> Int -> Text -> Int -> Reason e r
ReasonSplitComp SplitComp
comp Int
n Text
tx Int
len)

-- | Like 'splitP' but ensures the sequence is at least length 1
split1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
split1P :: forall (m :: * -> *) e a.
Monad m =>
Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
split1P = forall (m :: * -> *) e a.
Monad m =>
SplitComp
-> Int -> Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
splitCompP SplitComp
SplitCompGE Int
1

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data StrState = StrState !Bool !(Seq Char)

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

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

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

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

-- | Parse a sequence of items delimited by the first parser
sepByP :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepByP :: forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepByP ParserT e m x
c ParserT e m a
p = ParserT e m (Seq a)
go
 where
  go :: ParserT e m (Seq a)
go = do
    Maybe a
ma <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m a
p
    case Maybe a
ma of
      Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Seq a
Empty
      Just a
a -> Seq a -> ParserT e m (Seq a)
goNext (forall a. Seq a
Empty forall a. Seq a -> a -> Seq a
:|> a
a)
  goNext :: Seq a -> ParserT e m (Seq a)
goNext !Seq a
acc = do
    Maybe x
mc <- forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP ParserT e m x
c
    case Maybe x
mc of
      Maybe x
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq a
acc
      Just x
_ -> do
        a
a <- ParserT e m a
p
        Seq a -> ParserT e m (Seq a)
goNext (Seq a
acc forall a. Seq a -> a -> Seq a
:|> a
a)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Like 'repeatP' but ensures at least 1
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 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Seq a -> Seq a
(:<|) ParserT e m a
p (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Seq a)
repeatP ParserT e m a
p)

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

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

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

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

-- | Like 'sepByP' but ensures at least 1 element
sepBy1P :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepBy1P :: forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepBy1P ParserT e m x
px ParserT e m a
pa = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Seq a -> Seq a
(:<|) ParserT e m a
pa (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe forall a. Seq a
Empty) (forall (m :: * -> *) e a.
Monad m =>
ParserT e m a -> ParserT e m (Maybe a)
optP (ParserT e m x
px forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepByP ParserT e m x
px ParserT e m a
pa)))

-- | Like 'sepBy1P' but ensures at least 2 elements (i.e. there was a delimiter)
sepBy2P :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepBy2P :: forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepBy2P ParserT e m x
px ParserT e m a
pa = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. a -> Seq a -> Seq a
(:<|) (ParserT e m a
pa forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT e m x
px) (forall (m :: * -> *) e x a.
Monad m =>
ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
sepBy1P ParserT e m x
px ParserT e m a
pa)

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

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

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

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

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

-- | Render a formatted error to text
renderE :: HasErrMessage e => FilePath -> Text -> Err e -> Text
renderE :: forall e. HasErrMessage e => [Char] -> Text -> Err e -> Text
renderE [Char]
fp Text
h Err e
e =
  let ov :: OffsetVec
ov = Text -> OffsetVec
mkOffsetVec Text
h
      mkP :: Int -> (Int, Int)
mkP = if forall a. Vector a -> Bool
V.null OffsetVec
ov then forall a b. a -> b -> a
const (Int
1, Int
1) else \Int
i -> let (!Int
l, !Int
c) = OffsetVec
ov forall a. Vector a -> Int -> a
V.! forall a. Ord a => a -> a -> a
min Int
i (forall a. Vector a -> Int
V.length OffsetVec
ov forall a. Num a => a -> a -> a
- Int
1) in (Int
l forall a. Num a => a -> a -> a
+ Int
1, Int
c forall a. Num a => a -> a -> a
+ Int
1)
  in  Text -> Text
TL.toStrict (forall source. Source source => source -> [Errata] -> Text
E.prettyErrors Text
h (forall e.
HasErrMessage e =>
[Char] -> (Int -> (Int, Int)) -> Err e -> [Errata]
errataE [Char]
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 => [Char] -> Text -> Err e -> IO ()
printE [Char]
fp Text
h Err e
e = Handle -> Text -> IO ()
TIO.hPutStrLn Handle
stderr (forall e. HasErrMessage e => [Char] -> Text -> Err e -> Text
renderE [Char]
fp Text
h Err e
e)