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

import Control.Monad.Catch (MonadThrow)
import Control.Monad.State.Strict (gets)
import Data.Sequence (Seq (..))
import qualified Data.Sequence as Seq
import Data.Typeable (Typeable)
import SimpleParser.Parser (Parser, ParserT, greedyStarParser)
import SimpleParser.Stream (PosStream (..), Span (Span), Stream (..))
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
newtype LexedStream p a = LexedStream { LexedStream p a -> Seq (Spanned p a)
unLexedStream :: Seq (Spanned p a) }
  deriving stock (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)
  deriving newtype (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)

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) =
    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) -> LexedStream p a
forall p a. Seq (Spanned p a) -> LexedStream p a
LexedStream Seq (Spanned p a)
tl)

  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)
    | 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) -> LexedStream p a
forall p a. Seq (Spanned p a) -> LexedStream p a
LexedStream Seq (Spanned p a)
rest)

  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) =
    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) -> LexedStream p a
forall p a. Seq (Spanned p a) -> LexedStream p a
LexedStream Seq (Spanned p a)
rest)

  -- TODO(ejconlon) Specialize drops

-- | Position in a 'LexedStream'
data LexedSpan p =
    LexedSpanNext !(Span p)
  | LexedSpanEnd
  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 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) =
    case Seq (Spanned p a)
ss of
      Seq (Spanned p a)
Empty -> Pos (LexedStream p a)
forall p. LexedSpan p
LexedSpanEnd
      Spanned Span p
sp a
_ :<| Seq (Spanned p a)
_ -> Span p -> LexedSpan p
forall p. Span p -> LexedSpan p
LexedSpanNext 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) -> LexedStream (Pos s) a)
-> ParserT l s e m (Seq (Spanned (Pos s) a))
-> ParserT l s e m (LexedStream (Pos s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq (Spanned (Pos s) a) -> LexedStream (Pos s) a
forall p a. Seq (Spanned p a) -> LexedStream p a
LexedStream (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))

-- | Similar to 'runParserEnd' - first lexes the entire stream 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 -> Parser l2 (LexedStream (Pos s) a) e2 b -> s -> m b
runParserLexed :: Parser l1 s e1 a
-> Parser l2 (LexedStream (Pos s) a) e2 b -> s -> m b
runParserLexed Parser l1 s e1 a
lp 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
ls