{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.HTML.ToHtmlM (toHtmlM) where

import Control.Monad (join, zipWithM)
import Control.Monad.Reader
import Control.Monad.State
import Data.DList (toList)
import Data.Either (rights)
import qualified Data.Map as Map
import Data.Maybe (isJust)
import qualified Data.Set as Set
import Data.Text (Text, unpack)
import Data.Void (Void, absurd)
import Language.Lsd.AST.Common (Fallback (..), NavTocHeading (..))
import Language.Lsd.AST.Format (HeadingFormat)
import Language.Lsd.AST.Type.AppendixSection
    ( AppendixElementFormat (..)
    , AppendixSectionFormat (..)
    , AppendixSectionTitle (..)
    )
import Language.Lsd.AST.Type.Document
    ( DocumentFormat (..)
    , TocFormat (..)
    , TocHeading (..)
    )
import Language.Lsd.AST.Type.DocumentContainer
    ( DocumentContainerFormat (..)
    , MainDocumentFormat (..)
    )
import Language.Lsd.AST.Type.Enum (EnumFormat (..), EnumItemFormat (..))
import Language.Lsd.AST.Type.Footnote
    ( FootnoteFormat (SuperscriptFootnoteFormat)
    )
import Language.Lsd.AST.Type.Section (SectionFormatted (..))
import Language.Lsd.AST.Type.SimpleParagraph (SimpleParagraphFormat (..))
import Language.Lsd.AST.Type.SimpleSection (SimpleSectionFormat (..))
import Language.Lsd.AST.Type.Table (CellFormat (..))
import Language.Ltml.AST.AppendixSection (AppendixSection (..))
import Language.Ltml.AST.Document
import Language.Ltml.AST.DocumentContainer
    ( DocumentContainer (..)
    , DocumentContainerHeader (..)
    )
import Language.Ltml.AST.Footnote (Footnote (..))
import Language.Ltml.AST.Label (Label (..))
import Language.Ltml.AST.Node (Node (..))
import Language.Ltml.AST.Paragraph (Paragraph (..))
import Language.Ltml.AST.Section
import Language.Ltml.AST.SimpleBlock (SimpleBlock (..))
import Language.Ltml.AST.SimpleParagraph (SimpleParagraph (..))
import Language.Ltml.AST.SimpleSection (SimpleSection (..))
import Language.Ltml.AST.Table (Cell (..), Row (..), Table (..))
import Language.Ltml.AST.Text
import Language.Ltml.Common (Flagged (..), Flagged', NavTocHeaded (..), Parsed)
import Language.Ltml.HTML.CSS.Classes (ToCssClass (toCssClass))
import qualified Language.Ltml.HTML.CSS.Classes as Class
import Language.Ltml.HTML.CSS.Util
import Language.Ltml.HTML.Common
import Language.Ltml.HTML.FormatString
import Language.Ltml.HTML.References
import Language.Ltml.HTML.Util
import Lucid
import Text.Megaparsec (ParseErrorBundle, errorBundlePretty)

-- | Monadic Class to render @a@ to @Delayed (Html ())@
--   using a @Reader@ and a @State@ Monad
class ToHtmlM a where
    toHtmlM :: a -> HtmlReaderState

instance ToHtmlM DocumentContainer where
    toHtmlM :: DocumentContainer -> HtmlReaderState
toHtmlM
        ( DocumentContainer
                ( DocumentContainerFormat
                        HeaderFooterFormat
_
                        HeaderFooterFormat
_
                        (MainDocumentFormat Fallback NavTocHeading
fallbackDocHeading MainHeadingFormat
docHeadingFormat)
                    )
                NavTocHeaded (Parsed DocumentContainerHeader)
navTocParsedHeader
                Flagged' Document
doc
                [Flagged' AppendixSection]
appendices
            ) = do
            (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {documentFallbackTitle = fallbackDocHeading})
            -- \| Header is rendered to mempty, but this might generate an error box
            Delayed (HtmlT Identity ())
headerHtml <- NavTocHeaded (Parsed DocumentContainerHeader) -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM NavTocHeaded (Parsed DocumentContainerHeader)
navTocParsedHeader
            -- \| Main Document has a global ToC, appendices typically do not
            Delayed (HtmlT Identity ())
mainDocHtml <-
                (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
                    ( \ReaderState
s ->
                        ReaderState
s
                            { hasGlobalToC = True
                            , documentHeadingFormat = Left docHeadingFormat
                            }
                    )
                    (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Flagged' Document -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Flagged' Document
doc
            ReaderState
readerState <- ReaderT ReaderState (State GlobalState) ReaderState
forall r (m :: * -> *). MonadReader r m => m r
ask
            Delayed (HtmlT Identity ())
appendicesHtml <-
                (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {hasGlobalToC = appendixHasGlobalToC readerState}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
                    [Flagged' AppendixSection] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [Flagged' AppendixSection]
appendices
            -- Render Header only if whole DocumentContainer should be rendered
            Bool
render <- (ReaderState -> Bool)
-> ReaderT ReaderState (State GlobalState) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Bool
shouldRender
            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
                (if Bool
render then Delayed (HtmlT Identity ())
headerHtml else Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty)
                    Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
mainDocHtml
                    Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
appendicesHtml

-- | Ignore Header since it only defines PDF related stuff
instance ToHtmlM DocumentContainerHeader where
    toHtmlM :: DocumentContainerHeader -> HtmlReaderState
toHtmlM DocumentContainerHeader
_ = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty

-- | This instance is used for documents inside the appendix,
--   since the main document does not have a label.
instance ToHtmlM (Node Document) where
    toHtmlM :: Node Document -> HtmlReaderState
toHtmlM (Node Maybe Label
mLabel Document
doc) = do
        Int
appendixDocID <- (ReaderState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Int
currentAppendixElementID
        Maybe Label
-> HtmlT Identity () -> ReaderT ReaderState (State GlobalState) ()
addMaybeLabelToState Maybe Label
mLabel (String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Identity ()) -> String -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
appendixDocID)
        (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {appendixElementMLabel = mLabel}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Document -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Document
doc

instance ToHtmlM Document where
    -- \| builds Lucid 2 HTML from a Ltml Document AST
    toHtmlM :: Document -> HtmlReaderState
toHtmlM
        ( Document
                (DocumentFormat Maybe TocFormat
mTocFormat)
                Parsed DocumentHeading
documentHeading
                (DocumentBody Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
introSSections Flagged' (NavTocHeaded (Parsed DocumentMainBody))
sectionBody Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
outroSSections)
                Map Label Footnote
footNotes
            ) =
            (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {footnoteMap = footNotes}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ do
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
                    ( \GlobalState
s ->
                        GlobalState
s
                            { -- \| Reset used footnotes (footnotes are document-scoped)
                              usedFootnoteMap = usedFootnoteMap initGlobalState
                            , -- \| Reset footnote counter for this document
                              currentFootnoteID = currentFootnoteID initGlobalState
                            , -- \| Reset Section counters for this document
                              currentSectionID = currentSectionID initGlobalState
                            , currentSuperSectionID = currentSuperSectionID initGlobalState
                            }
                    )
                -- Note: Footnotes referenced in this Heading
                --       are rendered in the first child SectionBody
                -- TODO: This might be hacky and leads to export views
                --       of the first child having a footnote that is not
                --       referenced. But for now this is acceptable (imho)
                Delayed (HtmlT Identity ())
titleHtml <- Parsed DocumentHeading -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Parsed DocumentHeading
documentHeading
                Bool
renderDoc <- (ReaderState -> Bool)
-> ReaderT ReaderState (State GlobalState) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Bool
shouldRender
                -- \| mTocFormat = Nothing, means that no ToC should be rendered
                let renderToC :: Bool
renderToC = Maybe TocFormat -> Bool
forall a. Maybe a -> Bool
isJust Maybe TocFormat
mTocFormat Bool -> Bool -> Bool
&& Bool
renderDoc

                -- \| If current Document has a local ToC its Sections
                --   should NOT appear in global ToC, thats why we save the current global ToC
                Bool
hasGlobalToc <- (ReaderState -> Bool)
-> ReaderT ReaderState (State GlobalState) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Bool
hasGlobalToC
                (Delayed (HtmlT Identity ())
tocHtml, Delayed (HtmlT Identity ())
introHtml, Delayed (HtmlT Identity ())
mainHtml, Delayed (HtmlT Identity ())
outroHtml) <-
                    if Bool
hasGlobalToc
                        then do
                            -- \| Render ToC but as a Later to use the final GlobalState
                            Delayed (HtmlT Identity ())
delayedTocHtml <- Maybe TocFormat -> HtmlReaderState
renderDelayedToc Maybe TocFormat
mTocFormat
                            Delayed (HtmlT Identity ())
introHtml <- Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
introSSections
                            Delayed (HtmlT Identity ())
mainHtml <- Flagged' (NavTocHeaded (Parsed DocumentMainBody))
-> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Flagged' (NavTocHeaded (Parsed DocumentMainBody))
sectionBody
                            Delayed (HtmlT Identity ())
outroHtml <- Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
outroSSections
                            (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
 Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ())
delayedTocHtml, Delayed (HtmlT Identity ())
introHtml, Delayed (HtmlT Identity ())
mainHtml, Delayed (HtmlT Identity ())
outroHtml)
                        else
                            -- \| Reset ToC temporarily to build a local ToC, then write back the global ToC
                            (GlobalState -> ToC)
-> (GlobalState -> ToC -> GlobalState)
-> ToC
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall (m :: * -> *) a b.
MonadState GlobalState m =>
(GlobalState -> a)
-> (GlobalState -> a -> GlobalState) -> a -> m b -> m b
withModified
                                GlobalState -> ToC
tableOfContents
                                (\GlobalState
s ToC
a -> GlobalState
s {tableOfContents = a})
                                (GlobalState -> ToC
tableOfContents GlobalState
initGlobalState)
                                (ReaderT
   ReaderState
   (State GlobalState)
   (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
    Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
 -> ReaderT
      ReaderState
      (State GlobalState)
      (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
       Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ())))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a b. (a -> b) -> a -> b
$ do
                                    Delayed (HtmlT Identity ())
introHtml <- Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
introSSections
                                    Delayed (HtmlT Identity ())
mainHtml <- Flagged' (NavTocHeaded (Parsed DocumentMainBody))
-> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Flagged' (NavTocHeaded (Parsed DocumentMainBody))
sectionBody
                                    Delayed (HtmlT Identity ())
outroHtml <- Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
-> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Maybe (Flagged' (NavTocHeaded (Parsed DocumentIntro)))
outroSSections
                                    -- \| Render ToC last so local ToC has all Headings set,
                                    --    since the local ToC uses the current State
                                    Delayed (HtmlT Identity ())
localTocHtml <- Maybe TocFormat -> HtmlReaderState
renderLocalToc Maybe TocFormat
mTocFormat
                                    (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
 Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ())
localTocHtml, Delayed (HtmlT Identity ())
introHtml, Delayed (HtmlT Identity ())
mainHtml, Delayed (HtmlT Identity ())
outroHtml)

                -- \| Render DocumentHeading / ToC only if renderFlag was set by parent
                Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
                    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.Document
                        (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( (if Bool
renderDoc then Delayed (HtmlT Identity ())
titleHtml else Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty)
                                Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
introHtml
                                Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> (if Bool
renderToC then Delayed (HtmlT Identity ())
tocHtml else Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty)
                                Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
mainHtml
                                Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
outroHtml
                            )

-- | Does not only produce the default error box on error,
--   but also handles ToC entries.
instance ToHtmlM (Parsed DocumentHeading) where
    toHtmlM :: Parsed DocumentHeading -> HtmlReaderState
toHtmlM Parsed DocumentHeading
eErrDocumentHeading = do
        -- \| Title which is used if a parse error occurs
        Fallback NavTocHeading
fallbackTitle <- (GlobalState -> Fallback NavTocHeading)
-> ReaderT ReaderState (State GlobalState) (Fallback NavTocHeading)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Fallback NavTocHeading
documentFallbackTitle
        (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
resType, Delayed (HtmlT Identity ())
tocTitleHtml, Delayed (HtmlT Identity ())
titleHtml) <- case Parsed DocumentHeading
eErrDocumentHeading of
            Left ParseError
_ -> do
                ReaderT ReaderState (State GlobalState) ()
setHasErrors
                Delayed (HtmlT Identity ())
failedHeadingTextHtml <- Fallback NavTocHeading -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Fallback NavTocHeading
fallbackTitle
                (Delayed (HtmlT Identity ())
 -> Result (Delayed (HtmlT Identity ())),
 Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ())
      -> Result (Delayed (HtmlT Identity ())),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
forall a. a -> Result a
Error, Delayed (HtmlT Identity ())
failedHeadingTextHtml, Delayed (HtmlT Identity ())
failedHeadingTextHtml)
            Right (DocumentHeading [HeadingTextTree]
headingTextTree) -> do
                (Delayed (HtmlT Identity ())
tocHeadingTextHtml, Delayed (HtmlT Identity ())
headingTextHtml) <- [HeadingTextTree]
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
tocHeadingHtml [HeadingTextTree]
headingTextTree
                -- \| Used for setting HTML title
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {mainDocumentTitle = headingText headingTextTree})
                (Delayed (HtmlT Identity ())
 -> Result (Delayed (HtmlT Identity ())),
 Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Delayed (HtmlT Identity ())
      -> Result (Delayed (HtmlT Identity ())),
      Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
forall a. a -> Result a
Success, Delayed (HtmlT Identity ())
tocHeadingTextHtml, Delayed (HtmlT Identity ())
headingTextHtml)
        -- \| Get HeadingFormat from DocumentContainer or AppendixSection
        Either MainHeadingFormat (HeadingFormat 'True)
headingFormatS <- (ReaderState -> Either MainHeadingFormat (HeadingFormat 'True))
-> ReaderT
     ReaderState
     (State GlobalState)
     (Either MainHeadingFormat (HeadingFormat 'True))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Either MainHeadingFormat (HeadingFormat 'True)
documentHeadingFormat
        -- \| Here we check if we are inside an appendix, since
        --   the appendix heading format has an id and the main documents has not
        (Maybe (HtmlT Identity ())
mIdHtml, Delayed (HtmlT Identity ())
formattedTitle, Maybe Label
mLabel) <- case Either MainHeadingFormat (HeadingFormat 'True)
headingFormatS of
            Left MainHeadingFormat
headFormat -> Delayed (HtmlT Identity ())
-> MainHeadingFormat
-> ReaderT
     ReaderState
     (State GlobalState)
     (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Maybe Label)
buildMainHeading Delayed (HtmlT Identity ())
titleHtml MainHeadingFormat
headFormat
            Right HeadingFormat 'True
headFormatId -> Delayed (HtmlT Identity ())
-> HeadingFormat 'True
-> ReaderT
     ReaderState
     (State GlobalState)
     (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Maybe Label)
buildAppendixHeading Delayed (HtmlT Identity ())
titleHtml HeadingFormat 'True
headFormatId
        Text
htmlId <- Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
-> Maybe Label
-> TocCategory
-> ReaderStateMonad Text
addTocEntry Maybe (HtmlT Identity ())
mIdHtml (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
resType Delayed (HtmlT Identity ())
tocTitleHtml) Maybe Label
mLabel TocCategory
Other
        -- \| In case of a parse error, output an error box
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
            (ParseError -> Delayed (HtmlT Identity ()))
-> (DocumentHeading -> Delayed (HtmlT Identity ()))
-> Parsed DocumentHeading
-> Delayed (HtmlT Identity ())
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
Now (HtmlT Identity () -> Delayed (HtmlT Identity ()))
-> (ParseError -> HtmlT Identity ())
-> ParseError
-> Delayed (HtmlT Identity ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> ParseError -> HtmlT Identity ()
parseErrorHtml (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
htmlId))
                ( Delayed (HtmlT Identity ())
-> DocumentHeading -> Delayed (HtmlT Identity ())
forall a b. a -> b -> a
const (Delayed (HtmlT Identity ())
 -> DocumentHeading -> Delayed (HtmlT Identity ()))
-> Delayed (HtmlT Identity ())
-> DocumentHeading
-> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$
                    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h1_ [Class -> Attributes
cssClass_ Class
Class.DocumentTitle, Class -> Attributes
cssClass_ Class
Class.Anchor, Text -> Attributes
id_ Text
htmlId]
                        (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
formattedTitle
                )
                Parsed DocumentHeading
eErrDocumentHeading
      where
        -- \| Main Document Heading without Id and without Label
        --    This should only be called once
        buildMainHeading
            :: Delayed (Html ())
            -> HeadingFormat False
            -> ReaderStateMonad (Maybe (Html ()), Delayed (Html ()), Maybe Label)
        buildMainHeading :: Delayed (HtmlT Identity ())
-> MainHeadingFormat
-> ReaderT
     ReaderState
     (State GlobalState)
     (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Maybe Label)
buildMainHeading Delayed (HtmlT Identity ())
dTitleHtml MainHeadingFormat
headFormat = do
            let formattedTitle :: Delayed (HtmlT Identity ())
formattedTitle = MainHeadingFormat -> HtmlT Identity () -> HtmlT Identity ()
headingFormat MainHeadingFormat
headFormat (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
dTitleHtml
            -- \| Used for adding title to exported sections
            (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {mainDocumentTitleHtml = formattedTitle})
            (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
 Maybe Label)
-> ReaderT
     ReaderState
     (State GlobalState)
     (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Maybe Label)
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (HtmlT Identity ())
forall a. Maybe a
Nothing, Delayed (HtmlT Identity ())
formattedTitle, Maybe Label
forall a. Maybe a
Nothing)

        -- \| Appendix Docuemnt Heading with Id and Label
        buildAppendixHeading
            :: Delayed (Html ())
            -> HeadingFormat True
            -> ReaderStateMonad (Maybe (Html ()), Delayed (Html ()), Maybe Label)
        buildAppendixHeading :: Delayed (HtmlT Identity ())
-> HeadingFormat 'True
-> ReaderT
     ReaderState
     (State GlobalState)
     (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Maybe Label)
buildAppendixHeading Delayed (HtmlT Identity ())
dTitleHtml HeadingFormat 'True
headFormatId = do
            -- \| Heading for Appendix Element (with id and toc key)
            Int
docId <- (ReaderState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Int
currentAppendixElementID
            IdentifierFormat
idFormat <- (ReaderState -> IdentifierFormat)
-> ReaderT ReaderState (State GlobalState) IdentifierFormat
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> IdentifierFormat
appendixElementIdFormat
            TocKeyFormat
tocFormat <- (ReaderState -> TocKeyFormat)
-> ReaderT ReaderState (State GlobalState) TocKeyFormat
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> TocKeyFormat
appendixElementTocKeyFormat
            let (Delayed (HtmlT Identity ())
headingHtml, HtmlT Identity ()
tocHtml) = IdentifierFormat
-> Int
-> TocKeyFormat
-> HeadingFormat 'True
-> Delayed (HtmlT Identity ())
-> (Delayed (HtmlT Identity ()), HtmlT Identity ())
appendixFormat IdentifierFormat
idFormat Int
docId TocKeyFormat
tocFormat HeadingFormat 'True
headFormatId Delayed (HtmlT Identity ())
dTitleHtml
            -- \| Check if current document has Label and build ToC entry
            Maybe Label
mLabel <- (ReaderState -> Maybe Label)
-> ReaderT ReaderState (State GlobalState) (Maybe Label)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Maybe Label
appendixElementMLabel
            (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
 Maybe Label)
-> ReaderT
     ReaderState
     (State GlobalState)
     (Maybe (HtmlT Identity ()), Delayed (HtmlT Identity ()),
      Maybe Label)
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlT Identity () -> Maybe (HtmlT Identity ())
forall a. a -> Maybe a
Just HtmlT Identity ()
tocHtml, Delayed (HtmlT Identity ())
headingHtml, Maybe Label
mLabel)

-------------------------------------------------------------------------------

-- | This combined instances creates the sectionIDHtml before building the reference,
--   which is needed for correct referencing
instance ToHtmlM (Node Section) where
    toHtmlM :: Node Section -> HtmlReaderState
toHtmlM
        ( Node
                Maybe Label
mLabel
                ( Section
                        Parsed Heading
parsedHeading
                        DocumentMainBody
sectionBody
                    )
            ) = do
            SectionFormat
sectionFormatS <- (ReaderState -> SectionFormat)
-> ReaderT ReaderState (State GlobalState) SectionFormat
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> SectionFormat
localSectionFormat
            let (GlobalState -> Int
sectionIDGetter, ReaderT r (State GlobalState) ()
incrementSectionID, Class
sectionCssClass) =
                    -- \| Check if we are inside a section or a super-section
                    -- TODO: Is (SimpleLeafSectionBody [SimpleBlocks]) counted as super-section? (i think yes)
                    case (DocumentMainBody -> Bool
isSuper DocumentMainBody
sectionBody, SectionFormat -> Bool
isInserted SectionFormat
sectionFormatS) of
                        (Bool
True, Bool
_) -> (GlobalState -> Int
currentSuperSectionID, ReaderT r (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
incSuperSectionID, Class
Class.SuperSection)
                        (Bool
False, Bool
True) -> (GlobalState -> Int
currentSectionID, ReaderT r (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
incInsertedSectionID, Class
Class.Section)
                        (Bool
False, Bool
False) -> (GlobalState -> Int
currentSectionID, ReaderT r (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
resetInsertedSectionID ReaderT r (State GlobalState) ()
-> ReaderT r (State GlobalState) ()
-> ReaderT r (State GlobalState) ()
forall a b.
ReaderT r (State GlobalState) a
-> ReaderT r (State GlobalState) b
-> ReaderT r (State GlobalState) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT r (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
incSectionID, Class
Class.Section)

            -- \| increment (inserted / super) section id
            ReaderT ReaderState (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
incrementSectionID
            GlobalState
globalState <- ReaderT ReaderState (State GlobalState) GlobalState
forall s (m :: * -> *). MonadState s m => m s
get
            let (HtmlT Identity ()
sectionIDHtml, HtmlT Identity ()
sectionTocKeyHtml) =
                    SectionFormat
-> Int -> Int -> (HtmlT Identity (), HtmlT Identity ())
sectionFormat
                        SectionFormat
sectionFormatS
                        (GlobalState -> Int
sectionIDGetter GlobalState
globalState)
                        (GlobalState -> Int
currentInsertedSectionID GlobalState
globalState)

            Maybe Label
-> HtmlT Identity () -> ReaderT ReaderState (State GlobalState) ()
addMaybeLabelToState Maybe Label
mLabel HtmlT Identity ()
sectionIDHtml
            -- \| Render parsed Heading, which also creates ToC Entry
            (Delayed (HtmlT Identity ())
headingHtml, Text
tocId, Delayed Text
rawTitle) <-
                HtmlT Identity ()
-> Maybe Label
-> HtmlT Identity ()
-> Parsed Heading
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Text, Delayed Text)
buildHeadingHtml HtmlT Identity ()
sectionIDHtml Maybe Label
mLabel HtmlT Identity ()
sectionTocKeyHtml Parsed Heading
parsedHeading
            Delayed (HtmlT Identity ())
childrenHtml <- DocumentMainBody -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM DocumentMainBody
sectionBody

            LabelWrapper
exportLinkFunc <- (ReaderState -> LabelWrapper)
-> ReaderT ReaderState (State GlobalState) LabelWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> LabelWrapper
exportLinkWrapper
            let rawdTitleHtml :: Delayed (HtmlT Identity ())
rawdTitleHtml = Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml (Text -> HtmlT Identity ())
-> (Text -> Text) -> Text -> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> HtmlT Identity ())
-> Delayed Text -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed Text
rawTitle
                exportLinkHtml :: Delayed (HtmlT Identity ())
exportLinkHtml =
                    LabelWrapper
exportLinkFunc (Text -> Label
Label Text
tocId) (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HtmlT Identity ()
sectionTocKeyHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
rawdTitleHtml)

                sectionHtml :: Delayed (HtmlT Identity ())
sectionHtml =
                    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
section_ [Class -> Attributes
cssClass_ Class
sectionCssClass]
                        (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Delayed (HtmlT Identity ())
headingHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
childrenHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
exportLinkHtml)
            -- \| Collects all sections for possible export
            Text
-> Delayed Text
-> Delayed (HtmlT Identity ())
-> ReaderT ReaderState (State GlobalState) ()
collectExportSection Text
tocId Delayed Text
rawTitle Delayed (HtmlT Identity ())
sectionHtml

            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Delayed (HtmlT Identity ())
sectionHtml
          where
            -- \| Also adds table of contents entry for section
            buildHeadingHtml
                :: Html ()
                -> Maybe Label
                -> Html ()
                -> Parsed Heading
                -> ReaderStateMonad
                    ( Delayed (Html ())
                    , -- \^ Formatted title
                      Text
                    , -- \^ html id
                      Delayed Text
                      -- \^ raw textual title
                    )

            buildHeadingHtml :: HtmlT Identity ()
-> Maybe Label
-> HtmlT Identity ()
-> Parsed Heading
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Text, Delayed Text)
buildHeadingHtml HtmlT Identity ()
sectionIDHtml Maybe Label
mLabelH HtmlT Identity ()
tocKeyHtml Parsed Heading
eErrHeading =
                case Parsed Heading
eErrHeading of
                    Left ParseError
parseErr -> do
                        ReaderT ReaderState (State GlobalState) ()
setHasErrors
                        Text
htmlId <-
                            -- In case of a Heading failure
                            -- we simply display the ID as the title
                            Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ())) -> ReaderStateMonad Text
createTocEntryH Maybe (HtmlT Identity ())
forall a. Maybe a
Nothing (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
forall a. a -> Result a
Error (Delayed (HtmlT Identity ())
 -> Result (Delayed (HtmlT Identity ())))
-> Delayed (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
Now HtmlT Identity ()
tocKeyHtml)
                        (Delayed (HtmlT Identity ()), Text, Delayed Text)
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Text, Delayed Text)
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
Now (HtmlT Identity () -> Delayed (HtmlT Identity ()))
-> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ParseError -> HtmlT Identity ()
parseErrorHtml (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
htmlId) ParseError
parseErr, Text
htmlId, Delayed Text
forall a. Monoid a => a
mempty)
                    Right (Heading HeadingFormat 'True
headingFormatS [HeadingTextTree]
title) -> do
                        (Delayed (HtmlT Identity ())
tocTitleHtml, Delayed (HtmlT Identity ())
titleHtml) <- [HeadingTextTree]
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
tocHeadingHtml [HeadingTextTree]
title
                        let rawTitleText :: Delayed Text
rawTitleText = [HeadingTextTree] -> Delayed Text
headingText [HeadingTextTree]
title
                        Text
htmlId <- Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ())) -> ReaderStateMonad Text
createTocEntryH (HtmlT Identity () -> Maybe (HtmlT Identity ())
forall a. a -> Maybe a
Just HtmlT Identity ()
tocKeyHtml) (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
forall a. a -> Result a
Success Delayed (HtmlT Identity ())
tocTitleHtml)
                        (Delayed (HtmlT Identity ()), Text, Delayed Text)
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Text, Delayed Text)
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            ( [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h2_ [Class -> Attributes
cssClass_ Class
Class.Heading, Class -> Attributes
cssClass_ Class
Class.Anchor, Text -> Attributes
id_ Text
htmlId]
                                (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeadingFormat 'True
-> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall (permitId :: Bool).
HeadingFormat permitId
-> HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
headingFormatId HeadingFormat 'True
headingFormatS HtmlT Identity ()
sectionIDHtml
                                (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
titleHtml
                            , Text
htmlId
                            , Delayed Text
rawTitleText
                            )
              where
                createTocEntryH :: Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ())) -> ReaderStateMonad Text
createTocEntryH Maybe (HtmlT Identity ())
mIdHtml Result (Delayed (HtmlT Identity ()))
rTitle = Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
-> Maybe Label
-> TocCategory
-> ReaderStateMonad Text
addTocEntry Maybe (HtmlT Identity ())
mIdHtml Result (Delayed (HtmlT Identity ()))
rTitle Maybe Label
mLabelH TocCategory
SomeSection

instance ToHtmlM SectionBody where
    toHtmlM :: DocumentMainBody -> HtmlReaderState
toHtmlM DocumentMainBody
sectionBody = do
        Delayed (HtmlT Identity ())
sectionBodyHtml <- case DocumentMainBody
sectionBody of
            -- \| Super Section
            -- \| We have to save the super-section counter, since super-sections are counted locally
            InnerSectionBody [Flagged' FormattedSection]
nodeSections -> do
                Int
superSectionID <- (GlobalState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Int
currentSuperSectionID
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentSuperSectionID = currentSuperSectionID initGlobalState})
                Delayed (HtmlT Identity ())
bodyHtml <- [Flagged' FormattedSection] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [Flagged' FormattedSection]
nodeSections
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentSuperSectionID = superSectionID})
                Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Delayed (HtmlT Identity ())
bodyHtml

            -- \| Section
            -- \| In this case the children are paragraphs, so we set the needed flag for them
            --    to decide if the should have a visible id
            LeafSectionBody [Node Paragraph]
nodeParagraphs -> do
                Delayed (HtmlT Identity ())
paragraphsHtml <-
                    (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {isSingleParagraph = length nodeParagraphs == 1}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
                        [Node Paragraph] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [Node Paragraph]
nodeParagraphs
                -- \| reset paragraphID for next section
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentParagraphID = 1})
                Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Delayed (HtmlT Identity ())
paragraphsHtml
            SimpleLeafSectionBody [SimpleBlock]
simpleBlocks -> [SimpleBlock] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [SimpleBlock]
simpleBlocks

        FootnoteSet
sectionBodyFootnotes <- (GlobalState -> FootnoteSet)
-> ReaderT ReaderState (State GlobalState) FootnoteSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> FootnoteSet
locallyUsedFootnotes
        Delayed (HtmlT Identity ())
footnotesHtml <- FootnoteSet -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM FootnoteSet
sectionBodyFootnotes
        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {locallyUsedFootnotes = locallyUsedFootnotes initGlobalState})

        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Delayed (HtmlT Identity ())
sectionBodyHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
footnotesHtml

-- | Combined instance since the paragraphIDHtml has to be build before the reference is generated
instance ToHtmlM (Node Paragraph) where
    toHtmlM :: Node Paragraph -> HtmlReaderState
toHtmlM (Node Maybe Label
mLabel (Paragraph ParagraphFormat
format [ParagraphTextTree]
textTrees)) = do
        GlobalState
globalState <- ReaderT ReaderState (State GlobalState) GlobalState
forall s (m :: * -> *). MonadState s m => m s
get
        let (HtmlT Identity ()
paragraphIDHtml, HtmlT Identity ()
paragraphKeyHtml) = ParagraphFormat
-> Int -> Int -> (HtmlT Identity (), HtmlT Identity ())
paragraphFormat ParagraphFormat
format (GlobalState -> Int
currentParagraphID GlobalState
globalState) Int
0
         in do
                Maybe Label
-> HtmlT Identity () -> ReaderT ReaderState (State GlobalState) ()
addMaybeLabelToState Maybe Label
mLabel HtmlT Identity ()
paragraphIDHtml
                -- \| Group raw text (without enums) into <div> for flex layout spacing
                Delayed (HtmlT Identity ())
childText <- [ParagraphTextTree] -> HtmlReaderState
forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
[TextTree lbrek fnref style enum special] -> HtmlReaderState
renderDivGrouped [ParagraphTextTree]
textTrees
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentParagraphID = currentParagraphID s + 1})
                -- \| Reset sentence id for next paragraph
                (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentSentenceID = 0})
                ReaderState
readerState <- ReaderT ReaderState (State GlobalState) ReaderState
forall r (m :: * -> *). MonadReader r m => m r
ask
                Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
                    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Class -> Attributes
cssClass_ Class
Class.Paragraph, Class -> Attributes
cssClass_ Class
Class.Anchor, Maybe Label -> Attributes
mId_ Maybe Label
mLabel]
                        -- \| If this is the only paragraph inside this section we drop the visible paragraphID
                        (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> let idHtml :: HtmlT Identity ()
idHtml = if ReaderState -> Bool
isSingleParagraph ReaderState
readerState then HtmlT Identity ()
forall a. Monoid a => a
mempty else HtmlT Identity ()
paragraphKeyHtml
                             in HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. a -> HtmlT Identity () -> a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.ParagraphID (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity ()
idHtml)
                                    (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_
                                        ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.TextContainer
                                    (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
childText

-------------------------------------------------------------------------------

-- | Wrapper for block of SimpleParagraphs and table
instance ToHtmlM SimpleBlock where
    toHtmlM :: SimpleBlock -> HtmlReaderState
toHtmlM SimpleBlock
simpleBlock = case SimpleBlock
simpleBlock of
        SimpleParagraphBlock SimpleParagraph
simpleParagraph -> SimpleParagraph -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM SimpleParagraph
simpleParagraph
        TableBlock Table
table -> Table -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Table
table

-- | Section without Heading and Identifier
instance ToHtmlM SimpleSection where
    toHtmlM :: SimpleSection -> HtmlReaderState
toHtmlM (SimpleSection (SimpleSectionFormat Bool
hasVBar) [SimpleParagraph]
sParagraphs) = do
        -- \| Possibly add vertical bar at the beginning
        let pre :: HtmlT Identity ()
pre = if Bool
hasVBar then HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
hr_ [] else HtmlT Identity ()
forall a. Monoid a => a
mempty
        Delayed (HtmlT Identity ())
paragraphsHtml <- [SimpleParagraph] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [SimpleParagraph]
sParagraphs
        -- \| If <section> would be empty, skip it
        let renderSSection :: Bool
renderSSection = Bool
hasVBar Bool -> Bool -> Bool
|| Bool -> Bool
not ([SimpleParagraph] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SimpleParagraph]
sParagraphs)
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
            if Bool
renderSSection
                then ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
section_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.Section) (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
Now HtmlT Identity ()
pre Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
paragraphsHtml
                else Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty

-- | Paragraph without identifier
instance ToHtmlM SimpleParagraph where
    toHtmlM :: SimpleParagraph -> HtmlReaderState
toHtmlM (SimpleParagraph (SimpleParagraphFormat Typography
typography) [RichTextTree]
textTrees) = do
        Delayed (HtmlT Identity ())
childText <- [RichTextTree] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [RichTextTree]
textTrees
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
            [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_
                (Class -> Attributes
cssClass_ Class
Class.TextContainer Attributes -> [Attributes] -> [Attributes]
forall a. a -> [a] -> [a]
: Typography -> [Attributes]
forall a. ToCssClasses a => a -> [Attributes]
toCssClasses_ Typography
typography)
                (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
childText

-------------------------------------------------------------------------------

instance ToHtmlM Table where
    toHtmlM :: Table -> HtmlReaderState
toHtmlM (Table ColumnProps
_ [Row]
rows) = do
        Delayed (HtmlT Identity ())
rowsHtml <- [Delayed (HtmlT Identity ())] -> Delayed (HtmlT Identity ())
forall a. Monoid a => [a] -> a
mconcat ([Delayed (HtmlT Identity ())] -> Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
-> HtmlReaderState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Row -> HtmlReaderState)
-> [Row]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
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 Row -> HtmlReaderState
row [Row]
rows
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
            ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.TableContainer)
                (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
table_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.Table)
                (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tbody_
                (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
rowsHtml
      where
        row :: Row -> HtmlReaderState
        row :: Row -> HtmlReaderState
row (Row [Cell]
cells) = do
            Delayed (HtmlT Identity ())
cellsHtml <- [Delayed (HtmlT Identity ())] -> Delayed (HtmlT Identity ())
forall a. Monoid a => [a] -> a
mconcat ([Delayed (HtmlT Identity ())] -> Delayed (HtmlT Identity ()))
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
-> HtmlReaderState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cell -> HtmlReaderState)
-> [Cell]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
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 Cell -> HtmlReaderState
cell [Cell]
cells
            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tr_ (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
cellsHtml

        cell :: Cell -> HtmlReaderState
        cell :: Cell -> HtmlReaderState
cell Cell
HSpannedCell = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty
        cell (VSpannedCell Int
_) = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty
        cell (Cell CellFormat
_ [TableTextTree]
_ Int
0 Int
0) = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty
        cell (Cell (CellFormat BGColor
bgColor Typography
typography) [TableTextTree]
text Int
colspan Int
rowspan) = do
            Delayed (HtmlT Identity ())
textHtml <- [TableTextTree] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [TableTextTree]
text
            let bgClass :: [Attributes]
bgClass = BGColor -> [Attributes]
forall a. ToCssClasses a => a -> [Attributes]
toCssClasses_ BGColor
bgColor
                innerContainer :: HtmlT Identity () -> HtmlT Identity ()
innerContainer = [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ (Typography -> [Attributes]
forall a. ToCssClasses a => a -> [Attributes]
toCssClasses_ Typography
typography)
                tableData :: HtmlT Identity () -> HtmlT Identity ()
tableData = case (Int
colspan, Int
rowspan) of
                    (Int
1, Int
1) -> [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
td_ [Attributes]
bgClass
                    (Int, Int)
_ -> [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
td_ (Text -> Attributes
colspan_ (Int -> Text
iToT Int
colspan) Attributes -> [Attributes] -> [Attributes]
forall a. a -> [a] -> [a]
: Text -> Attributes
rowspan_ (Int -> Text
iToT Int
rowspan) Attributes -> [Attributes] -> [Attributes]
forall a. a -> [a] -> [a]
: [Attributes]
bgClass)
            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
tableData (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> HtmlT Identity ()
innerContainer (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
textHtml

-------------------------------------------------------------------------------

instance
    (ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special)
    => ToHtmlM (TextTree lnbrk fnref style enum special)
    where
    toHtmlM :: TextTree lnbrk fnref style enum special -> HtmlReaderState
toHtmlM TextTree lnbrk fnref style enum special
textTree = case TextTree lnbrk fnref style enum special
textTree of
        Word Text
text -> HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
text
        TextTree lnbrk fnref style enum special
Space -> HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml (Text
" " :: Text)
        TextTree lnbrk fnref style enum special
NonBreakingSpace -> HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtmlRaw (Text
"&nbsp;" :: Text)
        -- \| ignore value since type Void does not have any values
        LineBreak lnbrk
_ -> HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
br_ []
        Special special
special -> special -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM special
special
        Reference Label
label -> do
            -- \| Label func for wrapping arbitrary Html (like anchor links) around the reference
            LabelWrapper
labelFunc <- (ReaderState -> LabelWrapper)
-> ReaderT ReaderState (State GlobalState) LabelWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> LabelWrapper
labelWrapperFunc
            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ (GlobalState -> HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. (GlobalState -> a) -> Delayed a
Later ((GlobalState -> HtmlT Identity ()) -> Delayed (HtmlT Identity ()))
-> (GlobalState -> HtmlT Identity ())
-> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ \GlobalState
globalState ->
                case Label -> [(Label, HtmlT Identity ())] -> Maybe (HtmlT Identity ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
label ([(Label, HtmlT Identity ())] -> Maybe (HtmlT Identity ()))
-> [(Label, HtmlT Identity ())] -> Maybe (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ GlobalState -> [(Label, HtmlT Identity ())]
labels GlobalState
globalState of
                    -- \| Label was not found in GlobalState and a red error is emitted
                    Maybe (HtmlT Identity ())
Nothing -> Text -> HtmlT Identity ()
htmlError (Text
"Label \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
unLabel Label
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" not found!")
                    Just HtmlT Identity ()
labelHtml -> LabelWrapper
labelFunc Label
label HtmlT Identity ()
labelHtml
        Styled style
style [TextTree lnbrk fnref style enum special]
textTrees ->
            let styleClass :: Class
styleClass = style -> Class
forall a. ToCssClass a => a -> Class
toCssClass style
style
             in -- \| Wrap raw text in <span> and enums in <div>
                (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lnbrk fnref style enum special]
-> HtmlReaderState
forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
(HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
renderGroupedTextTree ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
styleClass) ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
styleClass) [TextTree lnbrk fnref style enum special]
textTrees
        Enum enum
enum -> enum -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM enum
enum
        FootnoteRef fnref
fnref -> fnref -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM fnref
fnref

-- | Increment sentence counter and add Label to GlobalState, if there is one
instance ToHtmlM SentenceStart where
    toHtmlM :: SentenceStart -> HtmlReaderState
toHtmlM (SentenceStart Maybe Label
mLabel) = do
        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentSentenceID = currentSentenceID s + 1})
        GlobalState
globalState <- ReaderT ReaderState (State GlobalState) GlobalState
forall s (m :: * -> *). MonadState s m => m s
get
        -- \| Add Maybe Label with just the sentence number
        Maybe Label
-> HtmlT Identity () -> ReaderT ReaderState (State GlobalState) ()
addMaybeLabelToState Maybe Label
mLabel (String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Identity ()) -> String -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (GlobalState -> Int
currentSentenceID GlobalState
globalState))
        case Maybe Label
mLabel of
            Maybe Label
Nothing -> HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty
            Just Label
label -> HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ [Class -> Attributes
cssClass_ Class
Class.Anchor, Text -> Attributes
id_ (Label -> Text
unLabel Label
label)] HtmlT Identity ()
forall a. Monoid a => a
mempty

instance ToHtmlM Enumeration where
    toHtmlM :: Enumeration -> HtmlReaderState
toHtmlM (Enumeration enumFormatS :: EnumFormat
enumFormatS@(EnumFormat (EnumItemFormat IdentifierFormat
idFormat EnumItemKeyFormat
_)) [Node EnumItem]
enumItems) = do
        -- \| Build enum format and add it to global state for creating the css classes later
        Text
enumCounterClass <- EnumFormat -> ReaderStateMonad Text
enumFormat EnumFormat
enumFormatS
        -- \| Reset enumItemID for this Enumeration
        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentEnumItemID = 1})
        -- \| Render enum items with correct id format
        [Delayed (HtmlT Identity ())]
nested <-
            (Node EnumItem -> HtmlReaderState)
-> [Node EnumItem]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
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
                ((ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {currentEnumIDFormatString = idFormat}) (HtmlReaderState -> HtmlReaderState)
-> (Node EnumItem -> HtmlReaderState)
-> Node EnumItem
-> HtmlReaderState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node EnumItem -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM)
                [Node EnumItem]
enumItems
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ do
            [HtmlT Identity ()]
nestedHtml <- [Delayed (HtmlT Identity ())] -> Delayed [HtmlT Identity ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Delayed (HtmlT Identity ())]
nested
            let enumItemsHtml :: HtmlT Identity ()
enumItemsHtml = (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> [HtmlT Identity ()] -> HtmlT Identity ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a b.
HtmlT Identity a -> HtmlT Identity b -> HtmlT Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
li_) (HtmlT Identity ()
forall a. Monoid a => a
mempty :: Html ()) [HtmlT Identity ()]
nestedHtml
             in HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlT Identity () -> Delayed (HtmlT Identity ()))
-> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$
                    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
ol_ [Class -> Attributes
cssClass_ Class
Class.Enumeration, Text -> Attributes
class_ Text
enumCounterClass] HtmlT Identity ()
enumItemsHtml

instance ToHtmlM (Node EnumItem) where
    toHtmlM :: Node EnumItem -> HtmlReaderState
toHtmlM (Node Maybe Label
mLabel (EnumItem [RichTextTree]
textTrees)) = do
        -- \| Save current enum item id, if nested enumerations follow and reset it
        Int
enumItemID <- (GlobalState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Int
currentEnumItemID
        -- \| Build reference with EnumFormat from ReaderState
        HtmlT Identity ()
enumItemRefHtml <- Int -> ReaderT ReaderState (State GlobalState) (HtmlT Identity ())
buildEnumItemRefHtml Int
enumItemID
        Maybe Label
-> HtmlT Identity () -> ReaderT ReaderState (State GlobalState) ()
addMaybeLabelToState Maybe Label
mLabel HtmlT Identity ()
enumItemRefHtml
        -- \| Render <div> grouped raw text (without enums) to get correct flex spacing
        Delayed (HtmlT Identity ())
enumItemHtml <- [RichTextTree] -> HtmlReaderState
forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
[TextTree lbrek fnref style enum special] -> HtmlReaderState
renderDivGrouped [RichTextTree]
textTrees
        -- \| Increment enumItemID for next enumItem
        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentEnumItemID = enumItemID + 1})
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
            [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Class -> Attributes
cssClass_ Class
Class.TextContainer, Class -> Attributes
cssClass_ Class
Class.Anchor, Maybe Label -> Attributes
mId_ Maybe Label
mLabel]
                (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
enumItemHtml

instance ToHtmlM FootnoteReference where
    toHtmlM :: FootnoteReference -> HtmlReaderState
toHtmlM (FootnoteReference Label
label) = do
        FootnoteMap
usedFootnotes <- (GlobalState -> FootnoteMap)
-> ReaderT ReaderState (State GlobalState) FootnoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> FootnoteMap
usedFootnoteMap
        -- \| Check if footnote was already referenced (document-scoped)
        let mFootnoteIdText :: Maybe (Int, HtmlT Identity (), Delayed (HtmlT Identity ()))
mFootnoteIdText = Label
-> FootnoteMap
-> Maybe (Int, HtmlT Identity (), Delayed (HtmlT Identity ()))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
label FootnoteMap
usedFootnotes
        case Maybe (Int, HtmlT Identity (), Delayed (HtmlT Identity ()))
mFootnoteIdText of
            Just (Int
footnoteID, HtmlT Identity ()
footnoteIdHtml, Delayed (HtmlT Identity ())
_) -> HtmlT Identity () -> Int -> Label -> HtmlReaderState
createFootnoteRef HtmlT Identity ()
footnoteIdHtml Int
footnoteID Label
label
            Maybe (Int, HtmlT Identity (), Delayed (HtmlT Identity ()))
Nothing -> do
                -- \| Look for label in footnoteMap with unused footnotes
                Map Label Footnote
unusedFootnoteMap <- (ReaderState -> Map Label Footnote)
-> ReaderT ReaderState (State GlobalState) (Map Label Footnote)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Map Label Footnote
footnoteMap
                case Label -> Map Label Footnote -> Maybe Footnote
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Label
label Map Label Footnote
unusedFootnoteMap of
                    -- \| Footnote Label does not exist
                    Maybe Footnote
Nothing -> do
                        ReaderT ReaderState (State GlobalState) ()
setHasErrors
                        HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
htmlError (Text -> HtmlT Identity ()) -> Text -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text
"Footnote Label \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
unLabel Label
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" not found!"
                    Just Footnote
footnote -> do
                        Int
footnoteID <- (GlobalState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Int
currentFootnoteID
                        let footnoteIdHtml :: HtmlT Identity ()
footnoteIdHtml = String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Identity ()) -> String -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
footnoteID
                        Delayed (HtmlT Identity ())
footnoteTextHtml <- Footnote -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM Footnote
footnote
                        -- \| Add Label for normal references to this footnote
                        Maybe Label
-> HtmlT Identity () -> ReaderT ReaderState (State GlobalState) ()
addMaybeLabelToState (Label -> Maybe Label
forall a. a -> Maybe a
Just Label
label) HtmlT Identity ()
footnoteIdHtml
                        -- \| Add new used footnote with id and rendered (delayed) text
                        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
                            ( \GlobalState
s ->
                                GlobalState
s
                                    { usedFootnoteMap =
                                        (label, (footnoteID, footnoteIdHtml, footnoteTextHtml)) : usedFootnoteMap s
                                    , currentFootnoteID = currentFootnoteID s + 1
                                    }
                            )
                        HtmlT Identity () -> Int -> Label -> HtmlReaderState
createFootnoteRef HtmlT Identity ()
footnoteIdHtml Int
footnoteID Label
label
      where
        -- \| Creates footnote reference html and adds footnote label to locally used footnotes
        createFootnoteRef :: Html () -> Int -> Label -> HtmlReaderState
        createFootnoteRef :: HtmlT Identity () -> Int -> Label -> HtmlReaderState
createFootnoteRef HtmlT Identity ()
footHtml Int
footId Label
footLabel = do
            (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
                ( \GlobalState
s ->
                    GlobalState
s
                        { locallyUsedFootnotes =
                            Set.insert (NumLabel (footId, footLabel)) (locallyUsedFootnotes s)
                        }
                )
            -- \| Function for wrapping arbitrary Html (like anchor links) around footnote refs
            LabelWrapper
footnoteFunc <- (ReaderState -> LabelWrapper)
-> ReaderT ReaderState (State GlobalState) LabelWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> LabelWrapper
footnoteWrapperFunc
            HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
sup_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ LabelWrapper
footnoteFunc Label
footLabel HtmlT Identity ()
footHtml

instance ToHtmlM Footnote where
    toHtmlM :: Footnote -> HtmlReaderState
toHtmlM (Footnote FootnoteFormat
SuperscriptFootnoteFormat [FootnoteTextTree]
textTrees) = do
        -- \| Grouped rendering is not necessary, since enums
        --   are not allowed inside of footnotes
        [FootnoteTextTree] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [FootnoteTextTree]
textTrees

instance ToHtmlM FootnoteSet where
    toHtmlM :: FootnoteSet -> HtmlReaderState
toHtmlM FootnoteSet
idLabelSet = do
        -- \| Get ascending (by footnoteId) list of Labels (drop id)
        let footnotes :: [Label]
footnotes = (NumLabel -> Label) -> [NumLabel] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, Label) -> Label
forall a b. (a, b) -> b
snd ((Int, Label) -> Label)
-> (NumLabel -> (Int, Label)) -> NumLabel -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumLabel -> (Int, Label)
unNumLabel) ([NumLabel] -> [Label]) -> [NumLabel] -> [Label]
forall a b. (a -> b) -> a -> b
$ FootnoteSet -> [NumLabel]
forall a. Set a -> [a]
Set.toAscList FootnoteSet
idLabelSet
        FootnoteMap
globalFootnoteMap <- (GlobalState -> FootnoteMap)
-> ReaderT ReaderState (State GlobalState) FootnoteMap
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> FootnoteMap
usedFootnoteMap
        [Delayed (HtmlT Identity ())]
delayedFootnotesHtml <- (Label -> HtmlReaderState)
-> [Label]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
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 (FootnoteMap -> Label -> HtmlReaderState
toFootnoteHtml FootnoteMap
globalFootnoteMap) [Label]
footnotes
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ do
            [HtmlT Identity ()]
footnoteHtmls <- [Delayed (HtmlT Identity ())] -> Delayed [HtmlT Identity ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Delayed (HtmlT Identity ())]
delayedFootnotesHtml
            -- \| If there are no footnotes, dont output empty <div>
            if [HtmlT Identity ()] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HtmlT Identity ()]
footnoteHtmls
                then HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (m :: * -> *) a. Monad m => a -> m a
return HtmlT Identity ()
forall a. Monoid a => a
mempty
                else do
                    let combinedFootnotesHtml :: HtmlT Identity ()
combinedFootnotesHtml = [HtmlT Identity ()] -> HtmlT Identity ()
forall a. Monoid a => [a] -> a
mconcat [HtmlT Identity ()]
footnoteHtmls
                    -- \| Wrap all footnotes into one <div>
                    HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlT Identity () -> Delayed (HtmlT Identity ()))
-> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.FootnoteContainer (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
hr_ [] HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> HtmlT Identity ()
combinedFootnotesHtml
      where
        -- \| Lookup footnote label and build single footnote html
        toFootnoteHtml :: FootnoteMap -> Label -> HtmlReaderState
        toFootnoteHtml :: FootnoteMap -> Label -> HtmlReaderState
toFootnoteHtml FootnoteMap
idTextMap Label
label =
            case Label
-> FootnoteMap
-> Maybe (Int, HtmlT Identity (), Delayed (HtmlT Identity ()))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Label
label FootnoteMap
idTextMap of
                -- \| This should never happen (hopefully)
                Maybe (Int, HtmlT Identity (), Delayed (HtmlT Identity ()))
Nothing ->
                    String -> HtmlReaderState
forall a. HasCallStack => String -> a
error
                        ( String
"footnote label \""
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Label -> Text
unLabel Label
label)
                            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" was used in current section, but never added to global used footnote map!"
                        )
                Just (Int
_, HtmlT Identity ()
idHtml, Delayed (HtmlT Identity ())
delayedTextHtml) ->
                    -- \| <div> <sup>id</sup> <span>text</span> </div>
                    Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return
                        ( ( [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Class -> Attributes
cssClass_ Class
Class.Footnote, Class -> Attributes
cssClass_ Class
Class.Anchor, Text -> Attributes
id_ (Label -> Text
unLabel Label
label)]
                                (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
sup_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.FootnoteID) HtmlT Identity ()
idHtml HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<>)
                          )
                            (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_
                            (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
delayedTextHtml
                        )

-------------------------------------------------------------------------------

instance ToHtmlM AppendixSection where
    toHtmlM :: AppendixSection -> HtmlReaderState
toHtmlM
        ( AppendixSection
                ( AppendixSectionFormat
                        (AppendixSectionTitle Text
appendixSectionTitle)
                        (AppendixElementFormat IdentifierFormat
idFormat TocKeyFormat
tocFormat HeadingFormat 'True
headFormat)
                    )
                [Flagged' (Node Document)]
nodeDocuments
            ) = do
            -- \| Empty appendices are dropped from HTML structure and ToC
            let isEmpty :: Bool
isEmpty = [Flagged' (Node Document)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Flagged' (Node Document)]
nodeDocuments
            -- \| Add Entry to ToC but without ID
            Text
htmlId <-
                if Bool
isEmpty
                    then
                        -- \| If appendix is dropped htmlId is unused and set to @mempty@
                        Result (HtmlT Identity ())
-> ReaderT ReaderState (State GlobalState) ()
addPhantomTocEntry (HtmlT Identity () -> Result (HtmlT Identity ())
forall a. a -> Result a
Success (HtmlT Identity () -> Result (HtmlT Identity ()))
-> HtmlT Identity () -> Result (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
appendixSectionTitle) ReaderT ReaderState (State GlobalState) ()
-> ReaderStateMonad Text -> ReaderStateMonad Text
forall a b.
ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) b
-> ReaderT ReaderState (State GlobalState) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> ReaderStateMonad Text
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
                    else
                        Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
-> Maybe Label
-> TocCategory
-> ReaderStateMonad Text
addTocEntry Maybe (HtmlT Identity ())
forall a. Maybe a
Nothing (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
forall a. a -> Result a
Success (Delayed (HtmlT Identity ())
 -> Result (Delayed (HtmlT Identity ())))
-> Delayed (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
Now (HtmlT Identity () -> Delayed (HtmlT Identity ()))
-> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
appendixSectionTitle) Maybe Label
forall a. Maybe a
Nothing TocCategory
Other
            -- \| Give each Document the corresponding appendix Id
            let zipFunc :: Int -> a -> HtmlReaderState
zipFunc Int
i a
nDoc = (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {currentAppendixElementID = i}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ a -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM a
nDoc
            [Delayed (HtmlT Identity ())]
documentHtmls <-
                -- \| Set all necessary formats for appendix document headings
                (ReaderState -> ReaderState)
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
                    ( \ReaderState
s ->
                        ReaderState
s
                            { appendixElementIdFormat = idFormat
                            , appendixElementTocKeyFormat = tocFormat
                            , documentHeadingFormat = Right headFormat
                            }
                    )
                    (ReaderT
   ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
 -> ReaderT
      ReaderState (State GlobalState) [Delayed (HtmlT Identity ())])
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
forall a b. (a -> b) -> a -> b
$ (Int -> Flagged' (Node Document) -> HtmlReaderState)
-> [Int]
-> [Flagged' (Node Document)]
-> ReaderT
     ReaderState (State GlobalState) [Delayed (HtmlT Identity ())]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> Flagged' (Node Document) -> HtmlReaderState
forall {a}. ToHtmlM a => Int -> a -> HtmlReaderState
zipFunc [Int
1 ..] [Flagged' (Node Document)]
nodeDocuments
            -- \| Wrap all appendix documents into one <div>
            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$
                if Bool
isEmpty
                    then Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty
                    else
                        [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Class -> Attributes
cssClass_ Class
Class.AppendixSection, Class -> Attributes
cssClass_ Class
Class.Anchor, Text -> Attributes
id_ Text
htmlId]
                            (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delayed (HtmlT Identity ())] -> Delayed (HtmlT Identity ())
forall a. Monoid a => [a] -> a
mconcat [Delayed (HtmlT Identity ())]
documentHtmls

-------------------------------------------------------------------------------

-- | This instance manages which part of the AST is actually translated into HTML;
--   Everything else is just used to build up the needed context (labels, etc.)
instance (ToHtmlM a) => ToHtmlM (Flagged' a) where
    toHtmlM :: Flagged' a -> HtmlReaderState
toHtmlM (Flagged Bool
renderFlag a
a) = do
        -- \| track if any sibling Flaggeds are True
        Bool
siblingFlagged <- (GlobalState -> Bool)
-> ReaderT ReaderState (State GlobalState) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Bool
hasFlagged
        -- \| Set False to see if child sets it True again
        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {hasFlagged = False})
        -- \| Set True for children if renderFlag is True, else keep value
        Delayed (HtmlT Identity ())
aHtml <-
            (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {shouldRender = renderFlag || shouldRender s}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ a -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM a
a
        -- \| Decide if output is thrown away
        Bool
hasFlaggedChild <- (GlobalState -> Bool)
-> ReaderT ReaderState (State GlobalState) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Bool
hasFlagged
        Bool
parentRender <- (ReaderState -> Bool)
-> ReaderT ReaderState (State GlobalState) Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> Bool
shouldRender
        let render :: Bool
render = Bool
renderFlag Bool -> Bool -> Bool
|| Bool
hasFlaggedChild Bool -> Bool -> Bool
|| Bool
parentRender
        -- \| Tell parent if we or any sibling is True
        (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {hasFlagged = render || siblingFlagged})
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ if Bool
render then Delayed (HtmlT Identity ())
aHtml else Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty

-------------------------------------------------------------------------------

-- = The @Parsed a@ instances makes the rendering robust against parse errors

-- | Returns rendered heading text
instance ToHtmlM (Fallback NavTocHeading) where
    toHtmlM :: Fallback NavTocHeading -> HtmlReaderState
toHtmlM (Fallback (NavTocHeading Text
title)) = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
title

-- | Instance used for 'DocumentIntro', 'DocumentExtro', 'DocumentMainBody' and 'DocumentContainerHeader':
--   Emits 'PhantomTocEntry' and parse error box
instance (ToHtmlM a) => ToHtmlM (NavTocHeaded (Parsed a)) where
    toHtmlM :: NavTocHeaded (Parsed a) -> HtmlReaderState
toHtmlM (NavTocHeaded (NavTocHeading Text
title) Parsed a
eErrA) =
        let titleHtml :: HtmlT Identity ()
titleHtml = Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
title
         in case Parsed a
eErrA of
                Left ParseError
parseError -> do
                    ReaderT ReaderState (State GlobalState) ()
setHasErrors
                    Result (HtmlT Identity ())
-> ReaderT ReaderState (State GlobalState) ()
addPhantomTocEntry (HtmlT Identity () -> Result (HtmlT Identity ())
forall a. a -> Result a
Error HtmlT Identity ()
titleHtml)
                    HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ParseError -> HtmlT Identity ()
parseErrorHtml Maybe Text
forall a. Maybe a
Nothing ParseError
parseError
                Right a
a -> do
                    Result (HtmlT Identity ())
-> ReaderT ReaderState (State GlobalState) ()
addPhantomTocEntry (HtmlT Identity () -> Result (HtmlT Identity ())
forall a. a -> Result a
Success HtmlT Identity ()
titleHtml)
                    a -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM a
a

-- | "Fake" section behaviour in error case
instance (ToHtmlM a) => ToHtmlM (SectionFormatted (Parsed a)) where
    toHtmlM :: SectionFormatted (Parsed a) -> HtmlReaderState
toHtmlM (SectionFormatted SectionFormat
sectionFormatS Parsed a
eErrA) = case Parsed a
eErrA of
        Left ParseError
parseErr -> do
            ReaderT ReaderState (State GlobalState) ()
setHasErrors
            -- \| Count error as @Section@, to keep following
            --    @Section@s correctly numbered
            if SectionFormat -> Bool
isInserted SectionFormat
sectionFormatS
                then ReaderT ReaderState (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
incInsertedSectionID
                else ReaderT ReaderState (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
resetInsertedSectionID ReaderT ReaderState (State GlobalState) ()
-> ReaderT ReaderState (State GlobalState) ()
-> ReaderT ReaderState (State GlobalState) ()
forall a b.
ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) b
-> ReaderT ReaderState (State GlobalState) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT ReaderState (State GlobalState) ()
forall r. ReaderT r (State GlobalState) ()
incSectionID

            Int
sectionID <- (GlobalState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Int
currentSectionID
            Int
insertedSectionID <- (GlobalState -> Int) -> ReaderT ReaderState (State GlobalState) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets GlobalState -> Int
currentInsertedSectionID
            -- \| Since we dont have a title we set the tocID as title
            let (HtmlT Identity ()
_, HtmlT Identity ()
tocKeyHtml) = SectionFormat
-> Int -> Int -> (HtmlT Identity (), HtmlT Identity ())
sectionFormat SectionFormat
sectionFormatS Int
sectionID Int
insertedSectionID
            Text
htmlID <- Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
-> Maybe Label
-> TocCategory
-> ReaderStateMonad Text
addTocEntry Maybe (HtmlT Identity ())
forall a. Maybe a
Nothing (Delayed (HtmlT Identity ()) -> Result (Delayed (HtmlT Identity ()))
forall a. a -> Result a
Error (Delayed (HtmlT Identity ())
 -> Result (Delayed (HtmlT Identity ())))
-> Delayed (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
Now HtmlT Identity ()
tocKeyHtml) Maybe Label
forall a. Maybe a
Nothing TocCategory
SomeSection
            HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow (HtmlT Identity () -> HtmlReaderState)
-> HtmlT Identity () -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ParseError -> HtmlT Identity ()
parseErrorHtml (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
htmlID) ParseError
parseErr
        Right a
a -> (ReaderState -> ReaderState) -> HtmlReaderState -> HtmlReaderState
forall a.
(ReaderState -> ReaderState)
-> ReaderT ReaderState (State GlobalState) a
-> ReaderT ReaderState (State GlobalState) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderState
s -> ReaderState
s {localSectionFormat = sectionFormatS}) (HtmlReaderState -> HtmlReaderState)
-> HtmlReaderState -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ a -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM a
a

-------------------------------------------------------------------------------

-- | Render current ToC from State
renderLocalToc :: Maybe TocFormat -> HtmlReaderState
renderLocalToc :: Maybe TocFormat -> HtmlReaderState
renderLocalToc Maybe TocFormat
mTocFormat = do
    GlobalState
globalState <- ReaderT ReaderState (State GlobalState) GlobalState
forall s (m :: * -> *). MonadState s m => m s
get
    TocEntryWrapper
entryFunc <- (ReaderState -> TocEntryWrapper)
-> ReaderT ReaderState (State GlobalState) TocEntryWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> TocEntryWrapper
tocEntryWrapperFunc
    TocEntryWrapper
buttonFunc <- (ReaderState -> TocEntryWrapper)
-> ReaderT ReaderState (State GlobalState) TocEntryWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> TocEntryWrapper
tocButtonWrapperFunc
    Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Maybe TocFormat
-> TocEntryWrapper
-> TocEntryWrapper
-> GlobalState
-> Delayed (HtmlT Identity ())
renderToc Maybe TocFormat
mTocFormat TocEntryWrapper
entryFunc TocEntryWrapper
buttonFunc GlobalState
globalState

-- | Returns a Later which takes a GlobalState to render a delayed ToC
renderDelayedToc :: Maybe TocFormat -> HtmlReaderState
renderDelayedToc :: Maybe TocFormat -> HtmlReaderState
renderDelayedToc Maybe TocFormat
mTocFormat = do
    TocEntryWrapper
entryFunc <- (ReaderState -> TocEntryWrapper)
-> ReaderT ReaderState (State GlobalState) TocEntryWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> TocEntryWrapper
tocEntryWrapperFunc
    TocEntryWrapper
buttonFunc <- (ReaderState -> TocEntryWrapper)
-> ReaderT ReaderState (State GlobalState) TocEntryWrapper
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderState -> TocEntryWrapper
tocButtonWrapperFunc

    -- \| Return Later to delay ToC generation to the end;
    --    Join Delayed (Delayed (Html ())) together,
    --    since the ToC itself contains Delayed (Html ()) too
    Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ Delayed (Delayed (HtmlT Identity ()))
-> Delayed (HtmlT Identity ())
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Delayed (Delayed (HtmlT Identity ()))
 -> Delayed (HtmlT Identity ()))
-> Delayed (Delayed (HtmlT Identity ()))
-> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> a -> b
$ (GlobalState -> Delayed (HtmlT Identity ()))
-> Delayed (Delayed (HtmlT Identity ()))
forall a. (GlobalState -> a) -> Delayed a
Later ((GlobalState -> Delayed (HtmlT Identity ()))
 -> Delayed (Delayed (HtmlT Identity ())))
-> (GlobalState -> Delayed (HtmlT Identity ()))
-> Delayed (Delayed (HtmlT Identity ()))
forall a b. (a -> b) -> a -> b
$ \GlobalState
globalState -> Maybe TocFormat
-> TocEntryWrapper
-> TocEntryWrapper
-> GlobalState
-> Delayed (HtmlT Identity ())
renderToc Maybe TocFormat
mTocFormat TocEntryWrapper
entryFunc TocEntryWrapper
buttonFunc GlobalState
globalState

-- | Helper function for rendering a ToC from the given  GlobalState
renderToc
    :: Maybe TocFormat
    -> TocEntryWrapper
    -- ^ Wrapper for Toc entry text
    -> TocEntryWrapper
    -- ^ Wrapper for Toc button
    -> GlobalState
    -> Delayed (Html ())
renderToc :: Maybe TocFormat
-> TocEntryWrapper
-> TocEntryWrapper
-> GlobalState
-> Delayed (HtmlT Identity ())
renderToc Maybe TocFormat
Nothing TocEntryWrapper
_ TocEntryWrapper
_ GlobalState
_ = Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty
renderToc (Just (TocFormat (TocHeading Text
title))) TocEntryWrapper
entryFunc TocEntryWrapper
buttonFunc GlobalState
globalState =
    let colGroup :: HtmlT Identity ()
colGroup =
            HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
colgroup_
                ( [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
col_ ([Attributes] -> HtmlT Identity ()) -> Class -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.MinSizeColumn
                    HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
col_ ([Attributes] -> HtmlT Identity ()) -> Class -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.MaxSizeColumn
                    HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<> [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
col_ ([Attributes] -> HtmlT Identity ()) -> Class -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.MinSizeColumn
                )
        tableHead :: HtmlT Identity ()
tableHead =
            HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
thead_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tr_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
th_ [Text -> Attributes
colspan_ Text
"3"] (Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
title))
                :: Html ()

        -- \| Build List of ToC rows
        tocEntries :: [Delayed (Html ())]
        tocEntries :: [Delayed (HtmlT Identity ())]
tocEntries =
            -- \| @rights@ filters all phantom entries and unpacks real ones
            let tupleList :: [TocEntry]
tupleList = [Either PhantomTocEntry TocEntry] -> [TocEntry]
forall a b. [Either a b] -> [b]
rights ([Either PhantomTocEntry TocEntry] -> [TocEntry])
-> [Either PhantomTocEntry TocEntry] -> [TocEntry]
forall a b. (a -> b) -> a -> b
$ ToC -> [Either PhantomTocEntry TocEntry]
forall a. DList a -> [a]
toList (ToC -> [Either PhantomTocEntry TocEntry])
-> ToC -> [Either PhantomTocEntry TocEntry]
forall a b. (a -> b) -> a -> b
$ GlobalState -> ToC
tableOfContents GlobalState
globalState
             in (TocEntry -> Delayed (HtmlT Identity ()))
-> [TocEntry] -> [Delayed (HtmlT Identity ())]
forall a b. (a -> b) -> [a] -> [b]
map (TocEntryWrapper
-> TocEntryWrapper -> TocEntry -> Delayed (HtmlT Identity ())
buildWrappedRow TocEntryWrapper
entryFunc TocEntryWrapper
buttonFunc) [TocEntry]
tupleList

        -- \| [Delayed (Html ())] -> Delayed [Html ()] -> Delayed (Html ())
        tableBody :: Delayed (HtmlT Identity ())
tableBody = HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tbody_ (HtmlT Identity () -> HtmlT Identity ())
-> ([HtmlT Identity ()] -> HtmlT Identity ())
-> [HtmlT Identity ()]
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [HtmlT Identity ()] -> HtmlT Identity ()
forall a. Monoid a => [a] -> a
mconcat ([HtmlT Identity ()] -> HtmlT Identity ())
-> Delayed [HtmlT Identity ()] -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delayed (HtmlT Identity ())] -> Delayed [HtmlT Identity ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Delayed (HtmlT Identity ())]
tocEntries
     in ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
nav_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.TableContainer) (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
table_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.TableOfContents)
            (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HtmlT Identity ()
colGroup Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HtmlT Identity ()
tableHead Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
tableBody)
  where
    -- \| Build <tr><td>id</td> <td>title</td></tr> and wrap id and title seperatly
    buildWrappedRow
        :: TocEntryWrapper
        -> TocEntryWrapper
        -> TocEntry
        -> Delayed (Html ())
    buildWrappedRow :: TocEntryWrapper
-> TocEntryWrapper -> TocEntry -> Delayed (HtmlT Identity ())
buildWrappedRow TocEntryWrapper
entryWrapper TocEntryWrapper
buttonWrapper (Maybe (HtmlT Identity ())
mIdHtml, Result (Delayed (HtmlT Identity ()))
rTitle, Text
htmlId, TocCategory
category) =
        let
            -- \| Draw ToC Error titles as inline errors
            entryWrap :: HtmlT Identity () -> HtmlT Identity ()
entryWrap = TocEntryWrapper
entryWrapper TocCategory
category (Text -> Label
Label Text
htmlId)
            buttonWrap :: HtmlT Identity () -> HtmlT Identity ()
buttonWrap = TocEntryWrapper
buttonWrapper TocCategory
category (Text -> Label
Label Text
htmlId)
            titleHtml :: Delayed (HtmlT Identity ())
titleHtml = (Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ()))
-> (Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ()))
-> Result (Delayed (HtmlT Identity ()))
-> Delayed (HtmlT Identity ())
forall a b. (a -> b) -> (a -> b) -> Result a -> b
result Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. a -> a
id ([Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.InlineError (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) Result (Delayed (HtmlT Identity ()))
rTitle
            titleCell :: Delayed (HtmlT Identity ())
titleCell = HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
td_ (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity ()
-> HtmlT Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HtmlT Identity () -> HtmlT Identity ()
entryWrap (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
titleHtml
            idCell :: HtmlT Identity ()
idCell = [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
td_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.TableCentered (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity ()
-> (HtmlT Identity () -> HtmlT Identity ())
-> Maybe (HtmlT Identity ())
-> HtmlT Identity ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HtmlT Identity ()
forall a. Monoid a => a
mempty HtmlT Identity () -> HtmlT Identity ()
entryWrap Maybe (HtmlT Identity ())
mIdHtml
            linkButton :: HtmlT Identity ()
linkButton = [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
td_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.TableCentered (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity () -> HtmlT Identity ()
buttonWrap (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml (Text
"↗" :: Text)
         in
            -- \| Nothing IdHtmls will be replaced with mempty
            HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
tr_ (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HtmlT Identity ()
idCell Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
titleCell Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> HtmlT Identity () -> Delayed (HtmlT Identity ())
forall a. a -> Delayed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HtmlT Identity ()
linkButton

-------------------------------------------------------------------------------

instance (ToHtmlM a) => ToHtmlM [a] where
    toHtmlM :: [a] -> HtmlReaderState
toHtmlM [] = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty
    toHtmlM (a
a : [a]
as) = do
        Delayed (HtmlT Identity ())
aHtml <- a -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM a
a
        Delayed (HtmlT Identity ())
asHtml <- [a] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [a]
as
        Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ())
aHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
asHtml)

instance (ToHtmlM a) => ToHtmlM (Maybe a) where
    toHtmlM :: Maybe a -> HtmlReaderState
toHtmlM Maybe a
Nothing = Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty
    toHtmlM (Just a
a) = a -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM a
a

-- | ToHtmlM instance that can never be called, because there are
--   no values of type Void
instance ToHtmlM Void where
    toHtmlM :: Void -> HtmlReaderState
toHtmlM = Void -> HtmlReaderState
forall a. Void -> a
absurd

-------------------------------------------------------------------------------

-- | Groups raw text in <div> and leaves enums as they are
renderDivGrouped
    :: (ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special)
    => [TextTree lbrek fnref style enum special]
    -> HtmlReaderState
renderDivGrouped :: forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
[TextTree lbrek fnref style enum special] -> HtmlReaderState
renderDivGrouped = (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
(HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
renderGroupedTextTree HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ HtmlT Identity () -> HtmlT Identity ()
forall a. a -> a
id

-- | Extracts enums from list and wraps raw text (without enums) into textF_;
--   enums are wrapped into enumF_;
--   E.g. result: <span> raw text </span>
--                <div> <enum></enum> </div>
--                <span> raw reference </span>
renderGroupedTextTree
    :: (ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special)
    => (Html () -> Html ())
    -> (Html () -> Html ())
    -> [TextTree lbrek fnref style enum special]
    -> HtmlReaderState
renderGroupedTextTree :: forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
(HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
renderGroupedTextTree HtmlT Identity () -> HtmlT Identity ()
_ HtmlT Identity () -> HtmlT Identity ()
_ [] = HtmlT Identity () -> HtmlReaderState
forall a. a -> ReaderStateMonad (Delayed a)
returnNow HtmlT Identity ()
forall a. Monoid a => a
mempty
renderGroupedTextTree HtmlT Identity () -> HtmlT Identity ()
textF_ HtmlT Identity () -> HtmlT Identity ()
enumF_ (enum :: TextTree lbrek fnref style enum special
enum@(Enum enum
_) : [TextTree lbrek fnref style enum special]
ts) = do
    Delayed (HtmlT Identity ())
enumHtml <- TextTree lbrek fnref style enum special -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM TextTree lbrek fnref style enum special
enum
    Delayed (HtmlT Identity ())
followingHtml <- (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
(HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
renderGroupedTextTree HtmlT Identity () -> HtmlT Identity ()
textF_ HtmlT Identity () -> HtmlT Identity ()
enumF_ [TextTree lbrek fnref style enum special]
ts
    -- \| Wrap enum into enumF_
    Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ (HtmlT Identity () -> HtmlT Identity ()
enumF_ (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
enumHtml) Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
followingHtml
renderGroupedTextTree HtmlT Identity () -> HtmlT Identity ()
textF_ HtmlT Identity () -> HtmlT Identity ()
enumF_ [TextTree lbrek fnref style enum special]
tts =
    let ([TextTree lbrek fnref style enum special]
rawText, [TextTree lbrek fnref style enum special]
tts') = [TextTree lbrek fnref style enum special]
-> ([TextTree lbrek fnref style enum special],
    [TextTree lbrek fnref style enum special])
forall lbrk fnref style enum special.
[TextTree lbrk fnref style enum special]
-> ([TextTree lbrk fnref style enum special],
    [TextTree lbrk fnref style enum special])
getNextRawTextTree [TextTree lbrek fnref style enum special]
tts
     in do
            Delayed (HtmlT Identity ())
rawTextHtml <- [TextTree lbrek fnref style enum special] -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM [TextTree lbrek fnref style enum special]
rawText
            Delayed (HtmlT Identity ())
followingHtml <- (HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
forall fnref style enum special lbrek.
(ToHtmlM fnref, ToCssClass style, ToHtmlM enum, ToHtmlM special) =>
(HtmlT Identity () -> HtmlT Identity ())
-> (HtmlT Identity () -> HtmlT Identity ())
-> [TextTree lbrek fnref style enum special]
-> HtmlReaderState
renderGroupedTextTree HtmlT Identity () -> HtmlT Identity ()
textF_ HtmlT Identity () -> HtmlT Identity ()
enumF_ [TextTree lbrek fnref style enum special]
tts'
            -- \| Wrap raw text without enums into textF_
            Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ()) -> HtmlReaderState)
-> Delayed (HtmlT Identity ()) -> HtmlReaderState
forall a b. (a -> b) -> a -> b
$ (HtmlT Identity () -> HtmlT Identity ()
textF_ (HtmlT Identity () -> HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Delayed (HtmlT Identity ())
rawTextHtml) Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
followingHtml

-------------------------------------------------------------------------------

-- | Render 'HeadingTextTree' with and without 'FootnoteRef's for normal and ToC usage
tocHeadingHtml
    :: [HeadingTextTree] -> ReaderStateMonad (Delayed (Html ()), Delayed (Html ()))
tocHeadingHtml :: [HeadingTextTree]
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
tocHeadingHtml [] = (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty, Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty)
tocHeadingHtml (HeadingTextTree
h : [HeadingTextTree]
hs) = do
    Delayed (HtmlT Identity ())
normalHtml <- HeadingTextTree -> HtmlReaderState
forall a. ToHtmlM a => a -> HtmlReaderState
toHtmlM HeadingTextTree
h
    let tocHtml :: Delayed (HtmlT Identity ())
tocHtml = case HeadingTextTree
h of
            FootnoteRef FootnoteReference
_ -> Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty
            HeadingTextTree
_ -> Delayed (HtmlT Identity ())
normalHtml
    (Delayed (HtmlT Identity ())
tocRest, Delayed (HtmlT Identity ())
normalRest) <- [HeadingTextTree]
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
tocHeadingHtml [HeadingTextTree]
hs

    (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
-> ReaderStateMonad
     (Delayed (HtmlT Identity ()), Delayed (HtmlT Identity ()))
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed (HtmlT Identity ())
tocHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
tocRest, Delayed (HtmlT Identity ())
normalHtml Delayed (HtmlT Identity ())
-> Delayed (HtmlT Identity ()) -> Delayed (HtmlT Identity ())
forall a. Semigroup a => a -> a -> a
<> Delayed (HtmlT Identity ())
normalRest)

-------------------------------------------------------------------------------

htmlError :: Text -> Html ()
htmlError :: Text -> HtmlT Identity ()
htmlError Text
msg = [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
span_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.InlineError (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml (Text
"Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg :: Text)

-- | Takes Maybe HtmlId and a parse error and renders a centered parse error box
parseErrorHtml :: Maybe Text -> ParseErrorBundle Text Void -> Html ()
parseErrorHtml :: Maybe Text -> ParseError -> HtmlT Identity ()
parseErrorHtml Maybe Text
mHtmlId ParseError
errBundle = do
    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.CenteredBox (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$
        [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_ [Class -> Attributes
cssClass_ Class
Class.ErrorBox, Class -> Attributes
cssClass_ Class
Class.Anchor, Maybe Text -> Attributes
mTextId_ Maybe Text
mHtmlId] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
            [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h1_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.DocumentTitle (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ HtmlT Identity ()
"Parsing failed!"
            HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
pre_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
code_ ([Attributes] -> HtmlT Identity () -> HtmlT Identity ())
-> Class -> HtmlT Identity () -> HtmlT Identity ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.LargeFontSize (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ String -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => String -> HtmlT m ()
toHtml (String -> HtmlT Identity ()) -> String -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseError
errBundle