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

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

newtype LexedChunk a = LexedChunk { LexedChunk a -> Seq a
unLexedChunk :: Seq a }
  deriving stock (Int -> LexedChunk a -> ShowS
[LexedChunk a] -> ShowS
LexedChunk a -> String
(Int -> LexedChunk a -> ShowS)
-> (LexedChunk a -> String)
-> ([LexedChunk a] -> ShowS)
-> Show (LexedChunk a)
forall a. Show a => Int -> LexedChunk a -> ShowS
forall a. Show a => [LexedChunk a] -> ShowS
forall a. Show a => LexedChunk a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LexedChunk a] -> ShowS
$cshowList :: forall a. Show a => [LexedChunk a] -> ShowS
show :: LexedChunk a -> String
$cshow :: forall a. Show a => LexedChunk a -> String
showsPrec :: Int -> LexedChunk a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LexedChunk a -> ShowS
Show)
  deriving newtype (LexedChunk a -> LexedChunk a -> Bool
(LexedChunk a -> LexedChunk a -> Bool)
-> (LexedChunk a -> LexedChunk a -> Bool) -> Eq (LexedChunk a)
forall a. Eq a => LexedChunk a -> LexedChunk a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LexedChunk a -> LexedChunk a -> Bool
$c/= :: forall a. Eq a => LexedChunk a -> LexedChunk a -> Bool
== :: LexedChunk a -> LexedChunk a -> Bool
$c== :: forall a. Eq a => LexedChunk a -> LexedChunk a -> Bool
Eq)

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 -> Maybe (Token (LexedStream p a), LexedStream p a)
forall a. Maybe a
Nothing
      Spanned Span p
_ a
a :<| Seq (Spanned p a)
tl -> (a, LexedStream p a) -> Maybe (a, LexedStream p a)
forall a. a -> Maybe a
Just (a
a, Seq (Spanned p a) -> p -> LexedStream p 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Seq a, LexedStream p a) -> Maybe (Seq a, LexedStream p a)
forall a. a -> Maybe a
Just (Seq a
forall a. Seq a
Seq.empty, LexedStream p a
s)
    | Seq (Spanned p a) -> Bool
forall a. Seq a -> Bool
Seq.null Seq (Spanned p a)
ss = Maybe (Chunk (LexedStream p a), LexedStream p a)
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let (Seq (Spanned p a)
out, Seq (Spanned p a)
rest) = Int -> Seq (Spanned p a) -> (Seq (Spanned p a), Seq (Spanned p a))
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt Int
n Seq (Spanned p a)
ss
        in (Seq a, LexedStream p a) -> Maybe (Seq a, LexedStream p a)
