{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Unified parser over @Body (,) f (K m)@, with the stream @f@ as ambient
-- state.
--
-- The stream @f@ is carried as the explicit thread state; the parser takes no
-- positional input (unit direction) and produces a @These a f@ output: a
-- result ('This'), a failure returning the stream ('That'), or a partial
-- result plus remainder ('These').
--
-- The base monad @m@ selects the parser family:
--
--   * @m = Identity@ — attoparsec-style pure parser
--   * @m = StateT s (ExceptT e n)@ — megaparsec-style state + errors
--
-- First-line libraries add 'Applicative', 'Alternative', 'Monad', and
-- 'MonadLogic' instances on top of this syntax.
--
-- === the intact-stream law
--
-- Every parser that fails returns 'That' carrying the /intact original/
-- stream. This is the invariant that makes '<|>' backtrack: the next
-- alternative receives the same stream the previous one started with. If a
-- composite parser consumes input before failing, its 'That' carries the
-- stream /at the point of failure/, so the next alternative will silently
-- start from a partially consumed position. 'try' repairs exactly that:
-- wrap a composite alternative when it may consume input and then fail.
--
-- === doctests
--
-- >>> runParserIdentity (char 'a') "abc"
-- These 'a' "bc"
--
-- >>> runParserIdentity (char 'x') "abc"
-- That "abc"
--
-- >>> runParserIdentity (string "ab") "abc"
-- These "ab" "c"
--
-- >>> runParserIdentity (string "ab") "ab"
-- These "ab" ""
--
-- >>> runParserIdentity (many (char 'a')) "aaab"
-- These "aaa" "b"
--
-- >>> runParserIdentity (char 'a' *> char 'b') "ab"
-- This 'b'
--
-- >>> runParserIdentity (char 'a' *> char 'b') "a"
-- That "a"
--
-- >>> runParserIdentity (endOfInput :: Parser Identity String Char ()) ""
-- These () ""
--
-- >>> runParserIdentity (endOfInput :: Parser Identity String Char ()) "a"
-- That "a"
module Circuit.Parser
  ( -- * Result type
    These (..),

    -- * Stream coalgebra
    Uncons (..),

    -- * Parser syntax
    Parser (..),

    -- * Running
    runParser,
    runParserIdentity,
    runParserMaybe,
    runParserError,

    -- * Result extraction
    asThese,
    asMaybe',
    asEither,

    -- * Primitives
    next,
    anyToken,
    satisfy,
    satisfyAscii,
    char,
    string,
    endOfInput,
    takeRest,
    skipWhile,

    -- * Choice
    empty,
    (<|>),

    -- * Repetition
    many,
    some,
    optional,
    skipMany,
    count,
    sepBy,
    sepBy1,
    chainr,

    -- * Capture
    capturedBS,
    bs,
    span,
    span1,

    -- * Inspection
    peek,

    -- * Backtracking
    try,

    -- * Post-filter
    filterP,

    -- * Continuation
    withOption,

    -- * Line endings
    lineEnd,
  )
where

import Circuit.Body (Body (..))
import Circuit.Category (K (..))
import Circuit.Parser.Stream (These (..), Uncons (..))
import Control.Applicative (Alternative (empty, (<|>)))
import Control.Monad (MonadPlus, void)
import Data.Bifunctor (first)
import Data.Bool (bool)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Char (isAscii)
import Data.Functor (($>))
import Data.Functor.Identity (Identity (..))
import Data.These (these)
import Prelude hiding (span)

-- $setup
-- >>> import Data.Functor.Identity (Identity)
-- >>> import Data.These (These (..))

-- | Parser syntax: a @Body (,) f (K m)@ morphism with the stream @f@
-- as ambient state, unit input, and @These a f@ output.
newtype Parser m f s a = Parser
  { forall {k} (m :: * -> *) f (s :: k) a.
Parser m f s a -> Body (,) f (K m) () (These a f)
unParser :: Body (,) f (K m) () (These a f)
  }

-- | The stream leftover after a parse result: the new thread state.
leftoverOf :: forall f s a. (Uncons f s) => These a f -> f
leftoverOf :: forall f s a. Uncons f s => These a f -> f
leftoverOf (This a
_) = forall f s. Uncons f s => f
nil @f @s
leftoverOf (That f
f) = f
f
leftoverOf (These a
_ f
f) = f
f

-- | Run a parser in the base monad, returning the raw 'These' result.
runParser :: forall m f s a. (Monad m) => Parser m f s a -> f -> m (These a f)
runParser :: forall {k} (m :: * -> *) f (s :: k) a.
Monad m =>
Parser m f s a -> f -> m (These a f)
runParser Parser m f s a
p f
f = (f, These a f) -> These a f
forall a b. (a, b) -> b
snd ((f, These a f) -> These a f) -> m (f, These a f) -> m (These a f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism (Parser m f s a -> Body (,) f (K m) () (These a f)
forall {k} (m :: * -> *) f (s :: k) a.
Parser m f s a -> Body (,) f (K m) () (These a f)
unParser Parser m f s a
p)) (f
f, ())

-- | Run a pure parser.
runParserIdentity :: Parser Identity f s a -> f -> These a f
runParserIdentity :: forall {k} f (s :: k) a. Parser Identity f s a -> f -> These a f
runParserIdentity Parser Identity f s a
p = Identity (These a f) -> These a f
forall a. Identity a -> a
runIdentity (Identity (These a f) -> These a f)
-> (f -> Identity (These a f)) -> f -> These a f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Identity f s a -> f -> Identity (These a f)
forall {k} (m :: * -> *) f (s :: k) a.
Monad m =>
Parser m f s a -> f -> m (These a f)
runParser Parser Identity f s a
p

-- | Run a parser and convert the result to 'Maybe'.
runParserMaybe :: forall m f s a. (Monad m) => Parser m f s a -> f -> m (Maybe a)
runParserMaybe :: forall {k} (m :: * -> *) f (s :: k) a.
Monad m =>
Parser m f s a -> f -> m (Maybe a)
runParserMaybe Parser m f s a
p = (These a f -> Maybe a) -> m (These a f) -> m (Maybe a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These a f -> Maybe a
forall a f. These a f -> Maybe a
asMaybe' (m (These a f) -> m (Maybe a))
-> (f -> m (These a f)) -> f -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser m f s a -> f -> m (These a f)
forall {k} (m :: * -> *) f (s :: k) a.
Monad m =>
Parser m f s a -> f -> m (These a f)
runParser Parser m f s a
p

-- | Run a parser and extract the result, erroring on failure.
runParserError :: forall m f s a. (Monad m) => Parser m f s a -> f -> m a
runParserError :: forall {k} (m :: * -> *) f (s :: k) a.
Monad m =>
Parser m f s a -> f -> m a
runParserError Parser m f s a
p = (These a f -> a) -> m (These a f) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap These a f -> a
forall a f. These a f -> a
asThese (m (These a f) -> m a) -> (f -> m (These a f)) -> f -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser m f s a -> f -> m (These a f)
forall {k} (m :: * -> *) f (s :: k) a.
Monad m =>
Parser m f s a -> f -> m (These a f)
runParser Parser m f s a
p

-- | Extract value from a parse result, erroring on failure.
asThese :: These a f -> a
asThese :: forall a f. These a f -> a
asThese (This a
a) = a
a
asThese (These a
a f
_) = a
a
asThese (That f
_) = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"parse failed"

-- | Convert a parse result to 'Maybe'.
asMaybe' :: These a f -> Maybe a
asMaybe' :: forall a f. These a f -> Maybe a
asMaybe' (This a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
asMaybe' (These a
a f
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
asMaybe' (That f
_) = Maybe a
forall a. Maybe a
Nothing

-- | Convert a parse result to 'Either' (failure returns 'Left' with the leftover stream).
asEither :: These a f -> Either f a
asEither :: forall a f. These a f -> Either f a
asEither (This a
a) = a -> Either f a
forall a b. b -> Either a b
Right a
a
asEither (These a
a f
_) = a -> Either f a
forall a b. b -> Either a b
Right a
a
asEither (That f
f) = f -> Either f a
forall a b. a -> Either a b
Left f
f

-- | Consume and return the next element, or 'That' if the stream is empty.
next :: forall m f s. (Monad m, Uncons f s) => Parser m f s s
next :: forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s s
next = Body (,) f (K m) () (These s f) -> Parser m f s s
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These s f) -> Parser m f s s)
-> Body (,) f (K m) () (These s f) -> Parser m f s s
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f))
-> K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f))
-> ((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f)
forall a b. (a -> b) -> a -> b
$ \(f
f, ()) ->
  let r :: These s f
r = forall f s. Uncons f s => f -> These s f
uncons @f @s f
f
   in (f, These s f) -> m (f, These s f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These s f
r, These s f
r)

-- | Alias for 'next'.
anyToken :: forall m f s. (Monad m, Uncons f s) => Parser m f s s
anyToken :: forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s s
anyToken = Parser m f s s
forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s s
next

-- | Apply a predicate to the result of 'uncons'.
guardThese :: (Uncons f s) => (s -> Bool) -> f -> These s f -> These s f
guardThese :: forall f s.
Uncons f s =>
(s -> Bool) -> f -> These s f -> These s f
guardThese s -> Bool
p f
def =
  (s -> These s f)
-> (f -> These s f)
-> (s -> f -> These s f)
-> These s f
-> These s f
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these
    (\s
a -> These s f -> These s f -> Bool -> These s f
forall a. a -> a -> Bool -> a
bool (f -> These s f
forall a b. b -> These a b
That f
def) (s -> These s f
forall a b. a -> These a b
This s
a) (s -> Bool
p s
a))
    f -> These s f
forall a b. b -> These a b
That
    (\s
a f
b -> These s f -> These s f -> Bool -> These s f
forall a. a -> a -> Bool -> a
bool (f -> These s f
forall a b. b -> These a b
That f
def) (s -> f -> These s f
forall a b. a -> b -> These a b
These s
a f
b) (s -> Bool
p s
a))

-- | Consume one element if it satisfies the predicate.
satisfy :: forall m f s. (Monad m, Uncons f s) => (s -> Bool) -> Parser m f s s
satisfy :: forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy s -> Bool
p = Body (,) f (K m) () (These s f) -> Parser m f s s
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These s f) -> Parser m f s s)
-> Body (,) f (K m) () (These s f) -> Parser m f s s
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f))
-> K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f))
-> ((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f)
forall a b. (a -> b) -> a -> b
$ \(f
f, ()) ->
  let r :: These s f
r = (s -> Bool) -> f -> These s f -> These s f
forall f s.
Uncons f s =>
(s -> Bool) -> f -> These s f -> These s f
guardThese s -> Bool
p f
f (forall f s. Uncons f s => f -> These s f
uncons @f @s f
f)
   in (f, These s f) -> m (f, These s f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These s f
r, These s f
r)

-- | Apply a predicate to the value inside a 'These' result. On failure the
-- original stream is returned intact.
guardResult :: (a -> Bool) -> f -> These a f -> These a f
guardResult :: forall a f. (a -> Bool) -> f -> These a f -> These a f
guardResult a -> Bool
p f
def =
  (a -> These a f)
-> (f -> These a f)
-> (a -> f -> These a f)
-> These a f
-> These a f
forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these
    (\a
a -> These a f -> These a f -> Bool -> These a f
forall a. a -> a -> Bool -> a
bool (f -> These a f
forall a b. b -> These a b
That f
def) (a -> These a f
forall a b. a -> These a b
This a
a) (a -> Bool
p a
a))
    f -> These a f
forall a b. b -> These a b
That
    (\a
a f
b -> These a f -> These a f -> Bool -> These a f
forall a. a -> a -> Bool -> a
bool (f -> These a f
forall a b. b -> These a b
That f
def) (a -> f -> These a f
forall a b. a -> b -> These a b
These a
a f
b) (a -> Bool
p a
a))

-- | Keep only successes matching the predicate.
filterP :: forall m f s a. (Monad m, Uncons f s) => Parser m f s a -> (a -> Bool) -> Parser m f s a
filterP :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> (a -> Bool) -> Parser m f s a
filterP (Parser Body (,) f (K m) () (These a f)
p) a -> Bool
f = Body (,) f (K m) () (These a f) -> Parser m f s a
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These a f) -> Parser m f s a)
-> Body (,) f (K m) () (These a f) -> Parser m f s a
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f))
-> K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f))
-> ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) -> do
  (_, r) <- K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
