module HeadedMegaparsec
  ( -- * Types
    HeadedParsec,

    -- * Execution
    toParsec,

    -- * Transformation
    wrapToHead,
    label,
    hidden,
    dbg,
    filter,

    -- * Construction
    parse,
    endHead,
  )
where

import Control.Applicative.Combinators
import qualified HeadedMegaparsec.Megaparsec as Megaparsec
import HeadedMegaparsec.Prelude hiding (filter, head, tail, try)
import Text.Megaparsec (Parsec, Stream)
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char as MegaparsecChar
import qualified Text.Megaparsec.Char.Lexer as MegaparsecLexer
import qualified Text.Megaparsec.Debug as Megaparsec

-- $setup
--
-- >>> :set -XApplicativeDo

-- * Types

-- |
-- Headed parser.
--
-- Abstracts over explicit composition between consecutive megaparsec `try` blocks,
-- providing for better error messages.
--
-- With headed parser you don't need to use `try` at all.
--
-- ==__Examples__
--
-- >>> import Prelude
-- >>> import Control.Applicative
-- >>> import Data.Void
-- >>> import qualified Text.Megaparsec as M
-- >>> import qualified Text.Megaparsec.Char as M
-- >>> import qualified Text.Megaparsec.Char.Lexer as ML
-- >>> :{
--   let
--     select :: HeadedParsec Void String (Maybe [Either Char Int], Maybe Int)
--     select = do
--       string' "select"
--       endHead
--       _targets <- optional (space1 *> targets)
--       _limit <- optional (space1 *> limit)
--       return (_targets, _limit)
--       where
--         -- Lifted versions of basic parsers:
--         char = parse . M.char
--         space = parse M.space
--         space1 = parse M.space1
--         decimal = parse ML.decimal
--         string' = parse . M.string'
--         -- Syntax parsers:
--         targets = M.sepBy1 target commaSeparator
--         target = Left <$> char '*' <|> Right <$> decimal
--         commaSeparator = space *> char ',' *> endHead *> space
--         limit = string' "limit" *> endHead *> space1 *> decimal
--     test :: String -> IO ()
--     test = M.parseTest (toParsec select <* M.eof)
-- :}
--
-- >>> test "select 1, "
-- 1:11:
--   |
-- 1 | select 1,
--   |           ^
-- unexpected end of input
-- expecting '*', integer, or white space
--
-- >>> test "select limit "
-- ...
-- unexpected end of input
-- expecting integer or white space
--
-- >>> test "select 1, 2 limit 2"
-- (Just [Right 1,Right 2],Just 2)
newtype HeadedParsec err strm a = HeadedParsec (Parsec err strm (Either a (Parsec err strm a)))

-- |
-- A helper required for hacking `dbg`.
data Showable a = Showable String a

-- * Instances

-- ** Showable

instance Show (Showable a) where
  show :: Showable a -> String
show (Showable String
msg a
_) = String
msg

-- ** HeadedParsec

instance Functor (HeadedParsec err strm) where
  fmap :: forall a b.
(a -> b) -> HeadedParsec err strm a -> HeadedParsec err strm b
fmap a -> b
fn (HeadedParsec Parsec err strm (Either a (Parsec err strm a))
p) = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
fn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fn)) Parsec err strm (Either a (Parsec err strm a))
p)

instance (Ord err, Stream strm) => Applicative (HeadedParsec err strm) where
  pure :: forall a. a -> HeadedParsec err strm a
pure = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> Either a b
Left
  <*> :: forall a b.
HeadedParsec err strm (a -> b)
-> HeadedParsec err strm a -> HeadedParsec err strm b
(<*>) (HeadedParsec Parsec err strm (Either (a -> b) (Parsec err strm (a -> b)))
p1) (HeadedParsec Parsec err strm (Either a (Parsec err strm a))
p2) = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall a b. (a -> b) -> a -> b
$ do
    Either (a -> b) (Parsec err strm (a -> b))
junction1 <- Parsec err strm (Either (a -> b) (Parsec err strm (a -> b)))
p1
    case Either (a -> b) (Parsec err strm (a -> b))
junction1 of
      Left a -> b
aToB -> do
        Either a (Parsec err strm a)
junction2 <- Parsec err strm (Either a (Parsec err strm a))
p2
        case Either a (Parsec err strm a)
junction2 of
          Left a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (a -> b
aToB a
a))
          Right Parsec err strm a
tailP2 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
              a
