-- | Useful combinators for 'ParserT' and 'Stream'.
-- Classified as SAFE or UNSAFE. SAFE always return a value. UNSAFE throw.
module SimpleParser.Input
  ( withToken
  , withChunk
  , peekToken
  , popToken
  , peekChunk
  , popChunk
  , dropChunk
  , isEnd
  , matchEnd
  , anyToken
  , anyChunk
  , satisfyToken
  , foldTokensWhile
  , takeTokensWhile
  , takeTokensWhile1
  , dropTokensWhile
  , dropTokensWhile1
  , matchToken
  , matchChunk
  ) where

import Control.Monad.State (gets, state)
import Data.Bifunctor (first)
import Data.Maybe (isNothing)
import SimpleParser.Chunked (Chunked (..))
import SimpleParser.Parser (ParserT (..), markWithOptStateParser, markWithStateParser)
import SimpleParser.Result (CompoundError (..), ParseError (..), ParseErrorBundle (..), ParseResult (..), RawError (..),
                            StreamError (..))
import SimpleParser.Stack (emptyStack)
import SimpleParser.Stream (Stream (..))

throwStreamError :: Monad m => RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError :: forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError RawError (Chunk s) (Token s)
re = forall l s e (m :: * -> *) a.
(s -> m (Maybe (ParseResult l s e a))) -> ParserT l s e m a
ParserT (\s
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (forall l s e a. ParseErrorBundle l s e -> ParseResult l s e a
ParseResultError (forall l s e. NESeq (ParseError l s e) -> ParseErrorBundle l s e
ParseErrorBundle (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall l s e.
MarkStack l s -> s -> CompoundError s e -> ParseError l s e
ParseError forall a. Stack a
emptyStack s
s (forall s e. StreamError s -> CompoundError s e
CompoundErrorStream (forall s. RawError (Chunk s) (Token s) -> StreamError s
StreamError RawError (Chunk s) (Token s)
re))))))))

-- | Fetches the next token from the stream and runs the callback.
withToken :: (Stream s, Monad m) => Maybe l -> (Maybe (Token s) -> ParserT l s e m a) -> ParserT l s e m a
withToken :: forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> (Maybe (Token s) -> ParserT l s e m a) -> ParserT l s e m a
withToken Maybe l
ml = forall (m :: * -> *) l s b e a.
Monad m =>
Maybe l
-> (s -> Maybe (b, s))
-> (Maybe b -> ParserT l s e m a)
-> ParserT l s e m a
markWithOptStateParser Maybe l
ml forall s. Stream s => s -> Maybe (Token s, s)
streamTake1

-- | Fetches the next chunk from the stream and runs the callback.
withChunk :: (Stream s, Monad m) => Maybe l -> Int -> (Maybe (Chunk s) -> ParserT l s e m a) -> ParserT l s e m a
withChunk :: forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> Int
-> (Maybe (Chunk s) -> ParserT l s e m a)
-> ParserT l s e m a
withChunk Maybe l
ml Int
n = forall (m :: * -> *) l s b e a.
Monad m =>
Maybe l
-> (s -> Maybe (b, s))
-> (Maybe b -> ParserT l s e m a)
-> ParserT l s e m a
markWithOptStateParser Maybe l
ml (forall s. Stream s => Int -> s -> Maybe (Chunk s, s)
streamTakeN Int
n)

-- | Return the next token, if any, but don't consume it. (SAFE)
peekToken :: (Stream s, Monad m) => ParserT l s e m (Maybe (Token s))
peekToken :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
peekToken = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => s -> Maybe (Token s, s)
streamTake1)

-- | Return the next token, if any, and consume it. (SAFE)
popToken :: (Stream s, Monad m) => ParserT l s e m (Maybe (Token s))
popToken :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
popToken = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\s
stream -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Maybe a
Nothing, s
stream) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just) (forall s. Stream s => s -> Maybe (Token s, s)
streamTake1 s
stream))

-- | Return the next chunk of the given size, if any, but don't consume it.
-- May return a smaller chunk at end of stream, but never returns an empty chunk. (SAFE)
peekChunk :: (Stream s, Monad m) => Int -> ParserT l s e m (Maybe (Chunk s))
peekChunk :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Int -> ParserT l s e m (Maybe (Chunk s))
peekChunk Int
n = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => Int -> s -> Maybe (Chunk s, s)
streamTakeN Int
n)

-- | Return the next chunk of the given size, if any, and consume it.
-- May return a smaller chunk at end of stream, but never returns an empty chunk. (SAFE)
popChunk :: (Stream s, Monad m) => Int -> ParserT l s e m (Maybe (Chunk s))
popChunk :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Int -> ParserT l s e m (Maybe (Chunk s))
popChunk Int
n = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\s
stream -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Maybe a
Nothing, s
stream) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just) (forall s. Stream s => Int -> s -> Maybe (Chunk s, s)
streamTakeN Int
n s
stream))