p) (f
s, ())
  let r' = (a -> Bool) -> f -> These a f -> These a f
forall a f. (a -> Bool) -> f -> These a f -> These a f
guardResult a -> Bool
f f
s These a f
r
  pure (leftoverOf @f @s r', r')

-- | Match a specific element.
char :: forall m f s. (Monad m, Uncons f s, Eq s) => s -> Parser m f s s
char :: forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char s
c = (s -> Bool) -> Parser m f s s
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
c)

-- | Match a sequence of elements.
string :: forall m f s. (Monad m, Uncons f s, Eq s) => [s] -> Parser m f s [s]
string :: forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string = (s -> Parser m f s s) -> [s] -> Parser m f s [s]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse s -> Parser m f s s
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char

-- | Succeed only at the end of input.
endOfInput :: forall m f s. (Monad m, Uncons f s) => Parser m f s ()
endOfInput :: forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s ()
endOfInput = Body (,) f (K m) () (These () f) -> Parser m f s ()
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These () f) -> Parser m f s ())
-> Body (,) f (K m) () (These () f) -> Parser m f s ()
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These () f) -> Body (,) f (K m) () (These () f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These () f) -> Body (,) f (K m) () (These () f))
-> K m (f, ()) (f, These () f) -> Body (,) f (K m) () (These () f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These () f)) -> K m (f, ()) (f, These () f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These () f)) -> K m (f, ()) (f, These () f))
-> ((f, ()) -> m (f, These () f)) -> K m (f, ()) (f, These () f)
forall a b. (a -> b) -> a -> b
$ \(f
f, ()) ->
  let r :: These () f
