{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Parsing Mixed Indentation Trees---trees that may both be represented by
--   indentation, or by bracketing tokens, where the latter nodes may span
--   multiple lines, while empty lines are disallowed.
module Language.Ltml.Parser.MiTree
    ( MiElementConfig (..)
    , InlineParser (..)
    , Restricted
    , unrestricted
    , unbracketed
    , miForest
    , hangingBlock
    , hangingBlock'
    , hangingBlock_
    , pipeSeparated
    )
where

import Control.Applicative (optional, (<|>))
import Control.Applicative.Combinators (choice)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text)
import Data.Text.FromWhitespace (FromWhitespace, fromWhitespace)
import Language.Ltml.Parser (MonadParser)
import Language.Ltml.Parser.Common.Indent
    ( checkIndentGT
    , nli
    )
import Language.Ltml.Parser.Common.Lexeme (lexeme, sp)
import Text.Megaparsec (Pos, empty, lookAhead, many, try, (<?>))
import Text.Megaparsec.Char (char)
import Text.Megaparsec.Char.Lexer (indentLevel)
import qualified Text.Megaparsec.Char.Lexer as L (indentLevel)

-- | Configuration on how to handle an element (node in a mi-tree).
data MiElementConfig = MiElementConfig
    { MiElementConfig -> Bool
miecRetainPrecedingWhitespace :: Bool
    -- ^ whether to retain (or else drop) whitespace between the preceding and
    --   this element (if any).
    , MiElementConfig -> Bool
miecRetainTrailingWhitespace :: Bool
    -- ^ Whether to retain (or else drop) whitespace between this and
    --   the subsequent element (if any).
    --   This does not apply if the subsequent element is a child (in which
    --   case whitespace is always dropped).
    }

-- | An in-line element parser (constructor).
--   Involved parsers must not consume whitespace (ASCII spaces, newlines)
--   and must not accept the empty input.
data InlineParser m a
    = LeafParser (m (MiElementConfig, [a]))
    | -- | Bracketing parser, composed of two parsers, one for the opening
      --   bracket, one for the closing bracket.
      --   The closing bracket parser is only used if possible
      --   (via 'Control.Applicative.optional').
      --   The body parser is determined by context.
      --   Any whitespace both within and adjacent to the brackets is dropped.
      BracketingParser (m ([a] -> (MiElementConfig, [a]))) (m ())

data Restricted a = Restricted Restriction a

data Restriction
    = Unrestricted
    | Unbracketed
    deriving (Restriction -> Restriction -> Bool
(Restriction -> Restriction -> Bool)
-> (Restriction -> Restriction -> Bool) -> Eq Restriction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Restriction -> Restriction -> Bool
== :: Restriction -> Restriction -> Bool
$c/= :: Restriction -> Restriction -> Bool
/= :: Restriction -> Restriction -> Bool
Eq)

unrestricted :: a -> Restricted a
unrestricted :: forall a. a -> Restricted a
unrestricted = Restriction -> a -> Restricted a
forall a. Restriction -> a -> Restricted a
Restricted Restriction
Unrestricted

unbracketed :: a -> Restricted a
unbracketed :: forall a. a -> Restricted a
unbracketed = Restriction -> a -> Restricted a
forall a. Restriction -> a -> Restricted a
Restricted Restriction
Unbracketed

filterRestricted :: (Restriction -> Bool) -> [Restricted a] -> [a]
filterRestricted :: forall a. (Restriction -> Bool) -> [Restricted a] -> [a]
filterRestricted Restriction -> Bool
p = (Restricted a -> Maybe a) -> [Restricted a] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Restricted a -> Maybe a
forall {a}. Restricted a -> Maybe a
aux
  where
    aux :: Restricted a -> Maybe a
aux (Restricted Restriction
r a
x) = if Restriction -> Bool
p Restriction
r then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing

-- | Parse a list of mixed indentation trees (a forest), terminated by a
--   newline (plus indentation).
--
--   At least one element is parsed.
--
--   This is expected to be run at the start of a non-empty line, after any
--   indentation.
--
--   The initial (minimum) indentation is set to none.
miForest
    :: forall m a
     . (MonadParser m, FromWhitespace [a])
    => [Restricted (InlineParser m a)]
    -- ^ In-line element parsers.
    --   They are tried in the given order.
    -> (Maybe Pos -> m a)
    -- ^ Block element parser.
    --
    --   The block parser is only attempted at the start of a line, and takes
    --   precedence over in-line parsers there.
    --
    --   Unlike the in-line parsers, the block parser must take care of
    --   indentation itself--except at the very beginning, where it may
    --   expect that any indentation has been consumed and the indentation is
    --   correct.
    --   The supplied indentation is the parent's, and indentation is
    --   acceptable iff strictly larger than that.
    --
    --   Further, the block parser must only succeed after a final newline
    --   (plus indentation).
    --
    --   Typically, a block parser is constructed via 'hangingBlock'
    --   (optionally combined with
    --   'Language.Ltml.Parser.Common.Indent.someIndented' and/or
    --   'Control.Applicative.<|>'), which satisfies these requirements.
    -> m [a]