-- | Drop the next chunk of the given size, if any, and consume it.
-- May return a smaller size at end of stream, but never returns size 0. (SAFE)
dropChunk :: (Stream s, Monad m) => Int -> ParserT l s e m (Maybe Int)
dropChunk :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Int -> ParserT l s e m (Maybe Int)
dropChunk Int
n = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state (\s
stream -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Maybe a
Nothing, s
stream) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just) (forall s. Stream s => Int -> s -> Maybe (Int, s)
streamDropN Int
n s
stream))

-- | Is this the end of the stream? (SAFE)
isEnd :: (Stream s, Monad m) => ParserT l s e m Bool
isEnd :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m Bool
isEnd = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> Bool
isNothing forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
peekToken

-- | Match the end of the stream or terminate the parser. (UNSAFE)
matchEnd :: (Stream s, Monad m) => ParserT l s e m ()
matchEnd :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m ()
matchEnd = forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> (Maybe (Token s) -> ParserT l s e m a) -> ParserT l s e m a
withToken forall a. Maybe a
Nothing (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall chunk token. token -> RawError chunk token
RawErrorMatchEnd))

-- | Return the next token or terminate the parser at end of stream. (UNSAFE)
anyToken :: (Stream s, Monad m) => ParserT l s e m (Token s)
anyToken :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Token s)
anyToken = forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> (Maybe (Token s) -> ParserT l s e m a) -> ParserT l s e m a
withToken forall a. Maybe a
Nothing (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError forall chunk token. RawError chunk token
RawErrorAnyToken) forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | Return the next chunk of the given size or terminate the parser at end of stream.
-- May return a smaller chunk at end of stream, but never returns an empty chunk. (UNSAFE)
anyChunk :: (Stream s, Monad m) => Int -> ParserT l s e m (Chunk s)
anyChunk :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Int -> ParserT l s e m (Chunk s)
anyChunk Int
n = forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> Int
-> (Maybe (Chunk s) -> ParserT l s e m a)
-> ParserT l s e m a
withChunk forall a. Maybe a
Nothing Int
n (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError forall chunk token. RawError chunk token
RawErrorAnyChunk) forall (f :: * -> *) a. Applicative f => a -> f a
pure)

-- | Match the next token with the given predicate or terminate the parser at predicate false or end of stream. (UNSAFE)
satisfyToken :: (Stream s, Monad m) => Maybe l -> (Token s -> Bool) -> ParserT l s e m (Token s)
satisfyToken :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m (Token s)
satisfyToken Maybe l
ml Token s -> Bool
pcate = forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> (Maybe (Token s) -> ParserT l s e m a) -> ParserT l s e m a
withToken Maybe l
ml forall a b. (a -> b) -> a -> b
$ \Maybe (Token s)
mu ->
  case Maybe (Token s)
mu of
    Just Token s
u | Token s -> Bool
pcate Token s
u -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Token s
u
    Maybe (Token s)
_ -> forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError (forall chunk token. Maybe token -> RawError chunk token
RawErrorSatisfyToken Maybe (Token s)
mu)

-- | Folds over a stream of tokens while the boolean value is true.
-- Always succeeds, even at end of stream. Only consumes greediest match. (SAFE)
foldTokensWhile :: (Stream s, Monad m) => (Token s -> x -> (Bool, x)) -> x -> ParserT l s e m x
foldTokensWhile :: forall s (m :: * -> *) x l e.
(Stream s, Monad m) =>
(Token s -> x -> (Bool, x)) -> x -> ParserT l s e m x
foldTokensWhile Token s -> x -> (Bool, x)
processNext = x -> ParserT l s e m x
go where
  go :: x -> ParserT l s e m x
go !x
x = do
    Maybe (Token s)
m <- forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
peekToken
    case Maybe (Token s)
m of
      Maybe (Token s)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x
      Just Token s
c ->
        let (Bool
ok, x
newX) = Token s -> x -> (Bool, x)
processNext Token s
c x
x
        in if Bool
ok
          then forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
popToken forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> x -> ParserT l s e m x
go x
newX
          else forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x

