module Language.Ltml.Parser.Section
    ( sectionP
    , sectionBodyP
    , headingP
    )
where

import Control.Applicative ((<|>))
import Control.Functor.Utils (traverseF)
import Control.Monad (void)
import Data.List.NonEmpty (NonEmpty (..))
import Language.Lsd.AST.Common (Keyword)
import Language.Lsd.AST.SimpleRegex (Star (Star))
import Language.Lsd.AST.Type (unwrapNT)
import Language.Lsd.AST.Type.Section
    ( FormattedSectionType
    , HeadingType (HeadingType)
    , SectionBodyType (..)
    , SectionFormatted (SectionFormatted)
    , SectionType (SectionType)
    )
import Language.Ltml.AST.Node (Node (Node))
import Language.Ltml.AST.Section
    ( FormattedSection
    , Heading (Heading)
    , Section (Section)
    , SectionBody (..)
    )
import Language.Ltml.Common (Flagged (Flagged))
import Language.Ltml.Parser (Parser)
import Language.Ltml.Parser.Common.Lexeme (nLexeme)
import Language.Ltml.Parser.Footnote (FootnoteParser)
import Language.Ltml.Parser.Footnote.Combinators
    ( manyWithFootnotesTillSucc
    , withSucceedingFootnotes
    )
import Language.Ltml.Parser.Keyword (keywordP)
import Language.Ltml.Parser.Paragraph (paragraphP)
import Language.Ltml.Parser.SimpleBlock (simpleBlockP)
import Language.Ltml.Parser.Text (HangingTextP, hangingTextP')
import Text.Megaparsec (MonadParsec (try), choice, many)

sectionP :: SectionType -> Parser () -> FootnoteParser (Node Section)
sectionP :: SectionType -> Parser () -> FootnoteParser (Node Section)
sectionP (SectionType Keyword
kw HeadingType
headingT SectionBodyType
bodyT) Parser ()
succStartP = do
    (Maybe Label
mLabel, Heading
heading) <- Keyword -> HeadingType -> FootnoteParser (Maybe Label, Heading)
forall (f :: * -> *).
HangingTextP f =>
Keyword -> HeadingType -> FootnoteParser (f Heading)
headingP Keyword
kw HeadingType
headingT
    SectionBody
body <- SectionBodyType -> Parser () -> FootnoteParser SectionBody
sectionBodyP SectionBodyType
bodyT Parser ()
succStartP
    Node Section -> FootnoteParser (Node Section)
forall a. a -> FootnoteWriterT (ParsecT Void Text Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Node Section -> FootnoteParser (Node Section))
-> Node Section -> FootnoteParser (Node Section)
forall a b. (a -> b) -> a -> b
$ Maybe Label -> Section -> Node Section
forall a. Maybe Label -> a -> Node a
Node Maybe Label
mLabel (Section -> Node Section) -> Section -> Node Section
forall a b. (a -> b) -> a -> b
$ Parsed Heading -> SectionBody -> Section
Section (Heading -> Parsed Heading
forall a b. b -> Either a b
Right Heading
heading) SectionBody
body

sectionP'
    :: FormattedSectionType -> Parser () -> FootnoteParser FormattedSection
sectionP' :: FormattedSectionType
-> Parser () -> FootnoteParser FormattedSection
sectionP' (SectionFormatted SectionType
t :| [SectionFormatted SectionType]
ts) Parser ()
succStartP = [FootnoteParser FormattedSection]
-> FootnoteParser FormattedSection
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((SectionFormatted SectionType -> FootnoteParser FormattedSection)
-> [SectionFormatted SectionType]
-> [FootnoteParser FormattedSection]
forall a b. (a -> b) -> [a] -> [b]
map (FootnoteParser FormattedSection -> FootnoteParser FormattedSection
forall a.
FootnoteWriterT (ParsecT Void Text Identity) a
-> FootnoteWriterT (ParsecT Void Text Identity) a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (FootnoteParser FormattedSection
 -> FootnoteParser FormattedSection)
-> (SectionFormatted SectionType
    -> FootnoteParser FormattedSection)
-> SectionFormatted SectionType
-> FootnoteParser FormattedSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser ()
-> SectionFormatted SectionType -> FootnoteParser FormattedSection
singleSectionP' Parser ()
succStartP) ([SectionFormatted SectionType]
ts [SectionFormatted SectionType]
-> [SectionFormatted SectionType] -> [SectionFormatted SectionType]
forall a. [a] -> [a] -> [a]
++ [SectionFormatted SectionType
t]))
  where
    singleSectionP'
        :: Parser ()
        -> SectionFormatted SectionType
        -> FootnoteParser FormattedSection
    singleSectionP' :: Parser ()
-> SectionFormatted SectionType -> FootnoteParser FormattedSection
singleSectionP' Parser ()
succStartP' = (SectionType
 -> FootnoteWriterT
      (ParsecT Void Text Identity) (Parsed (Node Section)))
-> SectionFormatted SectionType -> FootnoteParser FormattedSection
forall (t :: * -> *) (f :: * -> *) a b.
(TraversableF t, Functor f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Functor f =>
(a -> f b) -> SectionFormatted a -> f (SectionFormatted b)
traverseF (\SectionType
st -> Node Section -> Parsed (Node Section)
forall a b. b -> Either a b
Right (Node Section -> Parsed (Node Section))
-> FootnoteParser (Node Section)
-> FootnoteWriterT
     (ParsecT Void Text Identity) (Parsed (Node Section))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SectionType -> Parser () -> FootnoteParser (Node Section)
sectionP SectionType
st Parser ()
succStartP')

sectionBodyP :: SectionBodyType -> Parser () -> FootnoteParser SectionBody
sectionBodyP :: SectionBodyType -> Parser () -> FootnoteParser SectionBody
sectionBodyP SectionBodyType
t0 Parser ()
succStartP = SectionBodyType -> FootnoteParser SectionBody
bodyP SectionBodyType
t0
  where
    bodyP :: SectionBodyType -> FootnoteParser SectionBody
    bodyP :: SectionBodyType -> FootnoteParser SectionBody
bodyP (InnerSectionBodyType (Star NamedType FormattedSectionType
t)) =
        [Flagged' FormattedSection] -> SectionBody
InnerSectionBody
            ([Flagged' FormattedSection] -> SectionBody)
-> FootnoteWriterT
     (ParsecT Void Text Identity) [Flagged' FormattedSection]
-> FootnoteParser SectionBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FootnoteWriterT
  (ParsecT Void Text Identity) (Flagged' FormattedSection)
-> FootnoteWriterT
     (ParsecT Void Text Identity) [Flagged' FormattedSection]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many
                ( Bool -> FormattedSection -> Flagged' FormattedSection
forall flag a. flag -> a -> Flagged flag a
Flagged Bool
False
                    (FormattedSection -> Flagged' FormattedSection)
-> FootnoteParser FormattedSection
-> FootnoteWriterT
     (ParsecT Void Text Identity) (Flagged' FormattedSection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormattedSectionType
-> Parser () -> FootnoteParser FormattedSection
sectionP' FormattedSectionType
t' (FormattedSectionType -> Parser ()
toStartP FormattedSectionType
t' Parser () -> Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
succStartP)
                )
      where
        t' :: FormattedSectionType
t' = NamedType FormattedSectionType -> FormattedSectionType
forall t. NamedType t -> t
unwrapNT NamedType FormattedSectionType
t
    bodyP (LeafSectionBodyType (Star NamedType ParagraphType
t)) =
        [Node Paragraph] -> SectionBody
LeafSectionBody
            ([Node Paragraph] -> SectionBody)
-> FootnoteWriterT (ParsecT Void Text Identity) [Node Paragraph]
-> FootnoteParser SectionBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Node Paragraph)
-> Parser ()
-> FootnoteWriterT (ParsecT Void Text Identity) [Node Paragraph]
forall a. Parser a -> Parser () -> FootnoteParser [a]
manyWithFootnotesTillSucc (ParagraphType -> Parser (Node Paragraph)
paragraphP (ParagraphType -> Parser (Node Paragraph))
-> ParagraphType -> Parser (Node Paragraph)
forall a b. (a -> b) -> a -> b
$ NamedType ParagraphType -> ParagraphType
forall t. NamedType t -> t
unwrapNT NamedType ParagraphType
t) Parser ()
succStartP
    bodyP (SimpleLeafSectionBodyType (Star NamedType SimpleBlockType
t)) =
        [SimpleBlock] -> SectionBody
SimpleLeafSectionBody
            ([SimpleBlock] -> SectionBody)
-> FootnoteWriterT (ParsecT Void Text Identity) [SimpleBlock]
-> FootnoteParser SectionBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SimpleBlock
-> Parser ()
-> FootnoteWriterT (ParsecT Void Text Identity) [SimpleBlock]
forall a. Parser a -> Parser () -> FootnoteParser [a]
manyWithFootnotesTillSucc
                (SimpleBlockType -> Parser SimpleBlock
simpleBlockP (SimpleBlockType -> Parser SimpleBlock)
-> SimpleBlockType -> Parser SimpleBlock
forall a b. (a -> b) -> a -> b
$ NamedType SimpleBlockType -> SimpleBlockType
forall t. NamedType t -> t
unwrapNT NamedType SimpleBlockType
t)
                Parser ()
succStartP

toStartP :: FormattedSectionType -> Parser ()
toStartP :: FormattedSectionType -> Parser ()
toStartP (SectionFormatted SectionType
t :| [SectionFormatted SectionType]
ts) = [Parser ()] -> Parser ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ((SectionFormatted SectionType -> Parser ())
-> [SectionFormatted SectionType] -> [Parser ()]
forall a b. (a -> b) -> [a] -> [b]
map (Parser () -> Parser ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser () -> Parser ())
-> (SectionFormatted SectionType -> Parser ())
-> SectionFormatted SectionType
-> Parser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionFormatted SectionType -> Parser ()
toStartP') ([SectionFormatted SectionType]
ts [SectionFormatted SectionType]
-> [SectionFormatted SectionType] -> [SectionFormatted SectionType]
forall a. [a] -> [a] -> [a]
++ [SectionFormatted SectionType
t]))
  where
    toStartP' :: SectionFormatted SectionType -> Parser ()
    toStartP' :: SectionFormatted SectionType -> Parser ()
toStartP' (SectionFormatted SectionFormat
_ (SectionType Keyword
kw HeadingType
_ SectionBodyType
_)) = Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Keyword -> Parser ()
forall (m :: * -> *). MonadParser m => Keyword -> m ()
keywordP Keyword
kw

headingP
    :: (HangingTextP f)
    => Keyword
    -> HeadingType
    -> FootnoteParser (f Heading)
headingP :: forall (f :: * -> *).
HangingTextP f =>
Keyword -> HeadingType -> FootnoteParser (f Heading)
headingP Keyword
kw (HeadingType InnerHeadingFormat
fmt TextType Void
tt) =
    Parser (f Heading) -> FootnoteParser (f Heading)
forall a. Parser a -> FootnoteParser a
withSucceedingFootnotes (Parser (f Heading) -> FootnoteParser (f Heading))
-> Parser (f Heading) -> FootnoteParser (f Heading)
forall a b. (a -> b) -> a -> b
$
        Parser (f Heading) -> Parser (f Heading)
forall (m :: * -> *) a. MonadParser m => m a -> m a
nLexeme (Parser (f Heading) -> Parser (f Heading))
-> Parser (f Heading) -> Parser (f Heading)
forall a b. (a -> b) -> a -> b
$
            ([HeadingTextTree] -> Heading) -> f [HeadingTextTree] -> f Heading
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InnerHeadingFormat -> [HeadingTextTree] -> Heading
Heading InnerHeadingFormat
fmt) (f [HeadingTextTree] -> f Heading)
-> ParsecT Void Text Identity (f [HeadingTextTree])
-> Parser (f Heading)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Keyword
-> TextType Void
-> ParsecT Void Text Identity (f [HeadingTextTree])
forall (f :: * -> *) (m :: * -> *) lbrk fnref style enumType enum
       special.
(HangingTextP f, ParserWrapper m, LineBreakP lbrk,
 FootnoteRefP fnref, StyleP style, EnumP enumType enum,
 SpecialP m special) =>
Keyword
-> TextType enumType
-> m (f [TextTree lbrk fnref style enum special])
forall (m :: * -> *) lbrk fnref style enumType enum special.
(ParserWrapper m, LineBreakP lbrk, FootnoteRefP fnref,
 StyleP style, EnumP enumType enum, SpecialP m special) =>
Keyword
-> TextType enumType
-> m (f [TextTree lbrk fnref style enum special])
hangingTextP' Keyword
kw TextType Void
tt