a <- Parsec err strm a
tailP2
              return (a -> b
aToB a
a)
      Right Parsec err strm (a -> b)
tailP1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
          a -> b
aToB <- Parsec err strm (a -> b)
tailP1
          Either a (Parsec err strm a)
junction2 <- Parsec err strm (Either a (Parsec err strm a))
p2
          case Either a (Parsec err strm a)
junction2 of
            Left a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
aToB a
a)
            Right Parsec err strm a
tailP2 -> do
              a
a <- Parsec err strm a
tailP2
              return (a -> b
aToB a
a)

instance (Ord err, Stream strm) => Selective (HeadedParsec err strm) where
  select :: forall a b.
HeadedParsec err strm (Either a b)
-> HeadedParsec err strm (a -> b) -> HeadedParsec err strm b
select (HeadedParsec Parsec
  err strm (Either (Either a b) (Parsec err strm (Either a b)))
p1) (HeadedParsec Parsec err strm (Either (a -> b) (Parsec err strm (a -> b)))
p2) = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall a b. (a -> b) -> a -> b
$ do
    Either (Either a b) (Parsec err strm (Either a b))
junction1 <- Parsec
  err strm (Either (Either a b) (Parsec err strm (Either a b)))
p1
    case Either (Either a b) (Parsec err strm (Either a b))
junction1 of
      Left Either a b
eitherAOrB -> case Either a b
eitherAOrB of
        Right b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left b
b)
        Left a
a -> do
          Either (a -> b) (Parsec err strm (a -> b))
junction2 <- Parsec err strm (Either (a -> b) (Parsec err strm (a -> b)))
p2
          case Either (a -> b) (Parsec err strm (a -> b))
junction2 of
            Left a -> b
aToB -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (a -> b
aToB a
a))
            Right Parsec err strm (a -> b)
tailP2 -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
a) Parsec err strm (a -> b)
tailP2))
      Right Parsec err strm (Either a b)
tailP1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
          Either a b
eitherAOrB <- Parsec err strm (Either a b)
tailP1
          case Either a b
eitherAOrB of
            Right b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            Left a
a -> do
              Either (a -> b) (Parsec err strm (a -> b))
junction2 <- Parsec err strm (Either (a -> b) (Parsec err strm (a -> b)))
p2
              case Either (a -> b) (Parsec err strm (a -> b))
junction2 of
                Left a -> b
aToB -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
aToB a
a)
                Right Parsec err strm (a -> b)
tailP2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
a) Parsec err strm (a -> b)
tailP2

instance (Ord err, Stream strm) => Monad (HeadedParsec err strm) where
  return :: forall a. a -> HeadedParsec err strm a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  >>= :: forall a b.
HeadedParsec err strm a
-> (a -> HeadedParsec err strm b) -> HeadedParsec err strm b
(>>=) (HeadedParsec Parsec err strm (Either a (Parsec err strm a))
p1) a -> HeadedParsec err strm b
k2 = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall a b. (a -> b) -> a -> b
$ do
    Either a (Parsec err strm a)
junction1 <- Parsec err strm (Either a (Parsec err strm a))
p1
    case Either a (Parsec err strm a)
junction1 of
      Left a
a -> case a -> HeadedParsec err strm b
k2 a
a of HeadedParsec Parsec err strm (Either b (Parsec err strm b))
p2 -> Parsec err strm (Either b (Parsec err strm b))
p2
      Right Parsec err strm a
tailP1 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
          a
a <- Parsec err strm a
tailP1
          forall err strm a.
(Ord err, Stream strm) =>
Parsec err strm (Either a (Parsec err strm a)) -> Parsec err strm a
Megaparsec.contPossibly forall a b. (a -> b) -> a -> b
$ case a -> HeadedParsec err strm b
k2 a
a of HeadedParsec Parsec err strm (Either b (Parsec err strm b))
p2 -> Parsec err strm (Either b (Parsec err strm b))
p2

-- |
-- Alternation is performed only the basis of heads.
-- Bodies do not participate.
instance (Ord err, Stream strm) => Alternative (HeadedParsec err strm) where
  empty :: forall a. HeadedParsec err strm a
empty = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall (f :: * -> *) a. Alternative f => f a
empty
  <|> :: forall a.