-- | Take tokens into a chunk while they satisfy the given predicate.
-- Always succeeds, even at end of stream. May return an empty chunk. Only yields greediest match. (SAFE)
takeTokensWhile :: (Stream s, Monad m) => (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
(Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => (Token s -> Bool) -> s -> (Chunk s, s)
streamTakeWhile

-- | Take tokens into a chunk while they satisfy the given predicate.
-- Only succeeds if 1 or more tokens are taken, so it never returns an empty chunk.
-- Also takes an optional label to describe the predicate. (UNSAFE)
takeTokensWhile1 :: (Stream s, Monad m) => Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile1 :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m (Chunk s)
takeTokensWhile1 Maybe l
ml Token s -> Bool
pcate = forall (m :: * -> *) l s b e a.
Monad m =>
Maybe l
-> (s -> (b, s)) -> (b -> ParserT l s e m a) -> ParserT l s e m a
markWithStateParser Maybe l
ml (forall s. Stream s => (Token s -> Bool) -> s -> (Chunk s, s)
streamTakeWhile Token s -> Bool
pcate) forall a b. (a -> b) -> a -> b
$ \Chunk s
j ->
  if forall chunk token. Chunked chunk token => chunk -> Bool
chunkEmpty Chunk s
j
    then do
      Maybe (Token s)
mu <- forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
peekToken
      forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError (forall chunk token. Maybe token -> RawError chunk token
RawErrorTakeTokensWhile1 Maybe (Token s)
mu)
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunk s
j

-- | Drop tokens and return chunk size while they satisfy the given predicate.
-- Always succeeds, even at end of stream. May return empty chunk size 0. Only drops greediest match. (SAFE)
dropTokensWhile :: (Stream s, Monad m) => (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
(Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. Stream s => (Token s -> Bool) -> s -> (Int, s)
streamDropWhile

-- | Drop tokens and return chunk size while they satisfy the given predicate.
-- Only succeeds if 1 or more tokens are dropped.
-- Also takes an optional label to describe the predicate. (UNSAFE)
dropTokensWhile1 :: (Stream s, Monad m) => Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile1 :: forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
Maybe l -> (Token s -> Bool) -> ParserT l s e m Int
dropTokensWhile1 Maybe l
ml Token s -> Bool
pcate = forall (m :: * -> *) l s b e a.
Monad m =>
Maybe l
-> (s -> (b, s)) -> (b -> ParserT l s e m a) -> ParserT l s e m a
markWithStateParser Maybe l
ml (forall s. Stream s => (Token s -> Bool) -> s -> (Int, s)
streamDropWhile Token s -> Bool
pcate) forall a b. (a -> b) -> a -> b
$ \Int
s ->
  if Int
s forall a. Eq a => a -> a -> Bool
== Int
0
    then do
      Maybe (Token s)
mu <- forall s (m :: * -> *) l e.
(Stream s, Monad m) =>
ParserT l s e m (Maybe (Token s))
peekToken
      forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError (forall chunk token. Maybe token -> RawError chunk token
RawErrorDropTokensWhile1 Maybe (Token s)
mu)
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
s

-- | Match token with equality or terminate the parser at inequality or end of stream. (UNSAFE)
matchToken :: (Stream s, Monad m, Eq (Token s)) => Token s -> ParserT l s e m (Token s)
matchToken :: forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Token s)) =>
Token s -> ParserT l s e m (Token s)
matchToken Token s
t = forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> (Maybe (Token s) -> ParserT l s e m a) -> ParserT l s e m a
withToken forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \Maybe (Token s)
mu ->
  case Maybe (Token s)
mu of
    Just Token s
u | Token s
t forall a. Eq a => a -> a -> Bool
== Token s
u -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Token s
u
    Maybe (Token s)
_ -> forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError (forall chunk token. token -> Maybe token -> RawError chunk token
RawErrorMatchToken Token s
t Maybe (Token s)
mu)

-- | Match chunk with equality or terminate the parser at inequality or end of stream. (UNSAFE)
matchChunk :: (Stream s, Monad m, Eq (Chunk s)) => Chunk s -> ParserT l s e m (Chunk s)
matchChunk :: forall s (m :: * -> *) l e.
(Stream s, Monad m, Eq (Chunk s)) =>
Chunk s -> ParserT l s e m (Chunk s)
matchChunk Chunk s
k = forall s (m :: * -> *) l e a.
(Stream s, Monad m) =>
Maybe l
-> Int
-> (Maybe (Chunk s) -> ParserT l s e m a)
-> ParserT l s e m a
withChunk forall a. Maybe a
Nothing (forall chunk token. Chunked chunk token => chunk -> Int
chunkLength Chunk s
k) forall a b. (a -> b) -> a -> b
$ \Maybe (Chunk s)
mj ->
  case Maybe (Chunk s)
mj of
    Just Chunk s
j | Chunk s
k forall a. Eq a => a -> a -> Bool
== Chunk s
j -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunk s
j
    Maybe (Chunk s)
_ -> forall (m :: * -> *) s l e a.
Monad m =>
RawError (Chunk s) (Token s) -> ParserT l s e m a
throwStreamError (forall chunk token. chunk -> Maybe chunk -> RawError chunk token
RawErrorMatchChunk Chunk s
k Maybe (Chunk s)
mj)