{-# LANGUAGE ScopedTypeVariables #-}

module Language.Ltml.Tree.Parser.Document
    ( documentTP
    , documentTP'
    , documentTXP'
    )
where

import Control.Functor.Utils (Pure, sequenceEither)
import Control.Monad.ConsumableStack
    ( ConsumableStackError
        ( ConsumableStackDepletedEarly
        , ConsumableStackNotFullyConsumed
        )
    , ConsumableStackT
    , pop
    , runConsumableStackT
    )
import Control.Monad.Identity (runIdentity)
import Control.Monad.Trans (lift)
import Data.Text (Text)
import Language.Lsd.AST.Common (Keyword, NavTocHeading)
import Language.Lsd.AST.SimpleRegex (Disjunction (Disjunction), Sequence)
import Language.Lsd.AST.Type
    ( NamedType
    , unwrapNT
    )
import Language.Lsd.AST.Type.Document
    ( DocumentBodyType (DocumentBodyType)
    , DocumentExtroType (DocumentExtroType)
    , DocumentHeadingType
    , DocumentIntroType (DocumentIntroType)
    , DocumentMainBodyType (DocumentMainBodyType)
    , DocumentType (DocumentType)
    )
import Language.Lsd.AST.Type.SimpleSection (SimpleSectionType)
import Language.Ltml.AST.Document
    ( Document (Document)
    , DocumentBody (DocumentBody)
    , DocumentExtro
    , DocumentHeading
    , DocumentIntro
    , DocumentMainBody
    )
import Language.Ltml.AST.Section (SectionBody)
import Language.Ltml.AST.SimpleSection (SimpleSection)
import Language.Ltml.Common (Flagged', NavTocHeaded (NavTocHeaded), Parsed)
import Language.Ltml.Parser.Document (documentHeadingP)
import Language.Ltml.Parser.Footnote (FootnoteMap, runFootnoteWriterT)
import Language.Ltml.Parser.Section (sectionBodyP)
import Language.Ltml.Parser.SimpleSection (simpleSectionSequenceP)
import Language.Ltml.Parser.Text (HangingTextP)
import Language.Ltml.Tree (FlaggedInputTree', InputTree', Tree (Leaf, Tree))
import Language.Ltml.Tree.Parser
    ( FootnoteTreeParser
    , TreeParser
    , disjNFlaggedTreePF
    , flaggedTreePF
    , leafFootnoteParser
    , nFlaggedTreePF
    )
import Language.Ltml.Tree.Parser.Section (sectionBodyTP)
import Text.Megaparsec (eof)

documentTP
    :: NamedType DocumentType
    -> FlaggedInputTree'
    -> TreeParser (Flagged' Document)
documentTP :: NamedType DocumentType
-> FlaggedInputTree' -> TreeParser (Flagged' Document)
documentTP NamedType DocumentType
nt FlaggedInputTree'
tTree = (Identity Document -> Document)
-> Flagged Bool (Identity Document) -> Flagged' Document
forall a b. (a -> b) -> Flagged Bool a -> Flagged Bool b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Identity Document -> Document
forall a. Identity a -> a
runIdentity (Flagged Bool (Identity Document) -> Flagged' Document)
-> TreeParser (Flagged Bool (Identity Document))
-> TreeParser (Flagged' Document)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedType DocumentType
-> FlaggedInputTree'
-> TreeParser (Flagged Bool (Identity Document))
forall (f :: * -> *).
(Pure f, HangingTextP f) =>
NamedType DocumentType
-> FlaggedInputTree' -> TreeParser (Flagged' (f Document))
documentTP' NamedType DocumentType
nt FlaggedInputTree'
tTree

documentTP'
    :: (Pure f, HangingTextP f)
    => NamedType DocumentType
    -> FlaggedInputTree'
    -> TreeParser (Flagged' (f Document))
documentTP' :: forall (f :: * -> *).
(Pure f, HangingTextP f) =>
NamedType DocumentType
-> FlaggedInputTree' -> TreeParser (Flagged' (f Document))
documentTP' = (DocumentType
 -> Tree Bool (Maybe Text) Text -> TreeParser (f Document))
-> NamedType DocumentType
-> FlaggedInputTree'
-> TreeParser (Flagged Bool (f Document))
forall (m :: * -> *) t flag a b c.
(MonadTreeParser m, RawProperNodeKind t) =>
(t -> Tree flag a b -> m c)
-> NamedType t -> FlaggedTree flag a b -> m (Flagged flag c)
nFlaggedTreePF DocumentType
-> Tree Bool (Maybe Text) Text -> TreeParser (f Document)
forall (f :: * -> *).
(Pure f, HangingTextP f) =>
DocumentType
-> Tree Bool (Maybe Text) Text -> TreeParser (f Document)
documentTXP'

documentTXP'
    :: forall f
     . (Pure f, HangingTextP f)
    => DocumentType
    -> InputTree'
    -> TreeParser (f Document)
documentTXP' :: forall (f :: * -> *).
(Pure f, HangingTextP f) =>
DocumentType
-> Tree Bool (Maybe Text) Text -> TreeParser (f Document)
documentTXP' DocumentType
_ (Leaf Text
_) =
    String -> TreeParser (f Document)
forall a. String -> TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Parsing textual documents not yet implemented" -- TODO
documentTXP'
    (DocumentType Keyword
kw DocumentFormat
fmt DocumentHeadingType
headingT DocumentBodyType
bodyT (Disjunction [NamedType FootnoteType]
fnTs))
    (Tree Maybe Text
x [FlaggedInputTree']
children) = do
        (f (FootnoteMap -> Document)
docF, FootnoteMap
fnMap) <- FootnoteWriterT TreeParser (f (FootnoteMap -> Document))
-> [FootnoteType]
-> TreeParser (f (FootnoteMap -> Document), FootnoteMap)
forall (m :: * -> *) a.
FootnoteWriterT m a -> [FootnoteType] -> m (a, FootnoteMap)
runFootnoteWriterT FootnoteWriterT TreeParser (f (FootnoteMap -> Document))
aux ((NamedType FootnoteType -> FootnoteType)
-> [NamedType FootnoteType] -> [FootnoteType]
forall a b. (a -> b) -> [a] -> [b]
map NamedType FootnoteType -> FootnoteType
forall t. NamedType t -> t
unwrapNT [NamedType FootnoteType]
fnTs)
        f Document -> TreeParser (f Document)
forall a. a -> TreeParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (f Document -> TreeParser (f Document))
-> f Document -> TreeParser (f Document)
forall a b. (a -> b) -> a -> b
$ ((FootnoteMap -> Document) -> Document)
-> f (FootnoteMap -> Document) -> f Document
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FootnoteMap -> Document) -> FootnoteMap -> Document
forall a b. (a -> b) -> a -> b
$ FootnoteMap
fnMap) f (FootnoteMap -> Document)
docF
      where
        aux :: FootnoteTreeParser (f (FootnoteMap -> Document))
        aux :: FootnoteWriterT TreeParser (f (FootnoteMap -> Document))
aux = do
            f (Either ParseError DocumentHeading)
wHeading <- Either ParseError (f DocumentHeading)
-> f (Either ParseError DocumentHeading)
forall (f :: * -> *) e a.
Pure f =>
Either e (f a) -> f (Either e a)
sequenceEither (Either ParseError (f DocumentHeading)
 -> f (Either ParseError DocumentHeading))
-> FootnoteWriterT
     TreeParser (Either ParseError (f DocumentHeading))
-> FootnoteWriterT
     TreeParser (f (Either ParseError DocumentHeading))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Keyword
-> DocumentHeadingType
-> Maybe Text
-> FootnoteWriterT
     TreeParser (Either ParseError (f DocumentHeading))
forall (f :: * -> *).
HangingTextP f =>
Keyword
-> DocumentHeadingType
-> Maybe Text
-> FootnoteTreeParser (Parsed (f DocumentHeading))
headingTP Keyword
kw DocumentHeadingType
headingT Maybe Text
x
            DocumentBody
body <- DocumentBodyType
-> [FlaggedInputTree'] -> FootnoteTreeParser DocumentBody
bodyTP DocumentBodyType
bodyT [FlaggedInputTree']
children
            f (FootnoteMap -> Document)
-> FootnoteWriterT TreeParser (f (FootnoteMap -> Document))
forall a. a -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (f (FootnoteMap -> Document)
 -> FootnoteWriterT TreeParser (f (FootnoteMap -> Document)))
-> f (FootnoteMap -> Document)
-> FootnoteWriterT TreeParser (f (FootnoteMap -> Document))
forall a b. (a -> b) -> a -> b
$ (Either ParseError DocumentHeading -> FootnoteMap -> Document)
-> f (Either ParseError DocumentHeading)
-> f (FootnoteMap -> Document)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Either ParseError DocumentHeading
heading -> DocumentFormat
-> Either ParseError DocumentHeading
-> DocumentBody
-> FootnoteMap
-> Document
Document DocumentFormat
fmt Either ParseError DocumentHeading
heading DocumentBody
body) f (Either ParseError DocumentHeading)
wHeading

headingTP
    :: (HangingTextP f)
    => Keyword
    -> DocumentHeadingType
    -> Maybe Text
    -> FootnoteTreeParser (Parsed (f DocumentHeading))
headingTP :: forall (f :: * -> *).
HangingTextP f =>
Keyword
-> DocumentHeadingType
-> Maybe Text
-> FootnoteTreeParser (Parsed (f DocumentHeading))
headingTP Keyword
kw DocumentHeadingType
t (Just Text
x) = FootnoteParser (f DocumentHeading)
-> Text -> FootnoteTreeParser (Parsed (f DocumentHeading))
forall a. FootnoteParser a -> Text -> FootnoteTreeParser (Parsed a)
leafFootnoteParser (Keyword
-> DocumentHeadingType -> FootnoteParser (f DocumentHeading)
forall (f :: * -> *).
HangingTextP f =>
Keyword
-> DocumentHeadingType -> FootnoteParser (f DocumentHeading)
documentHeadingP Keyword
kw DocumentHeadingType
t) Text
x
headingTP Keyword
_ DocumentHeadingType
_ Maybe Text
Nothing = String -> FootnoteTreeParser (Parsed (f DocumentHeading))
forall a. String -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Document lacks heading"

bodyTP
    :: DocumentBodyType
    -> [FlaggedInputTree']
    -> FootnoteTreeParser DocumentBody
bodyTP :: DocumentBodyType
-> [FlaggedInputTree'] -> FootnoteTreeParser DocumentBody
bodyTP (DocumentBodyType Maybe DocumentIntroType
introT Disjunction (NamedType DocumentMainBodyType)
mainT Maybe DocumentExtroType
extroT) [FlaggedInputTree']
trees =
    ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) DocumentBody
-> [FlaggedInputTree']
-> FootnoteWriterT
     TreeParser (Either ConsumableStackError DocumentBody)
forall (m :: * -> *) s a.
Functor m =>
ConsumableStackT s m a -> [s] -> m (Either ConsumableStackError a)
runConsumableStackT ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) DocumentBody
aux [FlaggedInputTree']
trees FootnoteWriterT
  TreeParser (Either ConsumableStackError DocumentBody)
-> (Either ConsumableStackError DocumentBody
    -> FootnoteTreeParser DocumentBody)
-> FootnoteTreeParser DocumentBody
forall a b.
FootnoteWriterT TreeParser a
-> (a -> FootnoteWriterT TreeParser b)
-> FootnoteWriterT TreeParser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ConsumableStackError -> FootnoteTreeParser DocumentBody)
-> (DocumentBody -> FootnoteTreeParser DocumentBody)
-> Either ConsumableStackError DocumentBody
-> FootnoteTreeParser DocumentBody
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> FootnoteTreeParser DocumentBody
forall a. String -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> FootnoteTreeParser DocumentBody)
-> (ConsumableStackError -> String)
-> ConsumableStackError
-> FootnoteTreeParser DocumentBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsumableStackError -> String
prettyError) DocumentBody -> FootnoteTreeParser DocumentBody
forall a. a -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    aux :: ConsumableStackT FlaggedInputTree' FootnoteTreeParser DocumentBody
    aux :: ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) DocumentBody
aux =
        Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> Flagged' (NavTocHeaded (Parsed DocumentMainBody))
-> Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> DocumentBody
DocumentBody
            (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
 -> Flagged' (NavTocHeaded (Parsed DocumentMainBody))
 -> Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
 -> DocumentBody)
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody))
      -> Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
      -> DocumentBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DocumentIntroType
 -> ConsumableStackT
      FlaggedInputTree'
      (FootnoteWriterT TreeParser)
      (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> Maybe DocumentIntroType
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
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) -> Maybe a -> f (Maybe b)
traverse (\DocumentIntroType
t -> ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) FlaggedInputTree'
forall s (m :: * -> *). MonadConsumableStack s m => m s
pop ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) FlaggedInputTree'
-> (FlaggedInputTree'
    -> ConsumableStackT
         FlaggedInputTree'
         (FootnoteWriterT TreeParser)
         (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall a b.
ConsumableStackT FlaggedInputTree' (FootnoteWriterT TreeParser) a
-> (a
    -> ConsumableStackT
         FlaggedInputTree' (FootnoteWriterT TreeParser) b)
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FootnoteTreeParser (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall (m :: * -> *) a.
Monad m =>
m a -> ConsumableStackT FlaggedInputTree' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FootnoteTreeParser
   (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
 -> ConsumableStackT
      FlaggedInputTree'
      (FootnoteWriterT TreeParser)
      (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> (FlaggedInputTree'
    -> FootnoteTreeParser
         (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> FlaggedInputTree'
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentIntroType
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
introTP DocumentIntroType
t) Maybe DocumentIntroType
introT
            ConsumableStackT
  FlaggedInputTree'
  (FootnoteWriterT TreeParser)
  (Flagged' (NavTocHeaded (Parsed DocumentMainBody))
   -> Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
   -> DocumentBody)
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
      -> DocumentBody)
forall a b.
ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) (a -> b)
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) a
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) FlaggedInputTree'
forall s (m :: * -> *). MonadConsumableStack s m => m s
pop ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) FlaggedInputTree'
-> (FlaggedInputTree'
    -> ConsumableStackT
         FlaggedInputTree'
         (FootnoteWriterT TreeParser)
         (Flagged' (NavTocHeaded (Parsed DocumentMainBody))))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
forall a b.
ConsumableStackT FlaggedInputTree' (FootnoteWriterT TreeParser) a
-> (a
    -> ConsumableStackT
         FlaggedInputTree' (FootnoteWriterT TreeParser) b)
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FootnoteTreeParser
  (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
forall (m :: * -> *) a.
Monad m =>
m a -> ConsumableStackT FlaggedInputTree' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FootnoteTreeParser
   (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
 -> ConsumableStackT
      FlaggedInputTree'
      (FootnoteWriterT TreeParser)
      (Flagged' (NavTocHeaded (Parsed DocumentMainBody))))
-> (FlaggedInputTree'
    -> FootnoteTreeParser
         (Flagged' (NavTocHeaded (Parsed DocumentMainBody))))
-> FlaggedInputTree'
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Disjunction (NamedType DocumentMainBodyType)
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
mainTP Disjunction (NamedType DocumentMainBodyType)
mainT)
            ConsumableStackT
  FlaggedInputTree'
  (FootnoteWriterT TreeParser)
  (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
   -> DocumentBody)
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) DocumentBody
forall a b.
ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) (a -> b)
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) a
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DocumentExtroType
 -> ConsumableStackT
      FlaggedInputTree'
      (FootnoteWriterT TreeParser)
      (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> Maybe DocumentExtroType
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
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) -> Maybe a -> f (Maybe b)
traverse (\DocumentExtroType
t -> ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) FlaggedInputTree'
forall s (m :: * -> *). MonadConsumableStack s m => m s
pop ConsumableStackT
  FlaggedInputTree' (FootnoteWriterT TreeParser) FlaggedInputTree'
-> (FlaggedInputTree'
    -> ConsumableStackT
         FlaggedInputTree'
         (FootnoteWriterT TreeParser)
         (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall a b.
ConsumableStackT FlaggedInputTree' (FootnoteWriterT TreeParser) a
-> (a
    -> ConsumableStackT
         FlaggedInputTree' (FootnoteWriterT TreeParser) b)
-> ConsumableStackT
     FlaggedInputTree' (FootnoteWriterT TreeParser) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FootnoteTreeParser (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall (m :: * -> *) a.
Monad m =>
m a -> ConsumableStackT FlaggedInputTree' m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FootnoteTreeParser
   (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
 -> ConsumableStackT
      FlaggedInputTree'
      (FootnoteWriterT TreeParser)
      (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> (FlaggedInputTree'
    -> FootnoteTreeParser
         (Flagged' (NavTocHeaded (Parsed DocumentIntro))))
-> FlaggedInputTree'
-> ConsumableStackT
     FlaggedInputTree'
     (FootnoteWriterT TreeParser)
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentExtroType
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
extroTP DocumentExtroType
t) Maybe DocumentExtroType
extroT

    prettyError :: ConsumableStackError -> String
prettyError ConsumableStackError
ConsumableStackDepletedEarly = String
"Too few document body children"
    prettyError ConsumableStackError
ConsumableStackNotFullyConsumed =
        String
"Too many document body children"

introTP
    :: DocumentIntroType
    -> FlaggedInputTree'
    -> FootnoteTreeParser (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
introTP :: DocumentIntroType
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
introTP = (DocumentIntroType
 -> Tree Bool (Maybe Text) Text
 -> FootnoteWriterT
      TreeParser (NavTocHeaded (Parsed DocumentIntro)))
-> DocumentIntroType
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall (m :: * -> *) t flag a b c.
(MonadTreeParser m, ProperNodeKind t) =>
(t -> Tree flag a b -> m c)
-> t -> FlaggedTree flag a b -> m (Flagged flag c)
flaggedTreePF DocumentIntroType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
aux
  where
    aux :: DocumentIntroType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
aux (DocumentIntroType NavTocHeading
nth Sequence (NamedType SimpleSectionType)
t) = String
-> NavTocHeading
-> Sequence (NamedType SimpleSectionType)
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
introExtroTP' String
"intro" NavTocHeading
nth Sequence (NamedType SimpleSectionType)
t

extroTP
    :: DocumentExtroType
    -> FlaggedInputTree'
    -> FootnoteTreeParser (Flagged' (NavTocHeaded (Parsed DocumentExtro)))
extroTP :: DocumentExtroType
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
extroTP = (DocumentExtroType
 -> Tree Bool (Maybe Text) Text
 -> FootnoteWriterT
      TreeParser (NavTocHeaded (Parsed DocumentIntro)))
-> DocumentExtroType
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
forall (m :: * -> *) t flag a b c.
(MonadTreeParser m, ProperNodeKind t) =>
(t -> Tree flag a b -> m c)
-> t -> FlaggedTree flag a b -> m (Flagged flag c)
flaggedTreePF DocumentExtroType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
aux
  where
    aux :: DocumentExtroType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
aux (DocumentExtroType NavTocHeading
nth Sequence (NamedType SimpleSectionType)
t) = String
-> NavTocHeading
-> Sequence (NamedType SimpleSectionType)
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
introExtroTP' String
"extro" NavTocHeading
nth Sequence (NamedType SimpleSectionType)
t

introExtroTP'
    :: String
    -> NavTocHeading
    -> Sequence (NamedType SimpleSectionType)
    -> InputTree'
    -> FootnoteTreeParser (NavTocHeaded (Parsed [SimpleSection]))
introExtroTP' :: String
-> NavTocHeading
-> Sequence (NamedType SimpleSectionType)
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
introExtroTP' String
_ NavTocHeading
nth Sequence (NamedType SimpleSectionType)
t (Leaf Text
x) =
    NavTocHeading
-> Parsed DocumentIntro -> NavTocHeaded (Parsed DocumentIntro)
forall a. NavTocHeading -> a -> NavTocHeaded a
NavTocHeaded NavTocHeading
nth
        (Parsed DocumentIntro -> NavTocHeaded (Parsed DocumentIntro))
-> FootnoteWriterT TreeParser (Parsed DocumentIntro)
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FootnoteParser DocumentIntro
-> Text -> FootnoteWriterT TreeParser (Parsed DocumentIntro)
forall a. FootnoteParser a -> Text -> FootnoteTreeParser (Parsed a)
leafFootnoteParser (Sequence SimpleSectionType
-> Parser () -> FootnoteParser DocumentIntro
simpleSectionSequenceP ((NamedType SimpleSectionType -> SimpleSectionType)
-> Sequence (NamedType SimpleSectionType)
-> Sequence SimpleSectionType
forall a b. (a -> b) -> Sequence a -> Sequence b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedType SimpleSectionType -> SimpleSectionType
forall t. NamedType t -> t
unwrapNT Sequence (NamedType SimpleSectionType)
t) Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Text
x
introExtroTP' String
ename NavTocHeading
_ Sequence (NamedType SimpleSectionType)
_ Tree Bool (Maybe Text) Text
_ = String
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
forall a. String -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> FootnoteWriterT
      TreeParser (NavTocHeaded (Parsed DocumentIntro)))
-> String
-> FootnoteWriterT TreeParser (NavTocHeaded (Parsed DocumentIntro))
forall a b. (a -> b) -> a -> b
$ String
"Document " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not leaf"

mainTP
    :: Disjunction (NamedType DocumentMainBodyType)
    -> FlaggedInputTree'
    -> FootnoteTreeParser (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
mainTP :: Disjunction (NamedType DocumentMainBodyType)
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
mainTP = (DocumentMainBodyType
 -> Tree Bool (Maybe Text) Text
 -> FootnoteWriterT
      TreeParser (NavTocHeaded (Parsed DocumentMainBody)))
-> Disjunction (NamedType DocumentMainBodyType)
-> FlaggedInputTree'
-> FootnoteTreeParser
     (Flagged' (NavTocHeaded (Parsed DocumentMainBody)))
forall (m :: * -> *) t flag a b c.
(MonadTreeParser m, RawProperNodeKind t) =>
(t -> Tree flag a b -> m c)
-> Disjunction (NamedType t)
-> FlaggedTree flag a b
-> m (Flagged flag c)
disjNFlaggedTreePF DocumentMainBodyType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT
     TreeParser (NavTocHeaded (Parsed DocumentMainBody))
aux
  where
    aux
        :: DocumentMainBodyType
        -> InputTree'
        -> FootnoteTreeParser (NavTocHeaded (Parsed DocumentMainBody))
    aux :: DocumentMainBodyType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT
     TreeParser (NavTocHeaded (Parsed DocumentMainBody))
aux (DocumentMainBodyType NavTocHeading
nth SectionBodyType
t) Tree Bool (Maybe Text) Text
tree = NavTocHeading
-> Parsed DocumentMainBody
-> NavTocHeaded (Parsed DocumentMainBody)
forall a. NavTocHeading -> a -> NavTocHeaded a
NavTocHeaded NavTocHeading
nth (Parsed DocumentMainBody -> NavTocHeaded (Parsed DocumentMainBody))
-> FootnoteWriterT TreeParser (Parsed DocumentMainBody)
-> FootnoteWriterT
     TreeParser (NavTocHeaded (Parsed DocumentMainBody))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (Parsed DocumentMainBody)
aux' Tree Bool (Maybe Text) Text
tree
      where
        aux' :: InputTree' -> FootnoteTreeParser (Parsed SectionBody)
        aux' :: Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (Parsed DocumentMainBody)
aux' (Leaf Text
x) = FootnoteParser DocumentMainBody
-> Text -> FootnoteWriterT TreeParser (Parsed DocumentMainBody)
forall a. FootnoteParser a -> Text -> FootnoteTreeParser (Parsed a)
leafFootnoteParser (SectionBodyType -> Parser () -> FootnoteParser DocumentMainBody
sectionBodyP SectionBodyType
t Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Text
x
        aux' (Tree (Just Text
_) [FlaggedInputTree']
_) = String -> FootnoteWriterT TreeParser (Parsed DocumentMainBody)
forall a. String -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Document main body has header"
        aux' (Tree Maybe Text
Nothing [FlaggedInputTree']
trees) = DocumentMainBody -> Parsed DocumentMainBody
forall a b. b -> Either a b
Right (DocumentMainBody -> Parsed DocumentMainBody)
-> FootnoteWriterT TreeParser DocumentMainBody
-> FootnoteWriterT TreeParser (Parsed DocumentMainBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SectionBodyType
-> [FlaggedInputTree']
-> FootnoteWriterT TreeParser DocumentMainBody
sectionBodyTP SectionBodyType
t [FlaggedInputTree']
trees