HeadedParsec err strm a
-> HeadedParsec err strm a -> HeadedParsec err strm a
(<|>) (HeadedParsec Parsec err strm (Either a (Parsec err strm a))
p1) (HeadedParsec Parsec err strm (Either a (Parsec err strm a))
p2) = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Megaparsec.try Parsec err strm (Either a (Parsec err strm a))
p1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec err strm (Either a (Parsec err strm a))
p2)

-- |
-- Alternation is performed only the basis of heads.
-- Bodies do not participate.
instance (Ord err, Stream strm) => MonadPlus (HeadedParsec err strm) where
  mzero :: forall a. HeadedParsec err strm a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
  mplus :: forall a.
HeadedParsec err strm a
-> HeadedParsec err strm a -> HeadedParsec err strm a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

instance (Ord err, Stream strm) => MonadFail (HeadedParsec err strm) where
  fail :: forall a. String -> HeadedParsec err strm a
fail = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. MonadFail m => String -> m a
fail

-- * Execution

-- |
-- Convert headed parser into megaparsec parser.
toParsec :: (Ord err, Stream strm) => HeadedParsec err strm a -> Parsec err strm a
toParsec :: forall err strm a.
(Ord err, Stream strm) =>
HeadedParsec err strm a -> Parsec err strm a
toParsec (HeadedParsec Parsec err strm (Either a (Parsec err strm a))
p) = forall err strm a.
(Ord err, Stream strm) =>
Parsec err strm (Either a (Parsec err strm a)) -> Parsec err strm a
Megaparsec.contPossibly Parsec err strm (Either a (Parsec err strm a))
p

-- * Helpers

mapParsec :: (Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1)) -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2))) -> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec :: forall err1 strm1 res1 err2 strm2 res2.
(Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
 -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2)))
-> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
-> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2))
fn (HeadedParsec Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
p) = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec (Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
-> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2))
fn Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
p)

-- * Transformation

-- |
-- Wrap a parser to be usable as a whole in a head block,
-- allowing it in effect to be composed with the following parsers into a single `try` when executed,
-- no matter whether it contains `endHead` or not.
wrapToHead :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm a
wrapToHead :: forall err strm a.
(Ord err, Stream strm) =>
HeadedParsec err strm a -> HeadedParsec err strm a
wrapToHead = forall err1 strm1 res1 err2 strm2 res2.
(Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
 -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2)))
-> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall err strm a.
(Ord err, Stream strm) =>
Parsec err strm (Either a (Parsec err strm a)) -> Parsec err strm a
Megaparsec.contPossibly

-- |
-- Label a headed parser.
-- Works the same way as megaparsec's `Megaparsec.label`.
label :: (Ord err, Stream strm) => String -> HeadedParsec err strm a -> HeadedParsec err strm a
label :: forall err strm a.
(Ord err, Stream strm) =>
String -> HeadedParsec err strm a -> HeadedParsec err strm a
label String
label = forall err1 strm1 res1 err2 strm2 res2.
(Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
 -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2)))
-> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec (forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
Megaparsec.label String
label)

-- |
-- Adaptation of 'Megaparsec.hidden'.
hidden :: (Ord err, Stream strm) => HeadedParsec err strm a -> HeadedParsec err strm a
hidden :: forall err strm a.
(Ord err, Stream strm) =>
HeadedParsec err strm a -> HeadedParsec err strm a
hidden = forall err1 strm1 res1 err2 strm2 res2.
(Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
 -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2)))
-> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Megaparsec.hidden

-- |
-- Make a parser print debugging information when evaluated.
-- The first parameter is a custom label.
--
-- This function is a wrapper around `Megaparsec.dbg`.
-- It generates two debugging entries: one for head and one for tail.
dbg :: (Ord err, Megaparsec.ShowErrorComponent err, Megaparsec.VisualStream strm, Show a) => String -> HeadedParsec err strm a -> HeadedParsec err strm a
dbg :: forall err strm a.
(Ord err, ShowErrorComponent err, VisualStream strm, Show a) =>
String -> HeadedParsec err strm a -> HeadedParsec err strm a
dbg String
label = forall err1 strm1 res1 err2 strm2 res2.
(Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
 -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2)))
-> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec forall a b. (a -> b) -> a -> b
$ \Parsec err strm (Either a (ParsecT err strm Identity a))
p -> do
  Showable String
_ Either a (ParsecT err strm Identity a)
junction <- forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
Megaparsec.dbg (String
label forall a. Semigroup a => a -> a -> a
<> String
"/head") (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\a
a -> forall a. String -> a -> Showable a
Showable (forall a. Show a => a -> String
show a
a) (forall a b. a -> Either a b
Left a
a)) (forall a. String -> a -> Showable a
Showable String
"<tail parser>" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. b -> Either a b
Right)) Parsec err strm (Either a (ParsecT err strm Identity a))
p)
  case Either a (ParsecT err strm Identity a)