r = case forall f s. Uncons f s => f -> These s f
uncons @f @s f
f of
        That f
_ -> () -> f -> These () f
forall a b. a -> b -> These a b
These () f
f
        These s f
_ -> f -> These () f
forall a b. b -> These a b
That f
f
   in (f, These () f) -> m (f, These () f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These () f
r, These () f
r)

instance (Monad m) => Functor (Parser m f s) where
  fmap :: forall a b. (a -> b) -> Parser m f s a -> Parser m f s b
fmap a -> b
g (Parser Body (,) f (K m) () (These a f)
p) = Body (,) f (K m) () (These b f) -> Parser m f s b
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These b f) -> Parser m f s b)
-> Body (,) f (K m) () (These b f) -> Parser m f s b
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f))
-> K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f))
-> ((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f)
forall a b. (a -> b) -> a -> b
$ \(f
f, ()) -> do
    (f', r) <- K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
p) (f
f, ())
    pure (f', first g r)

instance (Monad m, Uncons f s) => Applicative (Parser m f s) where
  pure :: forall a. a -> Parser m f s a
pure a
a = Body (,) f (K m) () (These a f) -> Parser m f s a
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These a f) -> Parser m f s a)
-> Body (,) f (K m) () (These a f) -> Parser m f s a
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f))
-> K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f))
-> ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall a b. (a -> b) -> a -> b
$ \(f
f, ()) -> (f, These a f) -> m (f, These a f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
f, a -> f -> These a f
forall a b. a -> b -> These a b
These a
a f
f)

  Parser Body (,) f (K m) () (These (a -> b) f)
