{-# LANGUAGE CPP #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}

-- | Monadic parsing combinator library with attention to locations.
module Text.Lips
  ( ParsedLines(..)
  , Parser
  , ParserResult(..)
  , ParserStep(..)
  , startParser
  , startParserAtLine
  , starveParser
  , parseText
  , LocParsing(..)
  , ResetLineParsing(..)
  ) where

import Data.Typeable (Typeable)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid(..))
import Data.Word (Word)
#endif
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Unsafe as T
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
import Text.Loc
import Text.Parser.Combinators (Parsing(..))
import Text.Parser.Char (CharParsing(..))
import Control.Applicative
import Control.Monad (MonadPlus(..))
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail(..))
#endif
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Identity (IdentityT(..))
import Control.Monad.Trans.Reader (ReaderT(..))
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict

data SavedInput = SavedInput { SavedInput -> Text -> SavedInput
siSave ∷ Text → SavedInput
                             , SavedInput -> [Text] -> [Text]
siLoad ∷ [Text] → [Text]
                             , SavedInput -> SavedInput
siPop  ∷ SavedInput }

doNotSave ∷ SavedInput
doNotSave :: SavedInput
doNotSave = SavedInput { siSave :: Text -> SavedInput
siSave = forall a b. a -> b -> a
const SavedInput
doNotSave
                       , siLoad :: [Text] -> [Text]
siLoad = forall a. a -> a
id
                       , siPop :: SavedInput
siPop  = SavedInput
doNotSave }

save ∷ SavedInput → SavedInput
save :: SavedInput -> SavedInput
save = [Text] -> SavedInput -> SavedInput
go []
  where go :: [Text] -> SavedInput -> SavedInput
go [Text]
is SavedInput
p = SavedInput { siSave :: Text -> SavedInput
siSave = \Text
i → [Text] -> SavedInput -> SavedInput
go (Text
i forall a. a -> [a] -> [a]
: [Text]
is) (SavedInput -> Text -> SavedInput
siSave SavedInput
p Text
i)
                             , siLoad :: [Text] -> [Text]
siLoad = (forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
reverse [Text]
is)
                             , siPop :: SavedInput
siPop  = SavedInput
p }

data Error = Error { Error -> LineCol
errLoc ∷ LineCol
                   , Error -> [String]
errCtx ∷ [String]
                   , Error -> String
errMsg ∷ String }

data LastLine = LastLine Text {-# UNPACK #-} !Int
              | NoLastLine

data AccLines = AccLines { AccLines -> Seq Text
lsLines   ∷ Seq Text
                         , AccLines -> Text
lsLastPre ∷ Text
                         , AccLines -> LastLine
lsLast    ∷ LastLine }

updateLines ∷ Text → Char → Bool → LineCol → AccLines
            → (LineCol → AccLines → α) → α
updateLines :: forall α.
Text
-> Char
-> Bool
-> LineCol
-> AccLines
-> (LineCol -> AccLines -> α)
-> α
updateLines Text
_ Char
'\n' Bool
_ LineCol
l AccLines
ls LineCol -> AccLines -> α
cont = LineCol -> AccLines -> α
cont LineCol
l' AccLines
ls'
  where
    !l' :: LineCol
l'  = LineCol -> LineCol
nextLine LineCol
l
    !ls' :: AccLines
ls' = case AccLines -> LastLine
lsLast AccLines
ls of
             LastLine Text
txt Int
len →
               AccLines { lsLines :: Seq Text
lsLines   = AccLines -> Seq Text
lsLines AccLines
ls forall a. Seq a -> a -> Seq a
|>
                                        (AccLines -> Text
lsLastPre AccLines
ls forall a. Monoid a => a -> a -> a
`mappend`
                                           Int -> Text -> Text
T.take Int
len Text
txt)
                        , lsLastPre :: Text
lsLastPre = Text
T.empty
                        , lsLast :: LastLine
lsLast    = LastLine
NoLastLine }
             LastLine
NoLastLine →
               AccLines
ls { lsLines :: Seq Text
lsLines   = AccLines -> Seq Text
lsLines AccLines
ls forall a. Seq a -> a -> Seq a
|> AccLines -> Text
lsLastPre AccLines
ls
                  , lsLastPre :: Text
lsLastPre = Text
T.empty }
updateLines Text
i Char
_ Bool
itIsNull LineCol
l AccLines
ls LineCol -> AccLines -> α
cont = LineCol -> AccLines -> α
cont LineCol
l' AccLines
ls'
  where
    !l' :: LineCol
l'  = LineCol -> LineCol
nextCol LineCol
l
    !ls' :: AccLines
ls' = case AccLines -> LastLine
lsLast AccLines
ls of
             LastLine Text
txt Int
len →
               AccLines
ls { lsLast :: LastLine
lsLast    = Text -> Int -> LastLine
LastLine Text
txt (Int
len forall a. Num a => a -> a -> a
+ Int
1) }
             LastLine
NoLastLine | Bool
itIsNull →
               AccLines
ls { lsLastPre :: Text
lsLastPre = AccLines -> Text
lsLastPre AccLines
ls forall a. Monoid a => a -> a -> a
`mappend` Text
i }
             LastLine
NoLastLine →
               AccLines
ls { lsLast :: LastLine
lsLast    = Text -> Int -> LastLine
LastLine Text
i Int
1 }

forceUpdateLines ∷ Text → Char → Bool → LineCol → AccLines
                 → (LineCol → AccLines → α) → α
forceUpdateLines :: forall α.
Text
-> Char
-> Bool
-> LineCol
-> AccLines
-> (LineCol -> AccLines -> α)
-> α
forceUpdateLines Text
_ Char
'\n' Bool
_ LineCol
l AccLines
ls LineCol -> AccLines -> α
cont = LineCol -> AccLines -> α
cont LineCol
l' AccLines
ls'
  where !l' :: LineCol
l'  = LineCol -> LineCol
nextLine LineCol
l
        !ls' :: AccLines
ls' = AccLines { lsLines :: Seq Text
lsLines   = AccLines -> Seq Text
lsLines AccLines
ls forall a. Seq a -> a -> Seq a
|> AccLines -> Text
lsLastPre AccLines
ls
                        , lsLastPre :: Text
lsLastPre = Text
T.empty
                        , lsLast :: LastLine
lsLast    = LastLine
NoLastLine }
forceUpdateLines Text
i Char
_ Bool
itIsNull LineCol
l AccLines
ls LineCol -> AccLines -> α
cont = LineCol -> AccLines -> α
cont LineCol
l' AccLines
ls'
  where !l' :: LineCol