miForest :: forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
[Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [a]
miForest [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP = Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
miForestFrom Bool
False Bool
False [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP Maybe Pos
forall a. Maybe a
Nothing

-- | Information on whitespace separating two elements.
data Sep
    = Sep
        Bool
        -- ^ whether including linebreak
        Text

-- | Generalization of 'miForest'.
miForestFrom
    :: forall m a
     . (MonadParser m, FromWhitespace [a])
    => Bool
    -- ^ Whether there has already been parsed a "head" in the current line.
    --   A head is any non-empty token (whitespace counting as empty).
    --   If @True@, the parser behaves as if an initial in-line element was
    --   already parsed.  In particular, returning successfully without
    --   parsing any element is possible.
    --   If @False@, the parser is expected to be run at the start of an
    --   (indented) non-empty line.
    -> Bool
    -- ^ Whether the miForest should be ended when encountering a '|',
    --   which is a semi-special word character.
    -> [Restricted (InlineParser m a)]
    -> (Maybe Pos -> m a)
    -> Maybe Pos
    -- ^ Parent indentation level.  Only input indented strictly further is
    --   accepted.
    -> m [a]
miForestFrom :: forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
miForestFrom Bool
rootIsHeaded Bool
untilPipe [Restricted (InlineParser m a)]
rInlinePs Maybe Pos -> m a
blockP Maybe Pos
lvl = do
    ([a]
x, Sep
sep) <- Bool -> [InlineParser m a] -> m ([a], Sep)
go Bool
rootIsHeaded ((Restriction -> Bool)
-> [Restricted (InlineParser m a)] -> [InlineParser m a]
forall a. (Restriction -> Bool) -> [Restricted a] -> [a]
filterRestricted (Bool -> Restriction -> Bool
forall a b. a -> b -> a
const Bool
True) [Restricted (InlineParser m a)]
rInlinePs)
    case Sep
sep of
        Sep Bool
True Text
_ -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
x
        Sep Bool
False Text
_ -> m [a]
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty m [a] -> String -> m [a]
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"newline"
  where
    mkP :: InlineParser m a -> m ((MiElementConfig, [a]), Sep)
    mkP :: InlineParser m a -> m ((MiElementConfig, [a]), Sep)
mkP (LeafParser m (MiElementConfig, [a])
p) = (,) ((MiElementConfig, [a]) -> Sep -> ((MiElementConfig, [a]), Sep))
-> m (MiElementConfig, [a])
-> m (Sep -> ((MiElementConfig, [a]), Sep))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (MiElementConfig, [a])
p m (Sep -> ((MiElementConfig, [a]), Sep))
-> m Sep -> m ((MiElementConfig, [a]), Sep)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Sep
sepP
    mkP (BracketingParser m ([a] -> (MiElementConfig, [a]))
openP m ()
closeP) = do
        [a] -> (MiElementConfig, [a])
f <- m ([a] -> (MiElementConfig, [a]))
openP
        ([a]
body, Sep
s) <- Bool -> [InlineParser m a] -> m ([a], Sep)
go Bool
True ([InlineParser m a] -> m ([a], Sep))
-> [InlineParser m a] -> m ([a], Sep)
forall a b. (a -> b) -> a -> b
$ (Restriction -> Bool)
-> [Restricted (InlineParser m a)] -> [InlineParser m a]
forall a. (Restriction -> Bool) -> [Restricted a] -> [a]
filterRestricted (Restriction -> Restriction -> Bool
forall a. Eq a => a -> a -> Bool
/= Restriction
Unbracketed) [Restricted (InlineParser m a)]
rInlinePs
        Maybe Sep
ms' <- m Sep -> m (Maybe Sep)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m ()
closeP m () -> m Sep -> m Sep
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m Sep
sepP)
        ((MiElementConfig, [a]), Sep) -> m ((MiElementConfig, [a]), Sep)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> (MiElementConfig, [a])
f [a]
body, Sep -> Maybe Sep -> Sep
forall a. a -> Maybe a -> a
fromMaybe Sep
s Maybe Sep
ms')

    -- CONSIDER: Permit EOF.
    sepP :: m Sep
    sepP :: m Sep
sepP = do
        Text
s <- m Text
forall (m :: * -> *). MonadParser m => m Text
sp
        Maybe Text
ms' <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m Text
forall (m :: * -> *). MonadParser m => m Text
nli
        case Maybe Text
ms' of
            Just Text
s' -> Sep -> m Sep
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sep -> m Sep) -> Sep -> m Sep
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Sep
Sep Bool
True (Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s')
            Maybe Text
Nothing -> Sep -> m Sep
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Sep -> m Sep) -> Sep -> m Sep
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Sep
Sep Bool
False Text
s

    -- To be called at the start of an (indented) line iff not isHeaded.
    -- Iff `isHeaded`, treated as if a first in-line element was already
    -- parsed.
    --  - In particular, permits empty element list.
    go :: Bool -> [InlineParser m a] -> m ([a], Sep)
    go :: Bool -> [InlineParser m a] -> m ([a], Sep)
go Bool
isHeaded [InlineParser m a]
inlinePs =
        if Bool
isHeaded
            then m Sep
sepP m Sep -> (Sep -> m ([a], Sep)) -> m ([a], Sep)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Sep -> m ([a], Sep)
goTail Bool
False
            else m ([a], Sep)
goBlock m ([a], Sep) -> m ([a], Sep) -> m ([a], Sep)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> m ([a], Sep)
goInline Text
forall a. Monoid a => a
mempty
      where
        goInline :: Text -> m ([a], Sep)
        goInline :: Text -> m ([a], Sep)
goInline Text
precWS = do
            -- check if '|' is next and should terminate the forest
            Maybe Char
mStop <- m Char -> m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Char -> m (Maybe Char)) -> m Char -> m (Maybe Char)
forall a b. (a -> b) -> a -> b
$ m Char -> m Char
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (m Char -> m Char
forall a. m a -> m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (m Char -> m Char) -> m Char -> m Char
forall a b. (a -> b) -> a -> b
$ Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'|')
            case (Maybe Char
mStop, Bool
untilPipe) of
                (Just Char
_, Bool
True) -> Sep -> m ([a], Sep)
goEnd (Bool -> Text -> Sep
Sep Bool
True Text
precWS)
                (Maybe Char, Bool)
_ -> do
                    ((MiElementConfig
cfg, [a]
e), Sep
s) <- [m ((MiElementConfig, [a]), Sep)]
-> m ((MiElementConfig, [a]), Sep)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([m ((MiElementConfig, [a]), Sep)]
 -> m ((MiElementConfig, [a]), Sep))
-> [m ((MiElementConfig, [a]), Sep)]
-> m ((MiElementConfig, [a]), Sep)
forall a b. (a -> b) -> a -> b
$ (InlineParser m a -> m ((MiElementConfig, [a]), Sep))
-> [InlineParser m a] -> [m ((MiElementConfig, [a]), Sep)]
forall a b. (a -> b) -> [a] -> [b]
map InlineParser m a -> m ((MiElementConfig, [a]), Sep)
mkP [InlineParser m a]
inlinePs

                    let precWS' :: [a]
                        precWS' :: [a]