pf <*> :: forall a b.
Parser m f s (a -> b) -> Parser m f s a -> Parser m f s b
<*> Parser Body (,) f (K m) () (These a f)
pa = Body (,) f (K m) () (These b f) -> Parser m f s b
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These b f) -> Parser m f s b)
-> Body (,) f (K m) () (These b f) -> Parser m f s b
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f))
-> K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f))
-> ((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) ->
    let app :: (a -> b) -> f -> m (f, These b f)
app a -> b
g f
s' = do
          (s2, r2) <- K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
pa) (f
s', ())
          case r2 of
            That f
_ -> (f, These b f) -> m (f, These b f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
s, f -> These b f
forall a b. b -> These a b
That f
s)
            These a f
_ -> (f, These b f) -> m (f, These b f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
s2, (a -> b) -> These a f -> These b f
forall a b c. (a -> b) -> These a c -> These b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
g These a f
r2)
     in do
          (_, r1) <- K m (f, ()) (f, These (a -> b) f)
-> (f, ()) -> m (f, These (a -> b) f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These (a -> b) f)
-> K m (f, ()) (f, These (a -> b) f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These (a -> b) f)
pf) (f
s, ())
          case r1 of
            That f
_ -> (f, These b f) -> m (f, These b f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
s, f -> These b f
forall a b. b -> These a b
That f
s)
            This a -> b
g -> (a -> b) -> f -> m (f, These b f)
app a -> b
g (forall f s. Uncons f s => f
nil @f @s)
            These a -> b
g f
s1' -> (a -> b) -> f -> m (f, These b f)
app a -> b
g f
s1'

instance (Monad m, Uncons f s) => Monad (Parser m f s) where
  Parser Body (,) f (K m) () (These a f)
m >>= :: forall a b.
Parser m f s a -> (a -> Parser m f s b) -> Parser m f s b
>>= a -> Parser m f s b
k = Body (,) f (K m) () (These b f) -> Parser m f s b
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These b f) -> Parser m f s b)
-> Body (,) f (K m) () (These b f) -> Parser m f s b
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f))
-> K m (f, ()) (f, These b f) -> Body (,) f (K m) () (These b f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f))
-> ((f, ()) -> m (f, These b f)) -> K m (f, ()) (f, These b f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) -> do
    (s1, r1) <- K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
m) (f
s, ())
    case r1 of
      That f
_ -> (f, These b f) -> m (f, These b f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
s1, f -> These b f
forall a b. b -> These a b
That f
s1)
      This a
a -> K m (f, ()) (f, These b f) -> (f, ()) -> m (f, These b f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These b f) -> K m (f, ()) (f, These b f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism (Parser m f s b -> Body (,) f (K m) () (These b f)
forall {k} (m :: * -> *) f (s :: k) a.
Parser m f s a -> Body (,) f (K m) () (These a f)
unParser (a -> Parser m f s b
k a
a))) (forall f s. Uncons f s => f
nil @f @s, ())
      These a
a f
s1' -> K m (f, ()) (f, These b f) -> (f, ()) -> m (f, These b f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These b f) -> K m (f, ()) (f, These b f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism (Parser m f s b -> Body (,) f (K m) () (These b f)
forall {k} (m :: * -> *) f (s :: k) a.
Parser m f s a -> Body (,) f (K m) () (These a f)
unParser (a -> Parser m f s b
k a
a))) (f
s1', ())

instance (Monad m, Uncons f s) => Alternative (Parser m f s) where
  empty :: forall a. Parser m f s a
empty = Body (,) f (K m) () (These a f) -> Parser m f s a
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These a f) -> Parser m f s a)
-> Body (,) f (K m) () (These a f) -> Parser m f s a
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f))
-> K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f))
-> ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall a b. (a -> b) -> a -> b
$ \(f
f, ()) -> (f, These a f) -> m (f, These a f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
f, f -> These a f
forall a b. b -> These a b
That f
f)

  Parser Body (,) f (K m) () (These a f)
p1 <|> :: forall a. Parser m f s a -> Parser m f s a -> Parser m f s a
<|> Parser Body (,) f (K m) () (These a f)
p2 = Body (,) f (K m) () (These a f) -> Parser m f s a
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These a f) -> Parser m f s a)
-> Body (,) f (K m) () (These a f) -> Parser m f s a
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f))
-> K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f))
-> ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) -> do
    (s1, r1) <- K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
p1) (f
s, ())
    case r1 of
      That f
_ -> K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
p2) (f
s1, ())
      These a f
_ -> (f, These a f) -> m (f, These a f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f
s1, These a f
r1)