l'  = LineCol -> LineCol
nextCol LineCol
l
        !ls' :: AccLines
ls' | Bool
itIsNull  = AccLines
ls { lsLastPre :: Text
lsLastPre = AccLines -> Text
lsLastPre AccLines
ls forall a. Monoid a => a -> a -> a
`mappend` Text
i }
             | Bool
otherwise = AccLines
ls { lsLast :: LastLine
lsLast    = Text -> Int -> LastLine
LastLine Text
i Int
1 }

-- | Lines of text consumed by a parser (fully or partially).
data ParsedLines = ParsedLines { ParsedLines -> Seq Text
plFull    ∷ Seq Text -- ^ Fully consumed lines
                               , ParsedLines -> Maybe Text
plPartial ∷ Maybe Text
                                 -- ^ Partially consumed line
                               }
                   deriving (Typeable, Int -> ParsedLines -> ShowS
[ParsedLines] -> ShowS
ParsedLines -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedLines] -> ShowS
$cshowList :: [ParsedLines] -> ShowS
show :: ParsedLines -> String
$cshow :: ParsedLines -> String
showsPrec :: Int -> ParsedLines -> ShowS
$cshowsPrec :: Int -> ParsedLines -> ShowS
Show)

type WithSt r = [String] → LineCol → LineCol → AccLines
              → [Text] → SavedInput → ParserStep r

-- | Opaque parser type.
newtype Parser α =
  Parser { forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser ∷ ∀ r . (α → WithSt r)
                           → (α → WithSt r)
                           → (Error → WithSt r)
                           → (Error → WithSt r)
                           → WithSt r }

-- | Parser result.
data ParserResult α = ParserSuccess { forall α. ParserResult α -> [Text]
prLeftovers ∷ [Text] -- ^ Unparsed input
                                    , forall α. ParserResult α -> ParsedLines
prLines     ∷ ParsedLines -- ^ Parsed input
                                    , forall α. ParserResult α -> LineCol
prLoc       ∷ LineCol -- ^ Last location
                                    , forall α. ParserResult α -> α
prResult    ∷ α -- ^ Parsed value
                                    }
                    | ParserFailure { prLeftovers ∷ [Text]
                                    , prLines     ∷ ParsedLines
                                    , prLoc       ∷ LineCol
                                    , forall α. ParserResult α -> [String]
prErrCtx    ∷ [String] -- ^ Error context
                                    , forall α. ParserResult α -> String
prErrMsg    ∷ String -- ^ Error message
                                    }
                    deriving (Typeable, Int -> ParserResult α -> ShowS
forall α. Show α => Int -> ParserResult α -> ShowS
forall α. Show α => [ParserResult α] -> ShowS
forall α. Show α => ParserResult α -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParserResult α] -> ShowS
$cshowList :: forall α. Show α => [ParserResult α] -> ShowS
show :: ParserResult α -> String
$cshow :: forall α. Show α => ParserResult α -> String
showsPrec :: Int -> ParserResult α -> ShowS
$cshowsPrec :: forall α. Show α => Int -> ParserResult α -> ShowS
Show)

-- | Parser continuation.
data ParserStep α = ParserCont (Text → ParserStep α) (ParserResult α)
                  | ParserDone (ParserResult α)

-- | Start a parser.
startParser ∷ Parser α → ParserStep α
startParser :: forall α. Parser α -> ParserStep α
startParser = forall α. Word -> Text -> Parser α -> ParserStep α
startParserAtLine Word
1 Text
T.empty

-- | Start a parser on a specific line number and provide it with a first
--   chunk of the input.
startParserAtLine ∷ Word → Text → Parser α → ParserStep α
startParserAtLine :: forall α. Word -> Text -> Parser α -> ParserStep α
startParserAtLine Word
ln₀ Text
pre₀ (Parser forall r.
(α -> WithSt r)
-> (α -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p) =
   forall r.
(α -> WithSt r)
-> (α -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p forall {α} {p} {p}.
α
-> p
-> p
-> LineCol
-> AccLines
-> [Text]
-> SavedInput
-> ParserStep α
fc forall {α} {p} {p}.
α
-> p
-> p
-> LineCol
-> AccLines
-> [Text]
-> SavedInput
-> ParserStep α
fc forall {p} {p} {p} {α}.
Error
-> p -> p -> p -> AccLines -> [Text] -> SavedInput -> ParserStep α
fh forall {p} {p} {p} {α}.
Error
-> p -> p -> p -> AccLines -> [Text] -> SavedInput -> ParserStep α
fh [] (Word -> Word -> LineCol
LineCol Word
ln₀ Word
col₀) (Word -> Word -> LineCol
LineCol Word
ln₀ (Word
col₀ forall a. Num a => a -> a -> a
+ Word
1))
     AccLines
lines₀ [] SavedInput
doNotSave
  where fc :: α
-> p
-> p
-> LineCol
-> AccLines
-> [Text]
-> SavedInput
-> ParserStep α
fc α
a p
_ p
_ LineCol
nl AccLines
ls [Text]
is SavedInput
si =
            forall α. ParserResult α -> ParserStep α
ParserDone (ParserSuccess { prLeftovers :: [Text]
prLeftovers = [Text]
lo
                                      , prLines :: ParsedLines
prLines     = ParsedLines
ls'
                                      , prLoc :: LineCol
prLoc       = LineCol
nl
                                      , prResult :: α
prResult    = α
a })
          where lo :: [Text]
lo  = SavedInput -> [Text] -> [Text]
siLoad SavedInput
si [Text]
is
                ls' :: ParsedLines
ls' = [Text] -> AccLines -> ParsedLines
calcLines [Text]
lo AccLines
ls
        fh :: Error
-> p -> p -> p -> AccLines -> [Text] -> SavedInput -> ParserStep α
fh Error
e p
_ p
_ p
_ AccLines
ls [Text]
is SavedInput
si =
            forall α. ParserResult α -> ParserStep α
ParserDone (ParserFailure { prLeftovers :: [Text]
prLeftovers = [Text]
lo
                                      , prLines :: ParsedLines
prLines     = ParsedLines
ls'
                                      , prLoc :: LineCol
prLoc       = Error -> LineCol
errLoc Error
e
                                      , prErrCtx :: [String]
prErrCtx    = forall a. [a] -> [a]
reverse (Error -> [String]
errCtx Error
e)
                                      , prErrMsg :: String
prErrMsg    = Error -> String
errMsg Error
e })
          where lo :: [Text]
lo  = SavedInput -> [Text] -> [Text]
siLoad SavedInput
si [Text]
is
                ls' :: ParsedLines
ls' = [Text] -> AccLines -> ParsedLines
calcLines [Text]
lo AccLines
ls
        col₀ :: Word
col₀   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
pre₀)
        lines₀ :: AccLines
lines₀ = AccLines { lsLines :: Seq Text
lsLines   = forall a. Seq a
Seq.empty
                          , lsLastPre :: Text
lsLastPre = Text
pre₀
                          , lsLast :: LastLine
lsLast    = LastLine
NoLastLine }
        calcLines :: [Text] -> AccLines -> ParsedLines
calcLines [Text]
lo (AccLines {Text
Seq Text
LastLine
lsLast :: LastLine
lsLastPre :: Text
lsLines :: Seq Text
lsLast :: AccLines -> LastLine
lsLastPre :: AccLines -> Text
lsLines :: AccLines -> Seq Text
..}) = [Text] -> [Text] -> ParsedLines
go [] [Text]
lo
          where lastLine :: Text
lastLine       = case LastLine
lsLast of
                                   LastLine Text
txt Int
len → Text
lsLastPre forall a. Monoid a => a -> a -> a
`mappend`
                                                        Int -> Text -> Text
T.take Int
len Text
txt
                                   LastLine
NoLastLine       → Text
lsLastPre
                go :: [Text] -> [Text] -> ParsedLines
go [Text]
acc []      = Seq Text -> Maybe Text -> ParsedLines
ParsedLines Seq Text
lsLines
                               forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just
                               forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
                               forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse (Text
lastLine forall a. a -> [a] -> [a]
: [Text]
acc)
                go [Text]
acc (Text
h : [Text]
t) | (Text
h₁, Text
h₂) ← (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
h
                               , Bool -> Bool
not (Text -> Bool
T.null Text
h₂)
                               , Text
line ← forall a. Monoid a => [a] -> a
mconcat
                                      forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse
                                      forall a b. (a -> b) -> a -> b
$ Text
h₁ forall a. a -> [a] -> [a]
: Text
lastLine forall a. a -> [a] -> [a]
: [Text]
acc
                               = Seq Text -> Maybe Text -> ParsedLines
ParsedLines (Seq Text
lsLines forall a. Seq a -> a -> Seq a
|> Text
line) forall a. Maybe a
Nothing
                               | Bool
otherwise
                               = [Text] -> [Text] -> ParsedLines
go (Text
h forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
t

-- | Feed a parser continuation with empty input.
starveParser ∷ ParserStep α → ParserResult α
starveParser :: forall α. ParserStep α -> ParserResult α
starveParser (ParserCont Text -> ParserStep α
_ ParserResult α
r) = ParserResult α
r
starveParser (ParserDone ParserResult α
r)   = ParserResult α
r

-- | Run a parser on a text.
parseText ∷ Text → Parser α → ParserResult α
parseText :: forall α. Text -> Parser α -> ParserResult α
parseText Text
t Parser α
p = case forall α. Parser α -> ParserStep α
startParser Parser α
p of
                  ParserCont Text -> ParserStep α
c ParserResult α
_ → forall α. ParserStep α -> ParserResult α
starveParser (Text -> ParserStep α
c Text
t)
                  ParserDone ParserResult α
r   → ParserResult α
r


failParser:: String → Parser α 
failParser :: forall α. String -> Parser α
failParser String
msg = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \α -> WithSt r
_ α -> WithSt r
_ Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl →
                   Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
msg) [String]
ctx LineCol
pl LineCol
nl
{-# INLINE failParser #-}

instance Functor Parser where
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p) = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \b -> WithSt r
c b -> WithSt r
cc → forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (b -> WithSt r
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (b -> WithSt r
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative Parser where
  pure :: forall a. a -> Parser a
pure a
a = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \a -> WithSt r
c a -> WithSt r
_ Error -> WithSt r
_ Error -> WithSt r
_ → a -> WithSt r
c a
a
  {-# INLINE pure #-}
  Parser forall r.
((a -> b) -> WithSt r)
-> ((a -> b) -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₁ <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₂ = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \b -> WithSt r
c b -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch →
    forall r.
((a -> b) -> WithSt r)
-> ((a -> b) -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₁ (\a -> b
f → forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₂ (b -> WithSt r
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (b -> WithSt r
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Error -> WithSt r
h Error -> WithSt r
ch) (\a -> b
f → forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₂ (b -> WithSt r
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (b -> WithSt r
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Error -> WithSt r
ch Error -> WithSt r
ch) Error -> WithSt r
h Error -> WithSt r
ch
  {-# INLINE (<*>) #-}

instance Alternative Parser where
  empty :: forall a. Parser a
empty = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \a -> WithSt r
_ a -> WithSt r
_ Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl →
            Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
"Empty alternative") [String]
ctx LineCol
pl LineCol
nl
  {-# INLINE empty #-}
  Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₁ <|> :: forall a. Parser a -> Parser a -> Parser a
<|> Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₂ =
    forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \a -> WithSt r
c a -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl AccLines
ls →
      forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₁ a -> WithSt r
c a -> WithSt r
cc (\Error
_ [String]
_ LineCol
_ LineCol
_ AccLines
_ → forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p₂ a -> WithSt r
c a -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl AccLines
ls) Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl AccLines
ls

instance Monad Parser where
  return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE return #-}
  Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
f = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \b -> WithSt r
c b -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch →
    forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (\a
a → forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser (a -> Parser b
f a
a) b -> WithSt r
c b -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch) (\a
a → forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser (a -> Parser b
f a
a) b -> WithSt r
cc b -> WithSt r
cc Error -> WithSt r
ch Error -> WithSt r
ch) Error -> WithSt r
h Error -> WithSt r
ch
  {-# INLINE (>>=) #-}
#if !MIN_VERSION_base(4,13,0)
  fail = failParser
  {-# INLINE fail #-}
#endif

#if MIN_VERSION_base(4,9,0)
instance MonadFail Parser where
  fail :: forall α. String -> Parser α
fail = forall α. String -> Parser α
failParser
  {-# INLINE fail #-}
#endif

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

instance Parsing Parser where
  try :: forall a. Parser a -> Parser a
try (Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p) =
    forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \a -> WithSt r
c a -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si →
      forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (\a
a [String]
ctx' LineCol
pl' LineCol
nl' AccLines
ls' [Text]
is' SavedInput
si' → a -> WithSt r
c  a
a [String]
ctx' LineCol
pl' LineCol
nl' AccLines
ls' [Text]
is' (SavedInput -> SavedInput
siPop SavedInput
si'))
        (\a
a [String]
ctx' LineCol
pl' LineCol
nl' AccLines
ls' [Text]
is' SavedInput
si' → a -> WithSt r
cc a
a [String]
ctx' LineCol
pl' LineCol
nl' AccLines
ls' [Text]
is' (SavedInput -> SavedInput
siPop SavedInput
si'))
        (\Error
e [String]
_    LineCol
_   LineCol
_   AccLines
_   [Text]
_   SavedInput
si' → Error -> WithSt r
h  Error
e [String]
ctx  LineCol
pl  LineCol
nl  AccLines
ls
                                          (SavedInput -> [Text] -> [Text]
siLoad SavedInput
si' [Text]
is) (SavedInput -> SavedInput
siPop SavedInput
si'))
        (\Error
e [String]
_    LineCol
_   LineCol
_   AccLines
_   [Text]
_   SavedInput
si' → Error -> WithSt r
h  Error
e [String]
ctx  LineCol
pl  LineCol
nl  AccLines
ls
                                          (SavedInput -> [Text] -> [Text]
siLoad SavedInput
si' [Text]
is) (SavedInput -> SavedInput
siPop SavedInput
si'))
        [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is (SavedInput -> SavedInput
save SavedInput
si)
  Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p <?> :: forall a. Parser a -> String -> Parser a
<?> String
label = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \a -> WithSt r
c a -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx →
                         forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (\a
a [String]
_ → a -> WithSt r
c a
a [String]
ctx) (\a
a [String]
_ → a -> WithSt r
cc a
a [String]
ctx)
                           (\Error
e [String]
_ → Error -> WithSt r
h Error
e [String]
ctx) (\Error
e [String]
_ → Error -> WithSt r
ch Error
e [String]
ctx)
                           (String
label forall a. a -> [a] -> [a]
: [String]
ctx)
  {-# INLINE (<?>) #-}
  skipMany :: forall a. Parser a -> Parser ()
skipMany Parser a
p = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \() -> WithSt r
c () -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl AccLines
ls →
                 forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser Parser a
p (\a
_ → forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser (forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany Parser a
p) () -> WithSt r
c  () -> WithSt r
cc Error -> WithSt r
h  Error -> WithSt r
ch)
                             (\a
_ → forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser (forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany Parser a
p) () -> WithSt r
cc () -> WithSt r
cc Error -> WithSt r
ch Error -> WithSt r
ch)
                             (\Error
_ [String]
_ LineCol
_ LineCol
_ AccLines
_ → () -> WithSt r
c () [String]
ctx LineCol
pl LineCol
nl AccLines
ls)
                             Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl AccLines
ls
  skipSome :: forall a. Parser a -> Parser ()
skipSome Parser a
p = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \() -> WithSt r
c () -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch →
                 forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser Parser a
p (\a
_ → forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser (forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany Parser a
p) () -> WithSt r
c  () -> WithSt r
cc Error -> WithSt r
h  Error -> WithSt r
ch)
                             (\a
_ → forall α.
Parser α
-> forall r.
   (α -> WithSt r)
   -> (α -> WithSt r)
   -> (Error -> WithSt r)
   -> (Error -> WithSt r)
   -> WithSt r
runParser (forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany Parser a
p) () -> WithSt r
cc () -> WithSt r
cc Error -> WithSt r
ch Error -> WithSt r
ch)
                             Error -> WithSt r
h Error -> WithSt r
ch
  {-# INLINE skipSome #-}
  unexpected :: forall α. String -> Parser α
unexpected = forall α. String -> Parser α
failParser forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Unexpected " forall a. [a] -> [a] -> [a]
++)
  {-# INLINE unexpected #-}
  notFollowedBy :: forall a. Show a => Parser a -> Parser ()
notFollowedBy (Parser forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p) = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \() -> WithSt r
c () -> WithSt r
_ Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si →
    forall r.
(a -> WithSt r)
-> (a -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (\a
a [String]
_ LineCol
_ LineCol
_ AccLines
_ [Text]
_ SavedInput
si' → Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx (String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a))
                            [String]
ctx LineCol
pl LineCol
nl AccLines
ls (SavedInput -> [Text] -> [Text]
siLoad SavedInput
si' [Text]
is) (SavedInput -> SavedInput
siPop SavedInput
si'))
      (\a
a [String]
_ LineCol
_ LineCol
_ AccLines
_ [Text]
_ SavedInput
si' → Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx (String
"Unexpected " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a))
                            [String]
ctx LineCol
pl LineCol
nl AccLines
ls (SavedInput -> [Text] -> [Text]
siLoad SavedInput
si' [Text]
is) (SavedInput -> SavedInput
siPop SavedInput
si'))
      (\Error
_ [String]
_ LineCol
_ LineCol
_ AccLines
_ [Text]
_ SavedInput
si' → () -> WithSt r
c () [String]
ctx LineCol
pl LineCol
nl AccLines
ls (SavedInput -> [Text] -> [Text]
siLoad SavedInput
si' [Text]
is) (SavedInput -> SavedInput
siPop SavedInput
si'))
      (\Error
_ [String]
_ LineCol
_ LineCol
_ AccLines
_ [Text]
_ SavedInput
si' → () -> WithSt r
c () [String]
ctx LineCol
pl LineCol
nl AccLines
ls (SavedInput -> [Text] -> [Text]
siLoad SavedInput
si' [Text]
is) (SavedInput -> SavedInput
siPop SavedInput
si'))
      [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is (SavedInput -> SavedInput
save SavedInput
si)
  eof :: Parser ()
eof = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \() -> WithSt r
c () -> WithSt r
_ Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si →
          let go :: ParserStep r
go = forall α. (Text -> ParserStep α) -> ParserResult α -> ParserStep α
ParserCont
                     (\Text
i → if Text -> Bool
T.null Text
i
                           then ParserStep r
go
                           else Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
"End of input expected")
                                  [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text
i] (SavedInput -> Text -> SavedInput
siSave SavedInput
si Text
i))
                     (forall α. ParserStep α -> ParserResult α
starveParser forall a b. (a -> b) -> a -> b
$ () -> WithSt r
c () [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si) in
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
is
            then ParserStep r
go
            else Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
"End of input expected")
                   [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si

instance CharParsing Parser where
  satisfy :: (Char -> Bool) -> Parser Char
satisfy Char -> Bool
p = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \Char -> WithSt r
_ Char -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si →
    case [Text]
is of
      Text
i : [Text]
tl | !Char
ih ← Text -> Char
T.unsafeHead Text
i, Char -> Bool
p Char
ih
             , !Text
it ← Text -> Text
T.unsafeTail Text
i, !Bool
itIsNull ← Text -> Bool
T.null Text
it
             → forall α.
Text
-> Char
-> Bool
-> LineCol
-> AccLines
-> (LineCol -> AccLines -> α)
-> α
updateLines Text
i Char
ih Bool
itIsNull LineCol
nl AccLines
ls forall a b. (a -> b) -> a -> b
$ \LineCol
nl' AccLines
ls' →
                 Char -> WithSt r
cc Char
ih [String]
ctx LineCol
nl LineCol
nl' AccLines
ls'
                    (if Bool
itIsNull then [Text]
tl else Text
it forall a. a -> [a] -> [a]
: [Text]
tl) SavedInput
si
      Text
_ : [Text]
_ → Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
"Unexpected input") [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si
      [] → ParserStep r
go
        where
          go :: ParserStep r
go = forall α. (Text -> ParserStep α) -> ParserResult α -> ParserStep α
ParserCont
                 (\Text
i → case Text -> Maybe (Char, Text)
T.uncons Text
i of
                         Just (!Char
ih, Text
it) | Char -> Bool
p Char
ih, !Bool
itIsNull ← Text -> Bool
T.null Text
it →
                           forall α.
Text
-> Char
-> Bool
-> LineCol
-> AccLines
-> (LineCol -> AccLines -> α)
-> α
forceUpdateLines Text
i Char
ih Bool
itIsNull LineCol
nl AccLines
ls forall a b. (a -> b) -> a -> b
$ \LineCol
nl' AccLines
ls' →
                             Char -> WithSt r
cc Char
ih [String]
ctx LineCol
nl LineCol
nl' AccLines
ls'
                                (if Bool
itIsNull then [] else [Text
it])
                                (SavedInput -> Text -> SavedInput
siSave SavedInput
si Text
i)
                         Just (Char, Text)
_ → Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
"Unexpected input")
                                    [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text
i] (SavedInput -> Text -> SavedInput
siSave SavedInput
si Text
i)
                         Maybe (Char, Text)
Nothing → ParserStep r
go)
                 (forall α. ParserStep α -> ParserResult α
starveParser forall a b. (a -> b) -> a -> b
$ Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx String
"Unexpected end of input")
                                   [String]
ctx LineCol
pl LineCol
nl AccLines
ls [] SavedInput
si)
  char :: Char -> Parser Char
char Char
c = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (forall a. Eq a => a -> a -> Bool
== Char
c) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"A " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
  notChar :: Char -> Parser Char
notChar Char
c = forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
c) forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"Not a " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c)
  anyChar :: Parser Char
anyChar = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \Char -> WithSt r
_ Char -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl AccLines
ls [Text]
is SavedInput
si →
    let ctx' :: [String]
ctx' = String
"Any character" forall a. a -> [a] -> [a]
: [String]
ctx in
      case [Text]
is of
        Text
i : [Text]
tl | !Char
ih ← Text -> Char
T.unsafeHead Text
i
               , !Text
it ← Text -> Text
T.unsafeTail Text
i , !Bool
itIsNull ← Text -> Bool
T.null Text
it
               → forall α.
Text
-> Char
-> Bool
-> LineCol
-> AccLines
-> (LineCol -> AccLines -> α)
-> α
updateLines Text
i Char
ih Bool
itIsNull LineCol
nl AccLines
ls forall a b. (a -> b) -> a -> b
$ \LineCol
nl' AccLines
ls' →
                   Char -> WithSt r
cc Char
ih [String]
ctx' LineCol
nl LineCol
nl' AccLines
ls'
                      (if Bool
itIsNull then [Text]
tl else Text
it forall a. a -> [a] -> [a]
: [Text]
tl) SavedInput
si
        [] → ParserStep r
go
          where
            go :: ParserStep r
go = forall α. (Text -> ParserStep α) -> ParserResult α -> ParserStep α
ParserCont
                   (\Text
i → case Text -> Maybe (Char, Text)
T.uncons Text
i of
                           Just (!Char
ih, Text
it) | !Bool
itIsNull ← Text -> Bool
T.null Text
it →
                             forall α.
Text
-> Char
-> Bool
-> LineCol
-> AccLines
-> (LineCol -> AccLines -> α)
-> α
forceUpdateLines Text
i Char
ih Bool
itIsNull LineCol
nl AccLines
ls forall a b. (a -> b) -> a -> b
$ \LineCol
nl' AccLines
ls' →
                               Char -> WithSt r
cc Char
ih [String]
ctx' LineCol
nl LineCol
nl' AccLines
ls'
                                  (if Bool
itIsNull then [] else [Text
it])
                                  (SavedInput -> Text -> SavedInput
siSave SavedInput
si Text
i)
                           Maybe (Char, Text)
Nothing → ParserStep r
go)
                   (forall α. ParserStep α -> ParserResult α
starveParser forall a b. (a -> b) -> a -> b
$ Error -> WithSt r
h (LineCol -> [String] -> String -> Error
Error LineCol
nl [String]
ctx' String
"Unexpected end of input")
                                     [String]
ctx' LineCol
pl LineCol
nl AccLines
ls [] SavedInput
si)

instance α ~ String ⇒ IsString (Parser α) where
  fromString :: String -> Parser α
fromString = forall (m :: * -> *). CharParsing m => String -> m String
string
  {-# INLINE fromString #-}

-- | Parsers that provide location information.
class CharParsing p ⇒ LocParsing p where
  -- | Parser location type.
  type ParserLoc p
  -- | The current location.
  location ∷ p (ParserLoc p)
  default location ∷ (MonadTrans t, Monad m, LocParsing m, p ~ t m, ParserLoc p ~ ParserLoc m) ⇒ p (ParserLoc p)
  location = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (p :: * -> *). LocParsing p => p (ParserLoc p)
location
  -- | Attach the starting location to the parsed value.
  located  ∷ p α → p (Located (ParserLoc p) α)
  -- | Attach the spanned location to the parsed value.
  spanned  ∷ p α → p (Located (Span (ParserLoc p)) α)

-- | Parsers with resettable line numbers.
class LocParsing p ⇒ ResetLineParsing p where
  -- | Reset the current line number and return the text lines fully consumed
  --   by the parser so far.
  resetLineNr ∷ Word → p (Seq Text)
  default resetLineNr ∷ (MonadTrans t, Monad m, ResetLineParsing m, p ~ t m) ⇒ Word → p (Seq Text)
  resetLineNr = 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 (p :: * -> *). ResetLineParsing p => Word -> p (Seq Text)
resetLineNr

instance LocParsing Parser where
  type ParserLoc Parser = LineCol
  location :: Parser (ParserLoc Parser)
location = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \ParserLoc Parser -> WithSt r
c ParserLoc Parser -> WithSt r
_ Error -> WithSt r
_ Error -> WithSt r
_ [String]
ctx LineCol
pl LineCol
nl → ParserLoc Parser -> WithSt r
c LineCol
nl [String]
ctx LineCol
pl LineCol
nl
  {-# INLINE location #-}
  located :: forall α. Parser α -> Parser (Located (ParserLoc Parser) α)
located (Parser forall r.
(α -> WithSt r)
-> (α -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p) = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \Located (ParserLoc Parser) α -> WithSt r
c Located (ParserLoc Parser) α -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl →
                         forall r.
(α -> WithSt r)
-> (α -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (Located (ParserLoc Parser) α -> WithSt r
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l α. l -> α -> Located l α
Located LineCol
nl) (Located (ParserLoc Parser) α -> WithSt r
cc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l α. l -> α -> Located l α
Located LineCol
nl) Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl
  {-# INLINE located #-}
  spanned :: forall α. Parser α -> Parser (Located (Span (ParserLoc Parser)) α)
spanned (Parser forall r.
(α -> WithSt r)
-> (α -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p) = forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \Located (Span (ParserLoc Parser)) α -> WithSt r
c Located (Span (ParserLoc Parser)) α -> WithSt r
cc Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl →
    forall r.
(α -> WithSt r)
-> (α -> WithSt r)
-> (Error -> WithSt r)
-> (Error -> WithSt r)
-> WithSt r
p (\α
a [String]
ctx' LineCol
pl' → Located (Span (ParserLoc Parser)) α -> WithSt r
c (forall l α. l -> α -> Located l α
Located (forall l. l -> l -> Span l
Span LineCol
nl (forall a. Ord a => a -> a -> a
max LineCol
nl LineCol
pl')) α
a) [String]
ctx' LineCol
pl')
      (\α
a [String]
ctx' LineCol
pl' → Located (Span (ParserLoc Parser)) α -> WithSt r
cc (forall l α. l -> α -> Located l α
Located (forall l. l -> l -> Span l
Span LineCol
nl (forall a. Ord a => a -> a -> a
max LineCol
nl LineCol
pl')) α
a) [String]
ctx' LineCol
pl')
      Error -> WithSt r
h Error -> WithSt r
ch [String]
ctx LineCol
pl LineCol
nl
  {-# INLINABLE spanned #-}

instance ResetLineParsing Parser where
  resetLineNr :: Word -> Parser (Seq Text)
resetLineNr Word
ln =
    forall α.
(forall r.
 (α -> WithSt r)
 -> (α -> WithSt r)
 -> (Error -> WithSt r)
 -> (Error -> WithSt r)
 -> WithSt r)
-> Parser α
Parser forall a b. (a -> b) -> a -> b
$ \Seq Text -> WithSt r
c Seq Text -> WithSt r
_ Error -> WithSt r
_ Error -> WithSt r
_ [String]
ctx LineCol
_ LineCol
nl ls :: AccLines
ls@(AccLines {Text
Seq Text
LastLine
lsLast :: LastLine
lsLastPre :: Text
lsLines :: Seq Text
lsLast :: AccLines -> LastLine
lsLastPre :: AccLines -> Text
lsLines :: AccLines -> Seq Text
..}) →
      let col :: Word
col = forall l. LineColLoc l => l -> Word
locCol LineCol
nl in
        Seq Text -> WithSt r
c Seq Text
lsLines [String]
ctx (Word -> Word -> LineCol
LineCol Word
ln (Word
col forall a. Num a => a -> a -> a
- Word
1)) (Word -> Word -> LineCol
LineCol Word
ln Word
col)
          (AccLines
ls { lsLines :: Seq Text
lsLines = forall a. Seq a
Seq.empty })

instance (MonadPlus p, LocParsing p) ⇒ LocParsing (IdentityT p) where
  type ParserLoc (IdentityT p) = ParserLoc p
  located :: forall α.
IdentityT p α -> IdentityT p (Located (ParserLoc (IdentityT p)) α)
located (IdentityT p α
p) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located p α
p
  spanned :: forall α.
IdentityT p α
-> IdentityT p (Located (Span (ParserLoc (IdentityT p))) α)
spanned (IdentityT p α
p) = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned p α
p

instance (MonadPlus p, ResetLineParsing p) ⇒ ResetLineParsing (IdentityT p) where

instance (MonadPlus p, LocParsing p) ⇒ LocParsing (ReaderT r p) where
  type ParserLoc (ReaderT r p) = ParserLoc p
  located :: forall α.
ReaderT r p α -> ReaderT r p (Located (ParserLoc (ReaderT r p)) α)
located (ReaderT r -> p α
p) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> p α
p
  spanned :: forall α.
ReaderT r p α
-> ReaderT r p (Located (Span (ParserLoc (ReaderT r p))) α)
spanned (ReaderT r -> p α
p) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> p α
p

instance (MonadPlus p, ResetLineParsing p) ⇒ ResetLineParsing (ReaderT r p) where

instance (Monoid w, MonadPlus p, LocParsing p)
         ⇒ LocParsing (Lazy.WriterT w p) where
  type ParserLoc (Lazy.WriterT w p) = ParserLoc p
  located :: forall α.
WriterT w p α -> WriterT w p (Located (ParserLoc (WriterT w p)) α)
located (Lazy.WriterT p (α, w)
p) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$ do
                               Located ParserLoc p
l (α
a, w
w) ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located p (α, w)
p
                               forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located ParserLoc p
l α
a, w
w)
  spanned :: forall α.
WriterT w p α
-> WriterT w p (Located (Span (ParserLoc (WriterT w p))) α)
spanned (Lazy.WriterT p (α, w)
p) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$ do
                               Located Span (ParserLoc p)
l (α
a, w
w) ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned p (α, w)
p
                               forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located Span (ParserLoc p)
l α
a, w
w)

instance (Monoid w, MonadPlus p, ResetLineParsing p)
         ⇒ ResetLineParsing (Lazy.WriterT w p) where

instance (Monoid w, MonadPlus p, LocParsing p)
         ⇒ LocParsing (Strict.WriterT w p) where
  type ParserLoc (Strict.WriterT w p) = ParserLoc p
  located :: forall α.
WriterT w p α -> WriterT w p (Located (ParserLoc (WriterT w p)) α)
located (Strict.WriterT p (α, w)
p) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$ do
                                 Located ParserLoc p
l (α
a, w
w) ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located p (α, w)
p
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located ParserLoc p
l α
a, w
w)
  spanned :: forall α.
WriterT w p α
-> WriterT w p (Located (Span (ParserLoc (WriterT w p))) α)
spanned (Strict.WriterT p (α, w)
p) = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$ do
                                 Located Span (ParserLoc p)
l (α
a, w
w) ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned p (α, w)
p
                                 forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located Span (ParserLoc p)
l α
a, w
w)

instance (Monoid w, MonadPlus p, ResetLineParsing p)
         ⇒ ResetLineParsing (Strict.WriterT w p) where

instance (MonadPlus p, LocParsing p) ⇒ LocParsing (Lazy.StateT s p) where
  type ParserLoc (Lazy.StateT s p) = ParserLoc p
  located :: forall α.
StateT s p α -> StateT s p (Located (ParserLoc (StateT s p)) α)
located (Lazy.StateT s -> p (α, s)
p) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
                              Located ParserLoc p
l (α
a, s
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located (s -> p (α, s)
p s
s)
                              forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located ParserLoc p
l α
a, s
s')
  spanned :: forall α.
StateT s p α
-> StateT s p (Located (Span (ParserLoc (StateT s p))) α)
spanned (Lazy.StateT s -> p (α, s)
p) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
                              Located Span (ParserLoc p)
l (α
a, s
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned (s -> p (α, s)
p s
s)
                              forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located Span (ParserLoc p)
l α
a, s
s')

instance (MonadPlus p, ResetLineParsing p)
         ⇒ ResetLineParsing (Lazy.StateT s p) where

instance (MonadPlus p, LocParsing p) ⇒ LocParsing (Strict.StateT s p) where
  type ParserLoc (Strict.StateT s p) = ParserLoc p
  located :: forall α.
StateT s p α -> StateT s p (Located (ParserLoc (StateT s p)) α)
located (Strict.StateT s -> p (α, s)
p) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
                                Located ParserLoc p
l (α
a, s
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located (s -> p (α, s)
p s
s)
                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located ParserLoc p
l α
a, s
s')
  spanned :: forall α.
StateT s p α
-> StateT s p (Located (Span (ParserLoc (StateT s p))) α)
spanned (Strict.StateT s -> p (α, s)
p) = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s → do
                                Located Span (ParserLoc p)
l (α
a, s
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned (s -> p (α, s)
p s
s)
                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located Span (ParserLoc p)
l α
a, s
s')

instance (MonadPlus p, ResetLineParsing p)
         ⇒ ResetLineParsing (Strict.StateT s p) where

instance (Monoid w, MonadPlus p, LocParsing p)
         ⇒ LocParsing (Lazy.RWST r w s p) where
  type ParserLoc (Lazy.RWST r w s p) = ParserLoc p
  located :: forall α.
RWST r w s p α
-> RWST r w s p (Located (ParserLoc (RWST r w s p)) α)
located (Lazy.RWST r -> s -> p (α, s, w)
p) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
                            Located ParserLoc p
l (α
a, s
w, w
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located (r -> s -> p (α, s, w)
p r
r s
s)
                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located ParserLoc p
l α
a, s
w, w
s')
  spanned :: forall α.
RWST r w s p α
-> RWST r w s p (Located (Span (ParserLoc (RWST r w s p))) α)
spanned (Lazy.RWST r -> s -> p (α, s, w)
p) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
                            Located Span (ParserLoc p)
l (α
a, s
w, w
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned (r -> s -> p (α, s, w)
p r
r s
s)
                            forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located Span (ParserLoc p)
l α
a, s
w, w
s')

instance (Monoid w, MonadPlus p, ResetLineParsing p)
         ⇒ ResetLineParsing (Lazy.RWST r w s p) where

instance (Monoid w, MonadPlus p, LocParsing p)
         ⇒ LocParsing (Strict.RWST r w s p) where
  type ParserLoc (Strict.RWST r w s p) = ParserLoc p
  located :: forall α.
RWST r w s p α
-> RWST r w s p (Located (ParserLoc (RWST r w s p)) α)
located (Strict.RWST r -> s -> p (α, s, w)
p) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
                              Located ParserLoc p
l (α
a, s
w, w
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (ParserLoc p) α)
located (r -> s -> p (α, s, w)
p r
r s
s)
                              forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located ParserLoc p
l α
a, s
w, w
s')
  spanned :: forall α.
RWST r w s p α
-> RWST r w s p (Located (Span (ParserLoc (RWST r w s p))) α)
spanned (Strict.RWST r -> s -> p (α, s, w)
p) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s → do
                              Located Span (ParserLoc p)
l (α
a, s
w, w
s') ← forall (p :: * -> *) α.
LocParsing p =>
p α -> p (Located (Span (ParserLoc p)) α)
spanned (r -> s -> p (α, s, w)
p r
r s
s)
                              forall (m :: * -> *) a. Monad m => a -> m a
return (forall l α. l -> α -> Located l α
Located Span (ParserLoc p)
l α
a, s
w, w
s')

instance (Monoid w, MonadPlus p, ResetLineParsing p)
         ⇒ ResetLineParsing (Strict.RWST r w s p) where