precWS' =
                            if MiElementConfig -> Bool
miecRetainPrecedingWhitespace MiElementConfig
cfg
                                then Text -> [a]
forall a. FromWhitespace a => Text -> a
fromWhitespace Text
precWS
                                else []

                    ([a]
es, Sep
s') <- Bool -> Sep -> m ([a], Sep)
goTail (MiElementConfig -> Bool
miecRetainTrailingWhitespace MiElementConfig
cfg) Sep
s

                    ([a], Sep) -> m ([a], Sep)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
precWS' [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
e [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
es, Sep
s')

        goTail :: Bool -> Sep -> m ([a], Sep)
        goTail :: Bool -> Sep -> m ([a], Sep)
goTail Bool
retainWS (Sep Bool
lineEnded Text
precWS) =
            if Bool
lineEnded
                then Maybe Pos -> m ()
forall (m :: * -> *). MonadParser m => Maybe Pos -> m ()
checkIndentGT Maybe Pos
lvl m () -> m ([a], Sep) -> m ([a], Sep)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m ([a], Sep)
goBlock m ([a], Sep) -> m ([a], Sep) -> m ([a], Sep)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ([a], Sep)
goInline') m ([a], Sep) -> m ([a], Sep) -> m ([a], Sep)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ([a], Sep)
goEnd'
                else m ([a], Sep)
goInline' m ([a], Sep) -> m ([a], Sep) -> m ([a], Sep)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ([a], Sep)
goEnd'
          where
            goInline' :: m ([a], Sep)
goInline' = Text -> m ([a], Sep)
goInline Text
precWS'
            goEnd' :: m ([a], Sep)
goEnd' = Sep -> m ([a], Sep)
goEnd (Bool -> Text -> Sep
Sep Bool
lineEnded Text
precWS')
            precWS' :: Text
precWS' = if Bool
retainWS then Text
precWS else Text
forall a. Monoid a => a
mempty

        goBlock :: m ([a], Sep)
        goBlock :: m ([a], Sep)
goBlock = do
            a
x <- Maybe Pos -> m a
blockP Maybe Pos
lvl
            ([a]
xs, Sep
s) <- Bool -> Sep -> m ([a], Sep)
goTail Bool
False (Bool -> Text -> Sep
Sep Bool
True Text
forall a. Monoid a => a
mempty)
            ([a], Sep) -> m ([a], Sep)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs, Sep
s)

        goEnd :: Sep -> m ([a], Sep)
        goEnd :: Sep -> m ([a], Sep)
goEnd Sep
s = ([a], Sep) -> m ([a], Sep)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Sep
s)

-- | Parse a mi-forest headed by a keyword, with all lines but the first
--   indented further than the first.
--
--   Text may begin on the line of the keyword or on the next (indented) line.
--
--   The documentation on 'miForest' generally applies.
hangingBlock
    :: (MonadParser m, FromWhitespace [a])
    => m ([a] -> b)
    -- ^ Keyword parser.  Result is applied to the parsed mi-forest.
    --   This is expected not to consume any whitespace.
    -> [Restricted (InlineParser m a)]
    -> (Maybe Pos -> m a)
    -> m b
hangingBlock :: forall (m :: * -> *) a b.
(MonadParser m, FromWhitespace [a]) =>
m ([a] -> b)
-> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m b
hangingBlock m ([a] -> b)
keywordP [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP = do
    Pos
lvl' <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
L.indentLevel
    m ([a] -> b)
keywordP m ([a] -> b) -> m [a] -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
miForestFrom Bool
True Bool
False [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP (Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
lvl')

-- | Version of 'hangingBlock' where the keyword parser may yield any value,
--   which is paired with the parsed mi-forest.
hangingBlock'
    :: (MonadParser m, FromWhitespace [a])
    => m b
    -> [Restricted (InlineParser m a)]
    -> (Maybe Pos -> m a)
    -> m (b, [a])
hangingBlock' :: forall (m :: * -> *) a b.
(MonadParser m, FromWhitespace [a]) =>
m b
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> m (b, [a])
hangingBlock' = m ([a] -> (b, [a]))
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> m (b, [a])
forall (m :: * -> *) a b.
(MonadParser m, FromWhitespace [a]) =>
m ([a] -> b)
-> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m b
hangingBlock (m ([a] -> (b, [a]))
 -> [Restricted (InlineParser m a)]
 -> (Maybe Pos -> m a)
 -> m (b, [a]))
-> (m b -> m ([a] -> (b, [a])))
-> m b
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> m (b, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> [a] -> (b, [a])) -> m b -> m ([a] -> (b, [a]))
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,)

-- | Version of 'hangingBlock' where the keyword parser does not return a
--   value.
hangingBlock_
    :: (MonadParser m, FromWhitespace [a])
    => m ()
    -> [Restricted (InlineParser m a)]
    -> (Maybe Pos -> m a)
    -> m [a]
hangingBlock_ :: forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
m ()
-> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [a]
hangingBlock_ = m ([a] -> [a])
-> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [a]
forall (m :: * -> *) a b.
(MonadParser m, FromWhitespace [a]) =>
m ([a] -> b)
-> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m b
hangingBlock (m ([a] -> [a])
 -> [Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [a])
-> (m () -> m ([a] -> [a]))
-> m ()
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> [a] -> [a]) -> m () -> m ([a] -> [a])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> [a]) -> () -> [a] -> [a]
forall a b. a -> b -> a
const [a] -> [a]
forall a. a -> a
id)

-- | Parse a list of '|' seperated TextForests.
--   At least one element will be parsed.
--   The list can also be defined across multiple lines
--   and contain empty lines.
--   The initial (minimum) indentation is set to none.
pipeSeparated
    :: forall m a
     . (MonadParser m, FromWhitespace [a])
    => [Restricted (InlineParser m a)]
    -> (Maybe Pos -> m a)
    -- ^ Block parser. Documentation of 'miForest' applies.
    -> m [[a]]
pipeSeparated :: forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
[Restricted (InlineParser m a)] -> (Maybe Pos -> m a) -> m [[a]]
pipeSeparated [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP = do
    Pos
lvl <- m Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
indentLevel
    [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a) -> Maybe Pos -> m [[a]]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
[Restricted (InlineParser m a)]
-> (Maybe Pos -> m a) -> Maybe Pos -> m [[a]]
pipeSeparatedFrom [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP (Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
lvl)

pipeSeparatedFrom
    :: forall m a
     . (MonadParser m, FromWhitespace [a])
    => [Restricted (InlineParser m a)]
    -> (Maybe Pos -> m a)
    -- ^ Block parser. Documentation of 'miForest' applies.
    -> Maybe Pos
    -- ^ Parent indentation level. Documentation of 'miForestFrom' applies.
    -> m [[a]]
pipeSeparatedFrom :: forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
[Restricted (InlineParser m a)]
-> (Maybe Pos -> m a) -> Maybe Pos -> m [[a]]
pipeSeparatedFrom [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP Maybe Pos
lvl = do
    [a]
first <- Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
miForestFrom Bool
False Bool
True [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP Maybe Pos
lvl
    [[a]]
rest <- m [a] -> m [[a]]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m Char -> m Char
forall (m :: * -> *) a. MonadParser m => m a -> m a
lexeme (Token Text -> m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'|') m Char -> m [a] -> m [a]
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
forall (m :: * -> *) a.
(MonadParser m, FromWhitespace [a]) =>
Bool
-> Bool
-> [Restricted (InlineParser m a)]
-> (Maybe Pos -> m a)
-> Maybe Pos
-> m [a]
miForestFrom Bool
True Bool
True [Restricted (InlineParser m a)]
inlinePs Maybe Pos -> m a
blockP Maybe Pos
lvl)
    [[a]] -> m [[a]]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
first [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
rest)