instance (Monad m, Uncons f s) => MonadPlus (Parser m f s)

-- | Zero or more repetitions.
many :: forall m f s a. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s [a]
many :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many Parser m f s a
p = Parser m f s a -> Parser m f s [a]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
some Parser m f s a
p Parser m f s [a] -> Parser m f s [a] -> Parser m f s [a]
forall a. Parser m f s a -> Parser m f s a -> Parser m f s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser m f s [a]
forall a. a -> Parser m f s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | One or more repetitions.
some :: forall m f s a. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s [a]
some :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
some Parser m f s a
p = (:) (a -> [a] -> [a]) -> Parser m f s a -> Parser m f s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m f s a
p Parser m f s ([a] -> [a]) -> Parser m f s [a] -> Parser m f s [a]
forall a b.
Parser m f s (a -> b) -> Parser m f s a -> Parser m f s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser m f s a -> Parser m f s [a]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many Parser m f s a
p

-- | ASCII-only version of satisfy.
satisfyAscii :: forall m f. (Monad m, Uncons f Char) => (Char -> Bool) -> Parser m f Char Char
satisfyAscii :: forall (m :: * -> *) f.
(Monad m, Uncons f Char) =>
(Char -> Bool) -> Parser m f Char Char
satisfyAscii Char -> Bool
p = (Char -> Bool) -> Parser m f Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
p Char
c)

-- | Skip zero or more elements matching the predicate.
skipWhile :: forall m f s. (Monad m, Uncons f s) => (s -> Bool) -> Parser m f s ()
skipWhile :: forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile s -> Bool
p = Parser m f s [s] -> Parser m f s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser m f s s -> Parser m f s [s]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((s -> Bool) -> Parser m f s s
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy s -> Bool
p))

-- | Consume all remaining input as the value.
takeRest :: forall m f s. (Monad m, Uncons f s) => Parser m f s f
takeRest :: forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s f
takeRest = Body (,) f (K m) () (These f f) -> Parser m f s f
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These f f) -> Parser m f s f)
-> Body (,) f (K m) () (These f f) -> Parser m f s f
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These f f) -> Body (,) f (K m) () (These f f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These f f) -> Body (,) f (K m) () (These f f))
-> K m (f, ()) (f, These f f) -> Body (,) f (K m) () (These f f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These f f)) -> K m (f, ()) (f, These f f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These f f)) -> K m (f, ()) (f, These f f))
-> ((f, ()) -> m (f, These f f)) -> K m (f, ()) (f, These f f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) ->
  let r :: These f f
r = f -> f -> These f f
forall a b. a -> b -> These a b
These f
s (forall f s. Uncons f s => f
nil @f @s)
   in (f, These f f) -> m (f, These f f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These f f
r, These f f
r)

-- | Zero or one repetition.
optional :: forall m f s a. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s (Maybe a)
optional :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s (Maybe a)
optional Parser m f s a
p = (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser m f s a -> Parser m f s (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m f s a
p) Parser m f s (Maybe a)
-> Parser m f s (Maybe a) -> Parser m f s (Maybe a)
forall a. Parser m f s a -> Parser m f s a -> Parser m f s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a -> Parser m f s (Maybe a)
forall a. a -> Parser m f s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- | Skip zero or more repetitions.
skipMany :: forall m f s a. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s ()
skipMany :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s ()
skipMany Parser m f s a
p = Parser m f s [a] -> Parser m f s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser m f s a -> Parser m f s [a]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many Parser m f s a
p)

-- | Parse exactly @n@ occurrences of the given parser.
count :: forall m f s a. (Monad m, Uncons f s) => Int -> Parser m f s a -> Parser m f s [a]
count :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Int -> Parser m f s a -> Parser m f s [a]
count Int
n Parser m f s a
p
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a] -> Parser m f s [a]
forall a. a -> Parser m f s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise = (:) (a -> [a] -> [a]) -> Parser m f s a -> Parser m f s ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m f s a
p Parser m f s ([a] -> [a]) -> Parser m f s [a] -> Parser m f s [a]
forall a b.
Parser m f s (a -> b) -> Parser m f s a -> Parser m f s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Parser m f s a -> Parser m f s [a]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Int -> Parser m f s a -> Parser m f s [a]
count (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Parser m f s a
p

-- | Parse zero or more occurrences separated by a separator.
-- The separator is discarded.
sepBy :: forall m f s a b. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s b -> Parser m f s [a]
sepBy :: forall (m :: * -> *) f s a b.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s b -> Parser m f s [a]
sepBy Parser m f s a
p Parser m f s b
sep = Parser m f s a -> Parser m f s b -> Parser m f s [a]
forall (m :: * -> *) f s a b.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s b -> Parser m f s [a]
sepBy1 Parser m f s a
p Parser m f s b
sep Parser m f s [a] -> Parser m f s [a] -> Parser m f s [a]
forall a. Parser m f s a -> Parser m f s a -> Parser m f s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser m f s [a]
forall a. a -> Parser m f s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- | Parse one or more occurrences separated by a separator.
-- The separator is discarded. /Trailing separators are rejected/: after a
-- separator, the element parser must succeed. Use 'try' on the separator
-- yourself only if you genuinely want to allow trailing separators.
sepBy1 :: forall m f s a b. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s b -> Parser m f s [a]
sepBy1 :: forall (m :: * -> *) f s a b.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s b -> Parser m f s [a]
sepBy1 Parser m f s a
p Parser m f s b
sep = Parser m f s a
p Parser m f s a -> (a -> Parser m f s [a]) -> Parser m f s [a]
forall a b.
Parser m f s a -> (a -> Parser m f s b) -> Parser m f s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x -> Parser m f s a -> Parser m f s [a]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many (Parser m f s b
sep Parser m f s b -> Parser m f s a -> Parser m f s a
forall a b. Parser m f s a -> Parser m f s b -> Parser m f s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser m f s a
p) Parser m f s [a] -> ([a] -> Parser m f s [a]) -> Parser m f s [a]
forall a b.
Parser m f s a -> (a -> Parser m f s b) -> Parser m f s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
xs -> [a] -> Parser m f s [a]
forall a. a -> Parser m f s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)

