{-# LANGUAGE ScopedTypeVariables #-}

module Language.Ltml.Parser.Footnote.Combinators
    ( withSucceedingFootnotes
    , manyWithFootnotesTillSucc
    )
where

import Control.Applicative ((<|>))
import Control.Monad.Trans.Class (lift)
import Data.Maybe (catMaybes)
import Language.Ltml.Parser (Parser)
import Language.Ltml.Parser.Common.Combinators (manyTillSucc)
import Language.Ltml.Parser.Common.Lexeme (nLexeme)
import Language.Ltml.Parser.Footnote (FootnoteParser, footnoteP)
import Text.Megaparsec (many)

-- | Parse with any succeeding footnotes, consuming any empty lines between
--   footnotes and finally.
--
--   The supplied argument parser must not succeed in-line, and must consume
--   any final whitespace.  I.e., it may only succeed after a newline plus any
--   subsequent whitespace.
withSucceedingFootnotes :: Parser a -> FootnoteParser a
withSucceedingFootnotes :: forall a. Parser a -> FootnoteParser a
withSucceedingFootnotes Parser a
p = Parser a -> FootnoteWriterT Parser a
forall (m :: * -> *) a. Monad m => m a -> FootnoteWriterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser a
p FootnoteWriterT Parser a
-> FootnoteWriterT Parser [()] -> FootnoteWriterT Parser a
forall a b.
FootnoteWriterT Parser a
-> FootnoteWriterT Parser b -> FootnoteWriterT Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* FootnoteWriterT Parser () -> FootnoteWriterT Parser [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (FootnoteWriterT Parser () -> FootnoteWriterT Parser ()
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme FootnoteWriterT Parser ()
footnoteP)

-- | Like 'manyTillSucc', but parse any interleaved footnotes, and consume
--   any number of empty lines between nodes (including footnotes) and
--   finally.
manyWithFootnotesTillSucc
    :: forall a
     . Parser a
    -> Parser ()
    -> FootnoteParser [a]
manyWithFootnotesTillSucc :: forall a. Parser a -> Parser () -> FootnoteParser [a]
manyWithFootnotesTillSucc Parser a
p Parser ()
end =
    [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a])
-> FootnoteWriterT Parser [Maybe a] -> FootnoteWriterT Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FootnoteWriterT Parser (Maybe a)
-> FootnoteWriterT Parser () -> FootnoteWriterT Parser [Maybe a]
forall (m :: * -> *) a end. MonadParser m => m a -> m end -> m [a]
manyTillSucc (FootnoteWriterT Parser (Maybe a)
-> FootnoteWriterT Parser (Maybe a)
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme FootnoteWriterT Parser (Maybe a)
elemP) (Parser () -> FootnoteWriterT Parser ()
forall (m :: * -> *) a. Monad m => m a -> FootnoteWriterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser ()
end)
  where
    elemP :: FootnoteParser (Maybe a)
    -- Note: `p` must be tried last.
    --  - It typically includes a paragraph parser, which generally treats
    --    keywords (as used for footnotes) as plain text.
    elemP :: FootnoteWriterT Parser (Maybe a)
elemP =
        Maybe a
forall a. Maybe a
Nothing Maybe a
-> FootnoteWriterT Parser () -> FootnoteWriterT Parser (Maybe a)
forall a b.
a -> FootnoteWriterT Parser b -> FootnoteWriterT Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FootnoteWriterT Parser ()
footnoteP
            FootnoteWriterT Parser (Maybe a)
-> FootnoteWriterT Parser (Maybe a)
-> FootnoteWriterT Parser (Maybe a)
forall a.
FootnoteWriterT Parser a
-> FootnoteWriterT Parser a -> FootnoteWriterT Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> FootnoteWriterT Parser a -> FootnoteWriterT Parser (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> FootnoteWriterT Parser a
forall (m :: * -> *) a. Monad m => m a -> FootnoteWriterT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser a
p