junction of
    Left a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
a)
    Right ParsecT err strm Identity a
tailP -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a.
(MonadParsecDbg e s m, Show a) =>
String -> m a -> m a
Megaparsec.dbg (String
label forall a. Semigroup a => a -> a -> a
<> String
"/tail") ParsecT err strm Identity a
tailP

-- |
-- Filter the results of parser based on a predicate,
-- failing with a parameterized message.
filter :: (Ord err, Stream strm) => (a -> String) -> (a -> Bool) -> HeadedParsec err strm a -> HeadedParsec err strm a
filter :: forall err strm a.
(Ord err, Stream strm) =>
(a -> String)
-> (a -> Bool)
-> HeadedParsec err strm a
-> HeadedParsec err strm a
filter a -> String
err a -> Bool
pred = forall err1 strm1 res1 err2 strm2 res2.
(Parsec err1 strm1 (Either res1 (Parsec err1 strm1 res1))
 -> Parsec err2 strm2 (Either res2 (Parsec err2 strm2 res2)))
-> HeadedParsec err1 strm1 res1 -> HeadedParsec err2 strm2 res2
mapParsec forall a b. (a -> b) -> a -> b
$ \Parsec err strm (Either a (Parsec err strm a))
p -> do
  Either a (Parsec err strm a)
junction <- Parsec err strm (Either a (Parsec err strm a))
p
  case Either a (Parsec err strm a)
junction of
    Left a
a ->
      if a -> Bool
pred a
a
        then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
a)
        else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (a -> String
err a
a)
    Right Parsec err strm a
tailP -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
        a
a <- Parsec err strm a
tailP
        if a -> Bool
pred a
a
          then forall (m :: * -> *) a. Monad m => a -> m a
return a
a
          else forall (m :: * -> *) a. MonadFail m => String -> m a
fail (a -> String
err a
a)

-- |
-- Lift a megaparsec parser as a head parser.
head :: (Ord err, Stream strm) => Parsec err strm a -> HeadedParsec err strm a
head :: forall err strm a.
(Ord err, Stream strm) =>
Parsec err strm a -> HeadedParsec err strm a
head = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left

-- |
-- Lift a megaparsec parser as a tail parser.
--
-- Composing consecutive tails results in one tail.
--
-- Composing consecutive head and tail leaves the head still composable with preceding head.
tail :: (Stream strm) => Parsec err strm a -> HeadedParsec err strm a
tail :: forall strm err a.
Stream strm =>
Parsec err strm a -> HeadedParsec err strm a
tail = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. b -> Either a b
Right

-- |
-- Lift both head and tail megaparsec parsers, composing their results.
headAndTail :: (Ord err, Stream strm) => (head -> tail -> a) -> Parsec err strm head -> Parsec err strm tail -> HeadedParsec err strm a
headAndTail :: forall err strm head tail a.
(Ord err, Stream strm) =>
(head -> tail -> a)
-> Parsec err strm head
-> Parsec err strm tail
-> HeadedParsec err strm a
headAndTail head -> tail -> a
fn Parsec err strm head
headP Parsec err strm tail
tailP = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec forall a b. (a -> b) -> a -> b
$ do
  head
a <- Parsec err strm head
headP
  return $
    forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
      tail
b <- Parsec err strm tail
tailP
      return (head -> tail -> a
fn head
a tail
b)

-- |
-- Lift a megaparsec parser.
parse :: (Ord err, Stream strm) => Parsec err strm a -> HeadedParsec err strm a
parse :: forall err strm a.
(Ord err, Stream strm) =>
Parsec err strm a -> HeadedParsec err strm a
parse = forall err strm a.
(Ord err, Stream strm) =>
Parsec err strm a -> HeadedParsec err strm a
head

-- * Control

-- |
-- Make all the following parsers compose as tail.
endHead :: (Stream strm) => HeadedParsec err strm ()
endHead :: forall strm err. Stream strm => HeadedParsec err strm ()
endHead = forall err strm a.
Parsec err strm (Either a (Parsec err strm a))
-> HeadedParsec err strm a
HeadedParsec (forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (forall (m :: * -> *) a. Monad m => a -> m a
return ())))