-- | Right-fold chain combinator.
chainr :: forall m f s a b. (Monad m, Uncons f s) => (a -> b -> b) -> Parser m f s a -> Parser m f s b -> Parser m f s b
chainr :: forall (m :: * -> *) f s a b.
(Monad m, Uncons f s) =>
(a -> b -> b) -> Parser m f s a -> Parser m f s b -> Parser m f s b
chainr a -> b -> b
f Parser m f s a
p Parser m f s b
z = Parser m f s b
go
  where
    go :: Parser m f s b
go = (a -> b -> b
f (a -> b -> b) -> Parser m f s a -> Parser m f s (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m f s a
p Parser m f s (b -> b) -> Parser m f s b -> Parser m f s b
forall a b.
Parser m f s (a -> b) -> Parser m f s a -> Parser m f s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser m f s b
go) Parser m f s b -> Parser m f s b -> Parser m f s b
forall a. Parser m f s a -> Parser m f s a -> Parser m f s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m f s b
z

-- | Attempt a parser. If it fails with 'That', restore the original stream.
--
-- This matters for composite alternatives consumed by '<|>': a parser that
-- consumes input before failing would otherwise hand the next alternative a
-- partially-consumed stream. Wrap the composite in 'try' when that is
-- possible.
try :: forall m f s a. (Monad m, Uncons f s) => Parser m f s a -> Parser m f s a
try :: forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s a
try (Parser Body (,) f (K m) () (These a f)
p) = Body (,) f (K m) () (These a f) -> Parser m f s a
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These a f) -> Parser m f s a)
-> Body (,) f (K m) () (These a f) -> Parser m f s a
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f))
-> K m (f, ()) (f, These a f) -> Body (,) f (K m) () (These a f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f))
-> ((f, ()) -> m (f, These a f)) -> K m (f, ()) (f, These a f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) -> do
  (_, r) <- K m (f, ()) (f, These a f) -> (f, ()) -> m (f, These a f)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) f (K m) () (These a f) -> K m (f, ()) (f, These a f)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) f (K m) () (These a f)
p) (f
s, ())
  pure $ case r of
    That f
_ -> (f
s, f -> These a f
forall a b. b -> These a b
That f
s)
    These a f
result -> (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These a f
result, These a f
result)

-- | Try a parser with a fallback continuation.
withOption :: forall m f s a b. (Monad m, Uncons f s) => Parser m f s a -> (a -> Parser m f s b) -> Parser m f s b -> Parser m f s b
withOption :: forall (m :: * -> *) f s a b.
(Monad m, Uncons f s) =>
Parser m f s a
-> (a -> Parser m f s b) -> Parser m f s b -> Parser m f s b
withOption Parser m f s a
p a -> Parser m f s b
f Parser m f s b
def = (Parser m f s a
p Parser m f s a -> (a -> Parser m f s b) -> Parser m f s b
forall a b.
Parser m f s a -> (a -> Parser m f s b) -> Parser m f s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Parser m f s b
f) Parser m f s b -> Parser m f s b -> Parser m f s b
forall a. Parser m f s a -> Parser m f s a -> Parser m f s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser m f s b
def

-- | Match a newline character or succeed at end of input.
lineEnd :: forall m f. (Monad m, Uncons f Char) => Parser m f Char Char
lineEnd :: forall (m :: * -> *) f.
(Monad m, Uncons f Char) =>
Parser m f Char Char
lineEnd = Char -> Parser m f Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'\n' Parser m f Char Char
-> Parser m f Char Char -> Parser m f Char Char
forall a.
Parser m f Char a -> Parser m f Char a -> Parser m f Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser m f Char ()
forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s ()
endOfInput Parser m f Char () -> Char -> Parser m f Char Char
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char
' ')

-- | Capture the matched 'ByteString' prefix of a successful parse.
--
-- Flatparse-era specialty: measure consumed length via @B.length@ on the
-- remainder and 'B.take' a prefix of the original (cheap for strict
-- 'ByteString').
capturedBS :: forall m a. (Monad m) => Parser m ByteString Char a -> Parser m ByteString Char (ByteString, a)
capturedBS :: forall (m :: * -> *) a.
Monad m =>
Parser m ByteString Char a
-> Parser m ByteString Char (ByteString, a)
capturedBS (Parser Body (,) ByteString (K m) () (These a ByteString)
p) = Body (,) ByteString (K m) () (These (ByteString, a) ByteString)
-> Parser m ByteString Char (ByteString, a)
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) ByteString (K m) () (These (ByteString, a) ByteString)
 -> Parser m ByteString Char (ByteString, a))
-> Body (,) ByteString (K m) () (These (ByteString, a) ByteString)
-> Parser m ByteString Char (ByteString, a)
forall a b. (a -> b) -> a -> b
$ K m (ByteString, ()) (ByteString, These (ByteString, a) ByteString)
-> Body (,) ByteString (K m) () (These (ByteString, a) ByteString)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m
   (ByteString, ())
   (ByteString, These (ByteString, a) ByteString)
 -> Body (,) ByteString (K m) () (These (ByteString, a) ByteString))
-> K m
     (ByteString, ())
     (ByteString, These (ByteString, a) ByteString)
-> Body (,) ByteString (K m) () (These (ByteString, a) ByteString)
forall a b. (a -> b) -> a -> b
$ ((ByteString, ())
 -> m (ByteString, These (ByteString, a) ByteString))
-> K m
     (ByteString, ())
     (ByteString, These (ByteString, a) ByteString)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((ByteString, ())
  -> m (ByteString, These (ByteString, a) ByteString))
 -> K m
      (ByteString, ())
      (ByteString, These (ByteString, a) ByteString))
-> ((ByteString, ())
    -> m (ByteString, These (ByteString, a) ByteString))
-> K m
     (ByteString, ())
     (ByteString, These (ByteString, a) ByteString)
forall a b. (a -> b) -> a -> b
$ \(ByteString
s, ()) -> do
  (_, r) <- K m (ByteString, ()) (ByteString, These a ByteString)
-> (ByteString, ()) -> m (ByteString, These a ByteString)
forall {k} (m :: k -> *) a (b :: k). K m a b -> a -> m b
runK (Body (,) ByteString (K m) () (These a ByteString)
-> K m (ByteString, ()) (ByteString, These a ByteString)
forall {k1} {k2} {k3} (t :: k1 -> k2 -> k3) (ch :: k1)
       (arr :: k3 -> k3 -> *) (a :: k2) (b :: k2).
Body t ch arr a b -> arr (t ch a) (t ch b)
morphism Body (,) ByteString (K m) () (These a ByteString)
p) (ByteString
s, ())
  pure $ case r of
    That ByteString
_ -> (ByteString
s, ByteString -> These (ByteString, a) ByteString
forall a b. b -> These a b
That ByteString
s)
    This a
a -> (ByteString
B.empty, (ByteString, a) -> ByteString -> These (ByteString, a) ByteString
forall a b. a -> b -> These a b
These (ByteString
s, a
a) ByteString
B.empty)
    These a
a ByteString
s' -> (ByteString
s', (ByteString, a) -> ByteString -> These (ByteString, a) ByteString
forall a b. a -> b -> These a b
These (Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
s') ByteString
s, a
a) ByteString
s')

-- | Match a span and return it as a 'ByteString'.
bs :: forall m a. (Monad m) => Parser m ByteString Char a -> Parser m ByteString Char ByteString
bs :: forall (m :: * -> *) a.
Monad m =>
Parser m ByteString Char a -> Parser m ByteString Char ByteString
bs Parser m ByteString Char a
p = (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, a) -> ByteString)
-> Parser m ByteString Char (ByteString, a)
-> Parser m ByteString Char ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m ByteString Char a
-> Parser m ByteString Char (ByteString, a)
forall (m :: * -> *) a.
Monad m =>
Parser m ByteString Char a
-> Parser m ByteString Char (ByteString, a)
capturedBS Parser m ByteString Char a
p

-- | Capture a (possibly empty) span of elements satisfying the predicate.
-- The result is the list of captured elements; for zero-copy capture of a
-- 'ByteString' span, prefer 'bs' with 'skipWhile'.
span :: forall m f s. (Monad m, Uncons f s) => (s -> Bool) -> Parser m f s [s]
span :: forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s [s]
span s -> Bool
p = Body (,) f (K m) () (These [s] f) -> Parser m f s [s]
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These [s] f) -> Parser m f s [s])
-> Body (,) f (K m) () (These [s] f) -> Parser m f s [s]
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These [s] f) -> Body (,) f (K m) () (These [s] f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These [s] f) -> Body (,) f (K m) () (These [s] f))
-> K m (f, ()) (f, These [s] f)
-> Body (,) f (K m) () (These [s] f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These [s] f)) -> K m (f, ()) (f, These [s] f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These [s] f)) -> K m (f, ()) (f, These [s] f))
-> ((f, ()) -> m (f, These [s] f)) -> K m (f, ()) (f, These [s] f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) ->
  let r :: These [s] f