forall a. a -> Maybe a
Just ((Spanned p a -> a) -> Seq (Spanned p a) -> Seq a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Spanned p a -> a
forall p a. Spanned p a -> a
spannedValue Seq (Spanned p a)
out, Seq (Spanned p a) -> p -> LexedStream p a
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) = (Spanned p a -> Bool)
-> Seq (Spanned p a) -> (Seq (Spanned p a), Seq (Spanned p a))
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.spanl (a -> Bool
Token (LexedStream p a) -> Bool
f (a -> Bool) -> (Spanned p a -> a) -> Spanned p a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spanned p a -> a
forall p a. Spanned p a -> a
spannedValue) Seq (Spanned p a)
ss
    in ((Spanned p a -> a) -> Seq (Spanned p a) -> Seq a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Spanned p a -> a
forall p a. Spanned p a -> a
spannedValue Seq (Spanned p a)
out, Seq (Spanned p a) -> p -> LexedStream p a
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
(LexedSpan p -> LexedSpan p -> Bool)
-> (LexedSpan p -> LexedSpan p -> Bool) -> Eq (LexedSpan p)
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
[LexedSpan p] -> ShowS
LexedSpan p -> String
(Int -> LexedSpan p -> ShowS)
-> (LexedSpan p -> String)
-> ([LexedSpan p] -> ShowS)
-> Show (LexedSpan p)
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 -> p -> Line
forall p. HasLinePos p => p -> Line
viewLine (Span p -> p
forall p. Span p -> p
spanStart Span p
sp)
    LexedSpanEnd p
p -> p -> Line
forall p. HasLinePos p => p -> Line
viewLine p
p
  viewCol :: LexedSpan p -> Col
viewCol = \case
    LexedSpanElem Span p
sp -> p -> Col
forall p. HasLinePos p => p -> Col
viewCol (Span p -> p
forall p. Span p -> p
spanStart Span p
sp)
    LexedSpanEnd p
p -> p -> Col
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 -> p -> LexedSpan p
forall p. p -> LexedSpan p
LexedSpanEnd p
ep
      Spanned Span p
sp a
_ :<| Seq (Spanned p a)
_ -> Span p -> LexedSpan p
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 :: 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 <- (s -> Pos s) -> ParserT l s e m (Pos s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets s -> Pos s
forall s. PosStream s => s -> Pos s
streamViewPos
  a
a <- ParserT l s e m a
p
  Pos s
p2 <- (s -> Pos s) -> ParserT l s e m (Pos s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets s -> Pos s
forall s. PosStream s => s -> Pos s
streamViewPos
  Spanned (Pos s) a -> ParserT l s e m (Spanned (Pos s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Span (Pos s) -> a -> Spanned (Pos s) a
forall p a. Span p -> a -> Spanned p a
Spanned (Pos s -> Pos s -> Span (Pos s)
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 :: ParserT l s e m a -> ParserT l s e m (LexedStream (Pos s) a)
lexedParser ParserT l s e m a
p = Seq (Spanned (Pos s) a) -> Pos s -> LexedStream (Pos s) a
forall p a. Seq (Spanned p a) -> p -> LexedStream p a
LexedStream (Seq (Spanned (Pos s) a) -> Pos s -> LexedStream (Pos s) a)
-> ParserT l s e m (Seq (Spanned (Pos s) a))
-> ParserT l s e m (Pos s -> LexedStream (Pos s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT l s e m (Spanned (Pos s) a)
-> ParserT l s e m (Seq (Spanned (Pos s) a))
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 (ParserT l s e m a -> ParserT l s e m (Spanned (Pos s) a)
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) ParserT l s e m (Pos s -> LexedStream (Pos s) a)
-> ParserT l s e m (Pos s)
-> ParserT l s e m (LexedStream (Pos s) a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s -> Pos s) -> ParserT l s e m (Pos s)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets s -> Pos s
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 :: 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 <- Parser l1 s e1 (LexedStream (Pos s) a)
-> s -> m (LexedStream (Pos s) a)
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 l1 s e1 a -> Parser l1 s e1 (LexedStream (Pos s) a)
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
  Parser l2 (LexedStream (Pos s) a) e2 b
-> LexedStream (Pos s) a -> m b
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 :: 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
  -- TODO renderInteractive TWICE
  let lexRes :: Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
lexRes = Parser l1 s e1 (LexedStream LinePos a)
-> s -> Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
forall l s e a. Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser (Parser l1 s e1 a
-> ParserT l1 s e1 Identity (LexedStream (Pos s) a)
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 Parser l1 s e1 (LexedStream LinePos a)
-> ParserT l1 s e1 Identity ()
-> Parser l1 s e1 (LexedStream LinePos a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT l1 s e1 Identity ()
forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m ()
matchEnd) (Text -> LinePosStream Text
forall s. s -> LinePosStream s
newLinePosStream (String -> Text
T.pack String
input))
  String -> IO ()
putStrLn String
"Lex result:"
  ErrorStyle
-> String
-> Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
-> IO ()
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 = Parser l2 (LexedStream LinePos a) e2 b
-> LexedStream LinePos a
-> Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
forall l s e a. Parser l s e a -> s -> Maybe (ParseResult l s e a)
runParser (Parser l2 (LexedStream LinePos a) e2 b
Parser l2 (LexedStream (Pos s) a) e2 b
p Parser l2 (LexedStream LinePos a) e2 b
-> ParserT l2 (LexedStream LinePos a) e2 Identity ()
-> Parser l2 (LexedStream LinePos a) e2 b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParserT l2 (LexedStream LinePos a) e2 Identity ()
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
LexedStream (Pos s) a
ls)
      String -> IO ()
putStrLn String
"Parse result:"
      ErrorStyle
-> String
-> Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
-> IO ()
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)) -> b -> Maybe b
forall a. a -> Maybe a
Just b
b; Maybe (ParseResult l2 (LexedStream LinePos a) e2 b)
_ -> Maybe b
forall a. Maybe a
Nothing }
      Maybe b -> IO (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
res
    Maybe (ParseResult l1 s e1 (LexedStream LinePos a))
_ -> Maybe b -> IO (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing