-- | Utilities for handling lexing/tokenization as a separate parsing pass
module SimpleParser.Lexer
  ( Spanned (..)
  , LexedStream (..)
  , LexedSpan (..)
  , spannedParser
  , lexedParser
  , runParserLexed
  , lexedParseInteractive
  ) where

import Control.Monad.Catch (MonadThrow)
import Control.Monad.State.Strict (gets)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import SimpleParser.Explain (ExplainError, ExplainLabel, TextBuildable)
import SimpleParser.Input (matchEnd)
import SimpleParser.Interactive (ErrorStyle (..), renderInteractive)
import SimpleParser.Parser (Parser, ParserT, greedyStarParser, runParser)
import SimpleParser.Result (ParseResult (..), ParseSuccess (..))
import SimpleParser.Stream (HasLinePos (..), LinePosStream, PosStream (..), Span (..), Stream (..), newLinePosStream)
import SimpleParser.Throw (runParserEnd)

-- | A value annotated with a 'Span'
data Spanned p a = Spanned
  { forall p a. Spanned p a -> Span p
spannedSpan :: !(Span p)
  , forall p a. Spanned p a -> a
spannedValue :: !a
  } deriving stock (Spanned p a -> Spanned p a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a. (Eq p, Eq a) => Spanned p a -> Spanned p a -> Bool
/= :: Spanned p a -> Spanned p a -> Bool
$c/= :: forall p a. (Eq p, Eq a) => Spanned p a -> Spanned p a -> Bool
== :: Spanned p a -> Spanned p a -> Bool
$c== :: forall p a. (Eq p, Eq a) => Spanned p a -> Spanned p a -> Bool
Eq, Int -> Spanned p a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> Spanned p a -> ShowS
forall p a. (Show p, Show a) => [Spanned p a] -> ShowS
forall p a. (Show p, Show a) => Spanned p a -> String
showList :: [Spanned p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [Spanned p a] -> ShowS
show :: Spanned p a -> String
$cshow :: forall p a. (Show p, Show a) => Spanned p a -> String
showsPrec :: Int -> Spanned p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> Spanned p a -> ShowS
Show, forall a b. a -> Spanned p b -> Spanned p a
forall a b. (a -> b) -> Spanned p a -> Spanned p b
forall p a b. a -> Spanned p b -> Spanned p a
forall p a b. (a -> b) -> Spanned p a -> Spanned p 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 -> Spanned p b -> Spanned p a
$c<$ :: forall p a b. a -> Spanned p b -> Spanned p a
fmap :: forall a b. (a -> b) -> Spanned p a -> Spanned p b
$cfmap :: forall p a b. (a -> b) -> Spanned p a -> Spanned p b
Functor, forall a. Spanned p a -> Bool
forall p a. Eq a => a -> Spanned p a -> Bool
forall p a. Num a => Spanned p a -> a
forall p a. Ord a => Spanned p a -> a
forall m a. Monoid m => (a -> m) -> Spanned p a -> m
forall p m. Monoid m => Spanned p m -> m
forall p a. Spanned p a -> Bool
forall p a. Spanned p a -> Int
forall p a. Spanned p a -> [a]
forall a b. (a -> b -> b) -> b -> Spanned p a -> b
forall p a. (a -> a -> a) -> Spanned p a -> a
forall p m a. Monoid m => (a -> m) -> Spanned p a -> m
forall p b a. (b -> a -> b) -> b -> Spanned p a -> b
forall p a b. (a -> b -> b) -> b -> Spanned p 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 => Spanned p a -> a
$cproduct :: forall p a. Num a => Spanned p a -> a
sum :: forall a. Num a => Spanned p a -> a
$csum :: forall p a. Num a => Spanned p a -> a
minimum :: forall a. Ord a => Spanned p a -> a
$cminimum :: forall p a. Ord a => Spanned p a -> a
maximum :: forall a. Ord a => Spanned p a -> a
$cmaximum :: forall p a. Ord a => Spanned p a -> a
elem :: forall a. Eq a => a -> Spanned p a -> Bool
$celem :: forall p a. Eq a => a -> Spanned p a -> Bool
length :: forall a. Spanned p a -> Int
$clength :: forall p a. Spanned p a -> Int
null :: forall a. Spanned p a -> Bool
$cnull :: forall p a. Spanned p a -> Bool
toList :: forall a. Spanned p a -> [a]
$ctoList :: forall p a. Spanned p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Spanned p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> Spanned p a -> a
foldr1 :: forall a. (a -> a -> a) -> Spanned p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> Spanned p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Spanned p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> Spanned p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Spanned p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> Spanned p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Spanned p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> Spanned p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Spanned p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> Spanned p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Spanned p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> Spanned p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Spanned p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> Spanned p a -> m
fold :: forall m. Monoid m => Spanned p m -> m
$cfold :: forall p m. Monoid m => Spanned p m -> m
Foldable, forall p. Functor (Spanned p)
forall p. Foldable (Spanned p)
forall p (m :: * -> *) a.
Monad m =>
Spanned p (m a) -> m (Spanned p a)
forall p (f :: * -> *) a.
Applicative f =>
Spanned p (f a) -> f (Spanned p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spanned p a -> m (Spanned p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spanned p a -> f (Spanned p 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) -> Spanned p a -> f (Spanned p b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Spanned p (m a) -> m (Spanned p a)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
Spanned p (m a) -> m (Spanned p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spanned p a -> m (Spanned p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spanned p a -> m (Spanned p b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Spanned p (f a) -> f (Spanned p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
Spanned p (f a) -> f (Spanned p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spanned p a -> f (Spanned p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spanned p a -> f (Spanned p b)
Traversable)

-- | A materialized sequence of 'Spanned' values
data LexedStream p a = LexedStream
  { forall p a. LexedStream p a -> Seq (Spanned p a)
lsTokens :: !(Seq (Spanned p a))
  , forall p a. LexedStream p a -> p
lsEndPos :: !p
  } deriving stock (LexedStream p a -> LexedStream p a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall p a.
(Eq p, Eq a) =>
LexedStream p a -> LexedStream p a -> Bool
/= :: LexedStream p a -> LexedStream p a -> Bool
$c/= :: forall p a.
(Eq p, Eq a) =>
LexedStream p a -> LexedStream p a -> Bool
== :: LexedStream p a -> LexedStream p a -> Bool
$c== :: forall p a.
(Eq p, Eq a) =>
LexedStream p a -> LexedStream p a -> Bool
Eq, Int -> LexedStream p a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p a. (Show p, Show a) => Int -> LexedStream p a -> ShowS
forall p a. (Show p, Show a) => [LexedStream p a] -> ShowS
forall p a. (Show p, Show a) => LexedStream p a -> String
showList :: [LexedStream p a] -> ShowS
$cshowList :: forall p a. (Show p, Show a) => [LexedStream p a] -> ShowS
show :: LexedStream p a -> String
$cshow :: forall p a. (Show p, Show a) => LexedStream p a -> String
showsPrec :: Int -> LexedStream p a -> ShowS
$cshowsPrec :: forall p a. (Show p, Show a) => Int -> LexedStream p a -> ShowS
Show, forall a b. a -> LexedStream p b -> LexedStream p a
forall a b. (a -> b) -> LexedStream p a -> LexedStream p b
forall p a b. a -> LexedStream p b -> LexedStream p a
forall p a b. (a -> b) -> LexedStream p a -> LexedStream p 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 -> LexedStream p b -> LexedStream p a
$c<$ :: forall p a b. a -> LexedStream p b -> LexedStream p a
fmap :: forall a b. (a -> b) -> LexedStream p a -> LexedStream p b
$cfmap :: forall p a b. (a -> b) -> LexedStream p a -> LexedStream p b
Functor, forall a. LexedStream p a -> Bool
forall p a. Eq a => a -> LexedStream p a -> Bool
forall p a. Num a => LexedStream p a -> a
forall p a. Ord a => LexedStream p a -> a
forall m a. Monoid m => (a -> m) -> LexedStream p a -> m
forall p m. Monoid m => LexedStream p m -> m
forall p a. LexedStream p a -> Bool
forall p a. LexedStream p a -> Int
forall p a. LexedStream p a -> [a]
forall a b. (a -> b -> b) -> b -> LexedStream p a -> b
forall p a. (a -> a -> a) -> LexedStream p a -> a
forall p m a. Monoid m => (a -> m) -> LexedStream p a -> m
forall p b a. (b -> a -> b) -> b -> LexedStream p a -> b
forall p a b. (a -> b -> b) -> b -> LexedStream p 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 => LexedStream p a -> a
$cproduct :: forall p a. Num a => LexedStream p a -> a
sum :: forall a. Num a => LexedStream p a -> a
$csum :: forall p a. Num a => LexedStream p a -> a
minimum :: forall a. Ord a => LexedStream p a -> a
$cminimum :: forall p a. Ord a => LexedStream p a -> a
maximum :: forall a. Ord a => LexedStream p a -> a
$cmaximum :: forall p a. Ord a => LexedStream p a -> a
elem :: forall a. Eq a => a -> LexedStream p a -> Bool
$celem :: forall p a. Eq a => a -> LexedStream p a -> Bool
length :: forall a. LexedStream p a -> Int
$clength :: forall p a. LexedStream p a -> Int
null :: forall a. LexedStream p a -> Bool
$cnull :: forall p a. LexedStream p a -> Bool
toList :: forall a. LexedStream p a -> [a]
$ctoList :: forall p a. LexedStream p a -> [a]
foldl1 :: forall a. (a -> a -> a) -> LexedStream p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> LexedStream p a -> a
foldr1 :: forall a. (a -> a -> a) -> LexedStream p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> LexedStream p a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> LexedStream p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> LexedStream p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LexedStream p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> LexedStream p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LexedStream p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> LexedStream p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LexedStream p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> LexedStream p a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> LexedStream p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> LexedStream p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LexedStream p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> LexedStream p a -> m
fold :: forall m. Monoid m => LexedStream p m -> m
$cfold :: forall p m. Monoid m => LexedStream p m -> m
Foldable, forall p. Functor (LexedStream p)
forall p. Foldable (LexedStream p)
forall p (m :: * -> *) a.
Monad m =>
LexedStream p (m a) -> m (LexedStream p a)
forall p (f :: * -> *) a.
Applicative f =>
LexedStream p (f a) -> f (LexedStream p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LexedStream p a -> m (LexedStream p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LexedStream p a -> f (LexedStream p 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) -> LexedStream p a -> f (LexedStream p b)
sequence :: forall (m :: * -> *) a.
Monad m =>
LexedStream p (m a) -> m (LexedStream p a)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
LexedStream p (m a) -> m (LexedStream p a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LexedStream p a -> m (LexedStream p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LexedStream p a -> m (LexedStream p b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
LexedStream p (f a) -> f (LexedStream p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
LexedStream p (f a) -> f (LexedStream p a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LexedStream p a -> f (LexedStream p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LexedStream p a -> f (LexedStream p b)
Traversable)

instance Stream (LexedStream p a) where
  type Token (LexedStream p a) = a
  type Chunk (LexedStream p a) = Seq a

  streamTake1 :: LexedStream p a -> Maybe (Token (LexedStream p a), LexedStream p a)
streamTake1 (LexedStream Seq (Spanned p a)
ss p
ep) =
    case Seq (Spanned p a)
ss of
      Seq (Spanned p a)
Empty -> forall a. Maybe a
Nothing
      Spanned Span p
_ a
a :<| Seq (Spanned p a)
tl -> forall a. a -> Maybe a
Just (a
a, forall p a. Seq (Spanned p a) -> p -> LexedStream p a
LexedStream Seq (Spanned p a)
tl p
ep)

  streamTakeN :: Int
-> LexedStream p a
-> Maybe (Chunk (LexedStream p a), LexedStream p a)
streamTakeN Int
n s :: LexedStream p a
s@(LexedStream Seq (Spanned p a)
ss p
ep)
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall a. a -> Maybe a
Just (forall a. Seq a
Seq.empty, LexedStream p a
s)
    | forall a. Seq a -> Bool
Seq.null Seq (Spanned p a)
ss = forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (Seq (Spanned p a)
out, Seq (Spanned p a)
rest) = forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq (Spanned p a)
ss
        in forall a. a -> Maybe a
Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall p a. Spanned p a -> a
spannedValue Seq (Spanned p a)
out, forall p a. Seq (Spanned p a) -> p -> LexedStream p a
LexedStream Seq (Spanned p a)
rest p
ep)

  streamTakeWhile :: (Token (LexedStream p a) -> Bool)
-> LexedStream p a -> (Chunk (LexedStream p a), LexedStream p a)
streamTakeWhile Token (LexedStream p a) -> Bool
f (LexedStream Seq (Spanned p a)
ss p
ep) =
    let (Seq (Spanned p a)
out, Seq (Spanned p a)
rest) = forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl (Token (LexedStream p a) -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p a. Spanned p a -> a
spannedValue) Seq (Spanned p a)
ss
    in (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall p a. Spanned p a -> a
spannedValue Seq (Spanned p a)
out, forall p a. Seq (Spanned p a) -> p -> LexedStream p a
LexedStream Seq (Spanned p a)
rest p
ep)

  -- TODO(ejconlon) Specialize drops

-- | Position in a 'LexedStream'
data LexedSpan p =
    LexedSpanElem !(Span p)
  | LexedSpanEnd !p
  deriving stock (LexedSpan p -> LexedSpan p -> Bool
forall p. Eq p => LexedSpan p -> LexedSpan p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LexedSpan p -> LexedSpan p -> Bool
$c/= :: forall p. Eq p => LexedSpan p -> LexedSpan p -> Bool
== :: LexedSpan p -> LexedSpan p -> Bool
$c== :: forall p. Eq p => LexedSpan p -> LexedSpan p -> Bool
Eq, Int -> LexedSpan p -> ShowS
forall p. Show p => Int -> LexedSpan p -> ShowS
forall p. Show p => [LexedSpan p] -> ShowS
forall p. Show p => LexedSpan p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LexedSpan p] -> ShowS
$cshowList :: forall p. Show p => [LexedSpan p] -> ShowS
show :: LexedSpan p -> String
$cshow :: forall p. Show p => LexedSpan p -> String
showsPrec :: Int -> LexedSpan p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> LexedSpan p -> ShowS
Show)

instance HasLinePos p => HasLinePos (LexedSpan p) where
  viewLine :: LexedSpan p -> Line
viewLine = \case
    LexedSpanElem Span p
sp -> forall p. HasLinePos p => p -> Line
viewLine (forall p. Span p -> p
spanStart Span p
sp)
    LexedSpanEnd p
p -> forall p. HasLinePos p => p -> Line
viewLine p
p
  viewCol :: LexedSpan p -> Col
viewCol = \case
    LexedSpanElem Span p
sp -> forall p. HasLinePos p => p -> Col
viewCol (forall p. Span p -> p
spanStart Span p
sp)
    LexedSpanEnd p
p -> forall p. HasLinePos p => p -> Col
viewCol p
p

instance PosStream (LexedStream p a) where
  type Pos (LexedStream p a) = LexedSpan p

  streamViewPos :: LexedStream p a -> Pos (LexedStream p a)
streamViewPos (LexedStream Seq (Spanned p a)
ss p
ep) =
    case Seq (Spanned p a)
ss of
      Seq (Spanned p a)
Empty -> forall p. p -> LexedSpan p
LexedSpanEnd p
ep
      Spanned Span p
sp a
_ :<| Seq (Spanned p a)
_ -> forall p. Span p -> LexedSpan p
LexedSpanElem Span p
sp

-- | Annotates parse result with a span
spannedParser :: (PosStream s, Monad m) => ParserT l s e m a -> ParserT l s e m (Spanned (Pos s) a)
spannedParser :: forall s (m :: * -> *) l e a.
(PosStream s, Monad m) =>
ParserT l s e m a -> ParserT l s e m (Spanned (Pos s) a)
spannedParser ParserT l s e m a
p = do
  Pos s
p1 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s. PosStream s => s -> Pos s
streamViewPos
  a
a <- ParserT l s e m a
p
  Pos s
p2 <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s. PosStream s => s -> Pos s
streamViewPos
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall p a. Span p -> a -> Spanned p a
Spanned (forall p. p -> p -> Span p
Span Pos s
p1 Pos s
p2) a
a)

-- | Given a parser for a single token, repeatedly apply it and annotate results with spans
lexedParser :: (PosStream s, Monad m) => ParserT l s e m a -> ParserT l s e m (LexedStream (Pos s) a)
lexedParser :: forall s (m :: * -> *) l e a.
(PosStream s, Monad m) =>
ParserT l s e m a -> ParserT l s e m (LexedStream (Pos s) a)
lexedParser ParserT l s e m a
p = forall p a. Seq (Spanned p a) -> p -> LexedStream p a
LexedStream forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall seq elem (m :: * -> *) l s e.
(Chunked seq elem, Monad m) =>
ParserT l s e m elem -> ParserT l s e m seq
greedyStarParser (forall s (m :: * -> *) l e a.
(PosStream s, Monad m) =>
ParserT l s e m a -> ParserT l s e m (Spanned (Pos s) a)
spannedParser ParserT l s e m a
p) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s. PosStream s => s -> Pos s
streamViewPos

-- | Similar to 'runParserEnd' - first lexes the entire stream, applies the given cleanup function,
-- then runs the second parser over the results
runParserLexed :: (
  Typeable l1, Typeable e1, Typeable s, Typeable (Token s), Typeable (Chunk s),
  Show l1, Show e1, Show s, Show (Token s), Show (Chunk s),
  Typeable l2, Typeable e2, Typeable (Pos s), Typeable a,
  Show l2, Show e2, Show (Pos s), Show a,
  PosStream s, MonadThrow m) => Parser l1 s e1 a -> (LexedStream (Pos s) a -> LexedStream (Pos s) a) -> Parser l2 (LexedStream (Pos s) a) e2 b -> s -> m b
runParserLexed :: forall l1 e1 s l2 e2 a (m :: * -> *) b.
(Typeable l1, Typeable e1, Typeable s, Typeable (Token s),
 Typeable (Chunk s), Show l1, Show e1, Show s, Show (Token s),
 Show (Chunk s), Typeable l2, Typeable e2, Typeable (Pos s),
 Typeable a, Show l2, Show e2, Show (Pos s), Show a, PosStream s,
 MonadThrow m) =>
Parser l1 s e1 a
-> (LexedStream (Pos s) a -> LexedStream (Pos s) a)
-> Parser l2 (LexedStream (Pos s) a) e2 b
-> s
-> m b
runParserLexed Parser l1 s e1 a
lp LexedStream (Pos s) a -> LexedStream (Pos s) a
f Parser l2 (LexedStream (Pos s) a) e2 b
p s
s = do
  LexedStream (Pos s) a
ls <- forall l s e (m :: * -> *) a.
(Typeable l, Typeable s, Typeable e, Typeable (Token s),
 Typeable (Chunk s), Show l, Show s, Show e, Show (Token s),
 Show (Chunk s), Stream s, MonadThrow m) =>
Parser l s e a -> s -> m a
runParserEnd (forall s (m :: * -> *) l e a.
(PosStream s, Monad m) =>
ParserT l s e m a -> ParserT l s e m (LexedStream (Pos s) a)
lexedParser Parser l1 s e1 a
lp) s
s
  forall l s e (m :: * -> *) a.
(Typeable l, Typeable s, Typeable e, Typeable (Token s),
 Typeable (Chunk s), Show l, Show s, Show e, Show (Token s),
 Show (Chunk s), Stream s, MonadThrow m) =>
Parser l s e a -> s -> m a
runParserEnd Parser l2 (LexedStream (Pos s) a) e2 b
p (LexedStream (Pos s) a -> LexedStream (Pos s) a
f LexedStream (Pos s) a
ls)

-- | Similar to 'parseInteractive'
lexedParseInteractive :: (
  s ~ LinePosStream Text, TextBuildable a,
  ExplainLabel l1, ExplainError e1, ExplainLabel l2, ExplainError e2) =>
  Parser l1 s e1 a -> (LexedStream (Pos s) a -> LexedStream (Pos s) a) -> Parser l2 (LexedStream (Pos s) a) e2 b -> String -> IO (Maybe b)
lexedParseInteractive :: forall s a l1 e1 l2 e2 b.
(s ~ LinePosStream Text, TextBuildable a, ExplainLabel l1,
 ExplainError e1, ExplainLabel l2, ExplainError e2) =>
Parser l1 s e1 a
-> (LexedStream (Pos s) a -> LexedStream (Pos s) a)
-> Parser l2 (LexedStream (Pos s) a) e2 b
-> String
-> IO (Maybe b)
lexedParseInteractive Parser l1 s e1 a
lp LexedStream (Pos s) a -> LexedStream (Pos s) a
f Parser l2 (LexedStream (Pos s) a) e2 b
p String
input = do
  let lexRes :: Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
lexRes = forall l s e a. Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser (forall s (m :: * -> *) l e a.
(PosStream s, Monad m) =>
ParserT l s e m a -> ParserT l s e m (LexedStream (Pos s) a)
lexedParser Parser l1 s e1 a
lp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m ()
matchEnd) (forall s. s -> LinePosStream s
newLinePosStream (String -> Text
T.pack String
input))
  String -> IO ()
putStrLn String
"Lex result:"
  forall l s e a.
LinePosExplainable l s e =>
ErrorStyle -> String -> Maybe (ParseResult l s e a) -> IO ()
renderInteractive ErrorStyle
ErrorStyleErrata String
input Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
lexRes
  case Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
lexRes of
    Just (ParseResultSuccess (ParseSuccess s
_ LexedStream LinePos a
ls)) -> do
      let parseRes :: Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
parseRes = forall l s e a. Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser (Parser l2 (LexedStream (Pos s) a) e2 b
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m ()
matchEnd) (LexedStream (Pos s) a -> LexedStream (Pos s) a
f LexedStream LinePos a
ls)
      String -> IO ()
putStrLn String
"Parse result:"
      forall l s e a.
LinePosExplainable l s e =>
ErrorStyle -> String -> Maybe (ParseResult l s e a) -> IO ()
renderInteractive ErrorStyle
ErrorStyleErrata String
input Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
parseRes
      let res :: Maybe b
res = case Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
parseRes of { Just (ParseResultSuccess (ParseSuccess LexedStream LinePos a
_ b
b)) -> forall a. a -> Maybe a
Just b
b; Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
_ -> forall a. Maybe a
Nothing }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
res
    Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing