module Language.Ltml.Tree.Parser.Section
    ( sectionTP
    , sectionBodyTP
    )
where

import Control.Functor.Utils (sequenceEither, traverseF)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import Language.Lsd.AST.Common (Keyword)
import Language.Lsd.AST.SimpleRegex (Star (Star))
import Language.Lsd.AST.Type (NamedType)
import Language.Lsd.AST.Type.Section
    ( FormattedSectionType
    , HeadingType
    , SectionBodyType (InnerSectionBodyType)
    , SectionFormatted (SectionFormatted)
    , SectionType (SectionType)
    )
import Language.Ltml.AST.Node (Node)
import Language.Ltml.AST.Section
    ( FormattedSection
    , Heading
    , Section (Section)
    , SectionBody (InnerSectionBody)
    )
import Language.Ltml.Common (Flagged', Parsed)
import Language.Ltml.Parser.Section (headingP, sectionP)
import Language.Ltml.Tree (FlaggedInputTree', InputTree', Tree (Leaf, Tree))
import Language.Ltml.Tree.Parser
    ( FootnoteTreeParser
    , leafFootnoteParser
    , nFlaggedTreePF
    )
import Text.Megaparsec (eof)

{-# ANN sectionTP "HLint: ignore Avoid lambda using `infix`" #-}
sectionTP
    :: NamedType FormattedSectionType
    -> FlaggedInputTree'
    -> FootnoteTreeParser (Flagged' FormattedSection)
sectionTP :: NamedType FormattedSectionType
-> FlaggedInputTree'
-> FootnoteTreeParser (Flagged' FormattedSection)
sectionTP = (FormattedSectionType
 -> Tree Bool (Maybe Text) Text
 -> FootnoteWriterT TreeParser FormattedSection)
-> NamedType FormattedSectionType
-> FlaggedInputTree'
-> FootnoteTreeParser (Flagged' FormattedSection)
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 FormattedSectionType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser FormattedSection
sectionTP'
  where
    sectionTP'
        :: FormattedSectionType
        -> InputTree'
        -> FootnoteTreeParser FormattedSection
    sectionTP' :: FormattedSectionType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser FormattedSection
sectionTP' (SectionFormatted SectionType
t :| [SectionFormatted SectionType]
ts) Tree Bool (Maybe Text) Text
tree = (SectionFormatted SectionType
 -> FootnoteWriterT TreeParser FormattedSection
 -> FootnoteWriterT TreeParser FormattedSection)
-> FootnoteWriterT TreeParser FormattedSection
-> [SectionFormatted SectionType]
-> FootnoteWriterT TreeParser FormattedSection
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FootnoteWriterT TreeParser FormattedSection
-> FootnoteWriterT TreeParser FormattedSection
-> FootnoteWriterT TreeParser FormattedSection
altSelector (FootnoteWriterT TreeParser FormattedSection
 -> FootnoteWriterT TreeParser FormattedSection
 -> FootnoteWriterT TreeParser FormattedSection)
-> (SectionFormatted SectionType
    -> FootnoteWriterT TreeParser FormattedSection)
-> SectionFormatted SectionType
-> FootnoteWriterT TreeParser FormattedSection
-> FootnoteWriterT TreeParser FormattedSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Bool (Maybe Text) Text
-> SectionFormatted SectionType
-> FootnoteWriterT TreeParser FormattedSection
singleSectionTP' Tree Bool (Maybe Text) Text
tree) (Tree Bool (Maybe Text) Text
-> SectionFormatted SectionType
-> FootnoteWriterT TreeParser FormattedSection
singleSectionTP' Tree Bool (Maybe Text) Text
tree SectionFormatted SectionType
t) [SectionFormatted SectionType]
ts

    altSelector
        :: FootnoteTreeParser FormattedSection
        -> FootnoteTreeParser FormattedSection
        -> FootnoteTreeParser FormattedSection
    altSelector :: FootnoteWriterT TreeParser FormattedSection
-> FootnoteWriterT TreeParser FormattedSection
-> FootnoteWriterT TreeParser FormattedSection
altSelector FootnoteWriterT TreeParser FormattedSection
l FootnoteWriterT TreeParser FormattedSection
r = do
        FormattedSection
l' <- FootnoteWriterT TreeParser FormattedSection
l
        case FormattedSection
l' of
            SectionFormatted SectionFormat
_ (Right Node Section
_) -> FormattedSection -> FootnoteWriterT TreeParser FormattedSection
forall a. a -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. Monad m => a -> m a
return FormattedSection
l'
            FormattedSection
_ -> FootnoteWriterT TreeParser FormattedSection
r

    -- baseSelection :: FootnoteTreeParser FormattedSection
    -- baseSelection = fail "no valid alternative found"

    singleSectionTP'
        :: InputTree'
        -> SectionFormatted SectionType
        -> FootnoteTreeParser FormattedSection
    singleSectionTP' :: Tree Bool (Maybe Text) Text
-> SectionFormatted SectionType
-> FootnoteWriterT TreeParser FormattedSection
singleSectionTP' Tree Bool (Maybe Text) Text
tree = (SectionType
 -> FootnoteWriterT TreeParser (Either ParseError (Node Section)))
-> SectionFormatted SectionType
-> FootnoteWriterT TreeParser 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
t -> SectionType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (Either ParseError (Node Section))
sectionTP'' SectionType
t Tree Bool (Maybe Text) Text
tree)

    sectionTP''
        :: SectionType
        -> InputTree'
        -> FootnoteTreeParser (Parsed (Node Section))
    sectionTP'' :: SectionType
-> Tree Bool (Maybe Text) Text
-> FootnoteWriterT TreeParser (Either ParseError (Node Section))
sectionTP'' SectionType
t (Leaf Text
x) = FootnoteParser (Node Section)
-> Text
-> FootnoteWriterT TreeParser (Either ParseError (Node Section))
forall a. FootnoteParser a -> Text -> FootnoteTreeParser (Parsed a)
leafFootnoteParser (SectionType -> Parser () -> FootnoteParser (Node Section)
sectionP SectionType
t Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Text
x
    sectionTP'' (SectionType Keyword
kw HeadingType
headingT SectionBodyType
bodyT) (Tree Maybe Text
x [FlaggedInputTree']
children) = do
        Node (Either ParseError Heading)
wHeading <- Either ParseError (Node Heading)
-> Node (Either ParseError Heading)
forall (f :: * -> *) e a.
Pure f =>
Either e (f a) -> f (Either e a)
sequenceEither (Either ParseError (Node Heading)
 -> Node (Either ParseError Heading))
-> FootnoteWriterT TreeParser (Either ParseError (Node Heading))
-> FootnoteWriterT TreeParser (Node (Either ParseError Heading))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Keyword
-> HeadingType
-> Maybe Text
-> FootnoteWriterT TreeParser (Either ParseError (Node Heading))
headingTP Keyword
kw HeadingType
headingT Maybe Text
x
        SectionBody
body <- SectionBodyType
-> [FlaggedInputTree'] -> FootnoteTreeParser SectionBody
sectionBodyTP SectionBodyType
bodyT [FlaggedInputTree']
children
        Either ParseError (Node Section)
-> FootnoteWriterT TreeParser (Either ParseError (Node Section))
forall a. a -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Node Section)
 -> FootnoteWriterT TreeParser (Either ParseError (Node Section)))
-> Either ParseError (Node Section)
-> FootnoteWriterT TreeParser (Either ParseError (Node Section))
forall a b. (a -> b) -> a -> b
$ Node Section -> Either ParseError (Node Section)
forall a b. b -> Either a b
Right (Node Section -> Either ParseError (Node Section))
-> Node Section -> Either ParseError (Node Section)
forall a b. (a -> b) -> a -> b
$ (Either ParseError Heading -> Section)
-> Node (Either ParseError Heading) -> Node Section
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Either ParseError Heading
heading -> Either ParseError Heading -> SectionBody -> Section
Section Either ParseError Heading
heading SectionBody
body) Node (Either ParseError Heading)
wHeading

headingTP
    :: Keyword
    -> HeadingType
    -> Maybe Text
    -> FootnoteTreeParser (Parsed (Node Heading))
headingTP :: Keyword
-> HeadingType
-> Maybe Text
-> FootnoteWriterT TreeParser (Either ParseError (Node Heading))
headingTP Keyword
kw HeadingType
t (Just Text
x) = FootnoteParser (Node Heading)
-> Text
-> FootnoteWriterT TreeParser (Either ParseError (Node Heading))
forall a. FootnoteParser a -> Text -> FootnoteTreeParser (Parsed a)
leafFootnoteParser (Keyword -> HeadingType -> FootnoteParser (Node Heading)
forall (f :: * -> *).
HangingTextP f =>
Keyword -> HeadingType -> FootnoteParser (f Heading)
headingP Keyword
kw HeadingType
t) Text
x
headingTP Keyword
_ HeadingType
_ Maybe Text
Nothing = String
-> FootnoteWriterT TreeParser (Either ParseError (Node Heading))
forall a. String -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Section lacks heading"

sectionBodyTP
    :: SectionBodyType
    -> [FlaggedInputTree']
    -> FootnoteTreeParser SectionBody
sectionBodyTP :: SectionBodyType
-> [FlaggedInputTree'] -> FootnoteTreeParser SectionBody
sectionBodyTP (InnerSectionBodyType (Star NamedType FormattedSectionType
nt)) [FlaggedInputTree']
trees =
    [Flagged' FormattedSection] -> SectionBody
InnerSectionBody ([Flagged' FormattedSection] -> SectionBody)
-> FootnoteWriterT TreeParser [Flagged' FormattedSection]
-> FootnoteTreeParser SectionBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FlaggedInputTree'
 -> FootnoteTreeParser (Flagged' FormattedSection))
-> [FlaggedInputTree']
-> FootnoteWriterT TreeParser [Flagged' FormattedSection]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (NamedType FormattedSectionType
-> FlaggedInputTree'
-> FootnoteTreeParser (Flagged' FormattedSection)
sectionTP NamedType FormattedSectionType
nt) [FlaggedInputTree']
trees
sectionBodyTP SectionBodyType
_ [FlaggedInputTree']
_ = String -> FootnoteTreeParser SectionBody
forall a. String -> FootnoteWriterT TreeParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid section body kind"