r = [s] -> f -> These [s] f
go [] f
s
   in (f, These [s] f) -> m (f, These [s] f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These [s] f
r, These [s] f
r)
  where
    go :: [s] -> f -> These [s] f
go [s]
acc f
s0 = case forall f s. Uncons f s => f -> These s f
uncons @f @s f
s0 of
      That f
_ -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse [s]
acc) f
s0
      This s
x
        | s -> Bool
p s
x -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse (s
x s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
acc)) (forall f s. Uncons f s => f
nil @f @s)
        | Bool
otherwise -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse [s]
acc) f
s0
      These s
x f
s'
        | s -> Bool
p s
x -> [s] -> f -> These [s] f
go (s
x s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
acc) f
s'
        | Bool
otherwise -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse [s]
acc) f
s0

-- | Capture a non-empty span of elements satisfying the predicate. Fails if
-- the next element does not satisfy the predicate.
span1 :: forall m f s. (Monad m, Uncons f s) => (s -> Bool) -> Parser m f s [s]
span1 :: forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s [s]
span1 s -> Bool
p = Body (,) f (K m) () (These [s] f) -> Parser m f s [s]
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These [s] f) -> Parser m f s [s])
-> Body (,) f (K m) () (These [s] f) -> Parser m f s [s]
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These [s] f) -> Body (,) f (K m) () (These [s] f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These [s] f) -> Body (,) f (K m) () (These [s] f))
-> K m (f, ()) (f, These [s] f)
-> Body (,) f (K m) () (These [s] f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These [s] f)) -> K m (f, ()) (f, These [s] f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These [s] f)) -> K m (f, ()) (f, These [s] f))
-> ((f, ()) -> m (f, These [s] f)) -> K m (f, ()) (f, These [s] f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) ->
  let r :: These [s] f
r = case forall f s. Uncons f s => f -> These s f
uncons @f @s f
s of
        That f
_ -> f -> These [s] f
forall a b. b -> These a b
That f
s
        This s
x
          | s -> Bool
p s
x -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These [s
x] (forall f s. Uncons f s => f
nil @f @s)
          | Bool
otherwise -> f -> These [s] f
forall a b. b -> These a b
That f
s
        These s
x f
s'
          | s -> Bool
p s
x -> [s] -> f -> These [s] f
go [s
x] f
s'
          | Bool
otherwise -> f -> These [s] f
forall a b. b -> These a b
That f
s
   in (f, These [s] f) -> m (f, These [s] f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These [s] f
r, These [s] f
r)
  where
    go :: [s] -> f -> These [s] f
go [s]
acc f
s0 = case forall f s. Uncons f s => f -> These s f
uncons @f @s f
s0 of
      That f
_ -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse [s]
acc) f
s0
      This s
x
        | s -> Bool
p s
x -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse (s
x s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
acc)) (forall f s. Uncons f s => f
nil @f @s)
        | Bool
otherwise -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse [s]
acc) f
s0
      These s
x f
s'
        | s -> Bool
p s
x -> [s] -> f -> These [s] f
go (s
x s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
acc) f
s'
        | Bool
otherwise -> [s] -> f -> These [s] f
forall a b. a -> b -> These a b
These ([s] -> [s]
forall a. [a] -> [a]
reverse [s]
acc) f
s0

-- | Return the next element without consuming the stream. Fails at end of
-- input.
peek :: forall m f s. (Monad m, Uncons f s) => Parser m f s s
peek :: forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s s
peek = Body (,) f (K m) () (These s f) -> Parser m f s s
forall {k} (m :: * -> *) f (s :: k) a.
Body (,) f (K m) () (These a f) -> Parser m f s a
Parser (Body (,) f (K m) () (These s f) -> Parser m f s s)
-> Body (,) f (K m) () (These s f) -> Parser m f s s
forall a b. (a -> b) -> a -> b
$ K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f)
forall {k} {k1} {k2} (t :: k -> k1 -> k2) (ch :: k)
       (arr :: k2 -> k2 -> *) (a :: k1) (b :: k1).
arr (t ch a) (t ch b) -> Body t ch arr a b
Body (K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f))
-> K m (f, ()) (f, These s f) -> Body (,) f (K m) () (These s f)
forall a b. (a -> b) -> a -> b
$ ((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f)
forall {k} (m :: k -> *) a (b :: k). (a -> m b) -> K m a b
K (((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f))
-> ((f, ()) -> m (f, These s f)) -> K m (f, ()) (f, These s f)
forall a b. (a -> b) -> a -> b
$ \(f
s, ()) ->
  let r :: These s f
r = case forall f s. Uncons f s => f -> These s f
uncons @f @s f
s of
        That f
_ -> f -> These s f
forall a b. b -> These a b
That f
s
        This s
x -> s -> f -> These s f
forall a b. a -> b -> These a b
These s
x f
s
        These s
x f
_ -> s -> f -> These s f
forall a b. a -> b -> These a b
These s
x f
s
   in (f, These s f) -> m (f, These s f)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall f s a. Uncons f s => These a f -> f
leftoverOf @f @s These s f
r, These s f
r)