{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.HTML
    ( -- * Rendering HTML
      renderSectionHtmlCss
    , renderHtmlCss
    , renderHtmlCssWith
    , renderHtmlCssExport
    , renderHtmlCssBS

      -- * Rendering ToC Headings
    , renderTocList
    ) where

import Clay (Css)
import Control.Monad.Reader
import Control.Monad.State
import Data.Bifunctor (bimap)
import Data.ByteString.Lazy (ByteString)
import Data.DList (toList)
import qualified Data.Map as Map
import Data.Text (Text, pack)
import Language.Ltml.AST.DocumentContainer
    ( DocumentContainer (..)
    )
import Language.Ltml.AST.Footnote (Footnote (..))
import Language.Ltml.AST.Label (Label (..))
import Language.Ltml.AST.Section
import Language.Ltml.Common (Flagged')
import Language.Ltml.HTML.CSS (mainStylesheet)
import qualified Language.Ltml.HTML.CSS.Classes as Class
import Language.Ltml.HTML.CSS.Util
import Language.Ltml.HTML.Common
import Language.Ltml.HTML.ToHtmlM (toHtmlM)
import Lucid

-- | Render single @Node Section@ with given 'Footnote' Map to @Html ()@ and @Css@
renderSectionHtmlCss
    :: FormattedSection -> Map.Map Label Footnote -> (Html (), Css)
renderSectionHtmlCss :: FormattedSection -> Map Label Footnote -> (Html (), Css)
renderSectionHtmlCss FormattedSection
section Map Label Footnote
fnMap =
    -- \| Render with given footnote context
    let readerState :: ReaderState
readerState = ReaderState
initReaderState {footnoteMap = fnMap}
        (Delayed (Html ())
delayedHtml, GlobalState
finalState) = ReaderStateMonad (Delayed (Html ()))
-> ReaderState -> GlobalState -> (Delayed (Html ()), GlobalState)
forall a.
ReaderStateMonad a
-> ReaderState -> GlobalState -> (a, GlobalState)
runReaderState (FormattedSection -> ReaderStateMonad (Delayed (Html ()))
forall a. ToHtmlM a => a -> ReaderStateMonad (Delayed (Html ()))
toHtmlM FormattedSection
section) ReaderState
readerState GlobalState
initGlobalState
     in (GlobalState -> Delayed (Html ()) -> Html ()
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalState Delayed (Html ())
delayedHtml, EnumStyleMap -> Css
mainStylesheet (GlobalState -> EnumStyleMap
enumStyles GlobalState
finalState))

-- | Render @Flagged' DocumentContainer@ to @Html ()@ and @Css@
renderHtmlCss :: Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCss :: Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCss = ReaderState
-> GlobalState -> Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCssWith ReaderState
initReaderState GlobalState
initGlobalState

-- | Render a @Flagged' DocumentContainer@ to HTML and CSS with a given
--   initial 'ReaderState' and 'GlobalState'
renderHtmlCssWith
    :: ReaderState -> GlobalState -> Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCssWith :: ReaderState
-> GlobalState -> Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCssWith ReaderState
readerState GlobalState
globalState Flagged' DocumentContainer
docContainer =
    -- \| Render with given footnote context
    let (Delayed (Html ())
delayedHtml, GlobalState
finalState) = ReaderStateMonad (Delayed (Html ()))
-> ReaderState -> GlobalState -> (Delayed (Html ()), GlobalState)
forall a.
ReaderStateMonad a
-> ReaderState -> GlobalState -> (a, GlobalState)
runReaderState (Flagged' DocumentContainer -> ReaderStateMonad (Delayed (Html ()))
forall a. ToHtmlM a => a -> ReaderStateMonad (Delayed (Html ()))
toHtmlM Flagged' DocumentContainer
docContainer) ReaderState
readerState GlobalState
globalState
     in (GlobalState -> Delayed (Html ()) -> Html ()
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalState Delayed (Html ())
delayedHtml, EnumStyleMap -> Css
mainStylesheet (GlobalState -> EnumStyleMap
enumStyles GlobalState
finalState))

-- | Render a @Flagged' DocumentContainer@ with given states to main HTML, main CSS,
--   and list of exported sections. Fails, if any parse errors occur.
renderHtmlCssExport
    :: FilePath
    -- ^ Path from exported Sections to main HTML
    -> ReaderState
    -- ^ Used for document container
    -> GlobalState
    -> ReaderState
    -- ^ Used for exported sections
    -> Flagged' DocumentContainer
    -> Maybe
        ( Html ()
        , -- \^ HTML of whole Document
          Css
        , -- \^ Main Stylesheet
          [(Text, Text, Html ())]
        , -- \^ Exported sections Html with id and title
          Text
          -- \^ Raw textual title of the main document
        )
renderHtmlCssExport :: FilePath
-> ReaderState
-> GlobalState
-> ReaderState
-> Flagged' DocumentContainer
-> Maybe (Html (), Css, [(Text, Text, Html ())], Text)
renderHtmlCssExport FilePath
backPath ReaderState
readerState GlobalState
globalState ReaderState
exportReaderState Flagged' DocumentContainer
docCon =
    -- \| Render with given footnote context
    let (Delayed (Html ())
delayedHtml, GlobalState
finalState) = State GlobalState (Delayed (Html ()))
-> GlobalState -> (Delayed (Html ()), GlobalState)
forall s a. State s a -> s -> (a, s)
runState (ReaderStateMonad (Delayed (Html ()))
-> ReaderState -> State GlobalState (Delayed (Html ()))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Flagged' DocumentContainer -> ReaderStateMonad (Delayed (Html ()))
forall a. ToHtmlM a => a -> ReaderStateMonad (Delayed (Html ()))
toHtmlM Flagged' DocumentContainer
docCon) ReaderState
readerState) GlobalState
globalState
        -- \| Add footnote labes for "normal" (non-footnote) references
        mainHtml :: Html ()
mainHtml = GlobalState -> Delayed (Html ()) -> Html ()
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalState Delayed (Html ())
delayedHtml
        css :: Css
css = EnumStyleMap -> Css
mainStylesheet (GlobalState -> EnumStyleMap
enumStyles GlobalState
finalState)
        mainDocTitleHtml :: Delayed (Html ())
mainDocTitleHtml = GlobalState -> Delayed (Html ())
mainDocumentTitleHtml GlobalState
finalState
        rawMainDocTitle :: Text
rawMainDocTitle = GlobalState -> Delayed Text -> Text
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalState (Delayed Text -> Text) -> Delayed Text -> Text
forall a b. (a -> b) -> a -> b
$ GlobalState -> Delayed Text
mainDocumentTitle GlobalState
finalState
        -- \| Second render for exported sections
        -- TODO: get rid of second render run (its only because of the different labelWrapperFuncs)
        (Delayed (Html ())
_, GlobalState
finalExportState) = ReaderStateMonad (Delayed (Html ()))
-> ReaderState -> GlobalState -> (Delayed (Html ()), GlobalState)
forall a.
ReaderStateMonad a
-> ReaderState -> GlobalState -> (a, GlobalState)
runReaderState (Flagged' DocumentContainer -> ReaderStateMonad (Delayed (Html ()))
forall a. ToHtmlM a => a -> ReaderStateMonad (Delayed (Html ()))
toHtmlM Flagged' DocumentContainer
docCon) ReaderState
exportReaderState GlobalState
globalState
        backButton :: Html ()
backButton =
            Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ (Html () -> Html ()) -> Html () -> Html ()
forall a b. (a -> b) -> a -> b
$
                [Attributes] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
a_ [Class -> Attributes
cssClass_ Class
Class.ButtonLink, Text -> Attributes
href_ (Text -> Attributes) -> Text -> Attributes
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
pack FilePath
backPath] (Text -> Html ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml (Text
"←" :: Text))
        sections :: [(Text, Text, Html ())]
sections =
            ((Text, Delayed Text, Delayed (Html ())) -> (Text, Text, Html ()))
-> [(Text, Delayed Text, Delayed (Html ()))]
-> [(Text, Text, Html ())]
forall a b. (a -> b) -> [a] -> [b]
map
                ( \(Text
htmlId, Delayed Text
dTitle, Delayed (Html ())
dHtml) ->
                    ( Text
htmlId
                    , GlobalState -> Delayed Text -> Text
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalExportState Delayed Text
dTitle
                    , GlobalState -> Delayed (Html ()) -> Html ()
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalExportState
                        (Delayed (Html ()) -> Html ())
-> (Delayed (Html ()) -> Delayed (Html ()))
-> Delayed (Html ())
-> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (Html () -> Html ()) -> Delayed (Html ()) -> Delayed (Html ())
forall a b. (a -> b) -> Delayed a -> Delayed b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Html () -> Html () -> Html ()
forall a. a -> Html () -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html ()
backButton (Html () -> Html ()) -> (Html () -> Html ()) -> Html () -> Html ()
forall a. Semigroup a => a -> a -> a
<> [Attributes] -> Html () -> Html ()
forall arg result. Term arg result => arg -> result
div_ ([Attributes] -> Html () -> Html ()) -> Class -> Html () -> Html ()
forall a. ([Attributes] -> a) -> Class -> a
<#> Class
Class.Document)
                                (Delayed (Html ()) -> Delayed (Html ()))
-> (Delayed (Html ()) -> Delayed (Html ()))
-> Delayed (Html ())
-> Delayed (Html ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Delayed (Html ())
mainDocTitleHtml Delayed (Html ()) -> Delayed (Html ()) -> Delayed (Html ())
forall a. Semigroup a => a -> a -> a
<>)
                          )
                        (Delayed (Html ()) -> Html ()) -> Delayed (Html ()) -> Html ()
forall a b. (a -> b) -> a -> b
$ Delayed (Html ())
dHtml
                    )
                )
                (GlobalState -> [(Text, Delayed Text, Delayed (Html ()))]
exportSections GlobalState
finalExportState)
     in if GlobalState -> Bool
hasErrors GlobalState
finalState
            then Maybe (Html (), Css, [(Text, Text, Html ())], Text)
forall a. Maybe a
Nothing
            else (Html (), Css, [(Text, Text, Html ())], Text)
-> Maybe (Html (), Css, [(Text, Text, Html ())], Text)
forall a. a -> Maybe a
Just (Html ()
mainHtml, Css
css, [(Text, Text, Html ())]
sections, Text
rawMainDocTitle)

-- | Renders a @Flagged' DocumentContainer@ to HTML 'ByteString' with inlined CSS
renderHtmlCssBS :: Flagged' DocumentContainer -> ByteString
renderHtmlCssBS :: Flagged' DocumentContainer -> ByteString
renderHtmlCssBS Flagged' DocumentContainer
docCon =
    let (Html ()
body, Css
css) = Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCss Flagged' DocumentContainer
docCon
     in Html () -> ByteString
forall a. Html a -> ByteString
renderBS (Html () -> ByteString) -> Html () -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Css -> Html () -> Html ()
addInlineCssHeader FilePath
"Generated Document Preview" Css
css Html ()
body

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

-- | Renders a global ToC (including appendices) as a list of
--   either (@Maybe@ idHtml, @Result@ titleHtml) or a phantom result type
--   for @SimpleSection@s which do not have a @Heading@.
--   The @Result@ type signals the Frontend if an error occured while
--   parsing the segment.
renderTocList
    :: Flagged' DocumentContainer -> [RenderedTocEntry]
renderTocList :: Flagged' DocumentContainer -> [RenderedTocEntry]
renderTocList Flagged' DocumentContainer
docContainer =
    -- \| Create global ToC with Footnote context
    let (Delayed (Html ())
_, GlobalState
finalState) =
            State GlobalState (Delayed (Html ()))
-> GlobalState -> (Delayed (Html ()), GlobalState)
forall s a. State s a -> s -> (a, s)
runState
                ( ReaderStateMonad (Delayed (Html ()))
-> ReaderState -> State GlobalState (Delayed (Html ()))
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                    (Flagged' DocumentContainer -> ReaderStateMonad (Delayed (Html ()))
forall a. ToHtmlM a => a -> ReaderStateMonad (Delayed (Html ()))
toHtmlM Flagged' DocumentContainer
docContainer)
                    (ReaderState
initReaderState {appendixHasGlobalToC = True})
                )
                GlobalState
initGlobalState
        tocList :: [Either PhantomTocEntry TocEntry]
tocList = DList (Either PhantomTocEntry TocEntry)
-> [Either PhantomTocEntry TocEntry]
forall a. DList a -> [a]
toList (DList (Either PhantomTocEntry TocEntry)
 -> [Either PhantomTocEntry TocEntry])
-> DList (Either PhantomTocEntry TocEntry)
-> [Either PhantomTocEntry TocEntry]
forall a b. (a -> b) -> a -> b
$ GlobalState -> DList (Either PhantomTocEntry TocEntry)
tableOfContents GlobalState
finalState
        -- \| Produce (Just <span>id</span>, Success <span>title</span>);
        --    This creates one homogeneous list without Either
        htmlTitleList :: [PhantomTocEntry]
htmlTitleList =
            (Either PhantomTocEntry TocEntry -> PhantomTocEntry)
-> [Either PhantomTocEntry TocEntry] -> [PhantomTocEntry]
forall a b. (a -> b) -> [a] -> [b]
map
                ( (PhantomTocEntry -> PhantomTocEntry)
-> (TocEntry -> PhantomTocEntry)
-> Either PhantomTocEntry TocEntry
-> PhantomTocEntry
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                    ((Maybe (Html ()) -> Maybe (Html ()))
-> (Result (Html ()) -> Result (Html ()))
-> PhantomTocEntry
-> PhantomTocEntry
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ (Html () -> Html ()) -> Maybe (Html ()) -> Maybe (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ (Html () -> Html ()) -> Result (Html ()) -> Result (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>))
                    ( \(Maybe (Html ())
mId, Result (Delayed (Html ()))
rDt, Text
_, TocCategory
_) -> (Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ (Html () -> Html ()) -> Maybe (Html ()) -> Maybe (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Html ())
mId, Html () -> Html ()
forall arg result. Term arg result => arg -> result
span_ (Html () -> Html ())
-> (Delayed (Html ()) -> Html ()) -> Delayed (Html ()) -> Html ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> Delayed (Html ()) -> Html ()
forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
finalState (Delayed (Html ()) -> Html ())
-> Result (Delayed (Html ())) -> Result (Html ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result (Delayed (Html ()))
rDt)
                    )
                )
                [Either PhantomTocEntry TocEntry]
tocList
     in -- \| Render Maybe Html and Result Html to ByteString
        (PhantomTocEntry -> RenderedTocEntry)
-> [PhantomTocEntry] -> [RenderedTocEntry]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (Html ()) -> Maybe ByteString)
-> (Result (Html ()) -> Result ByteString)
-> PhantomTocEntry
-> RenderedTocEntry
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Html () -> ByteString) -> Maybe (Html ()) -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html () -> ByteString
forall a. Html a -> ByteString
renderBS) ((Html () -> ByteString) -> Result (Html ()) -> Result ByteString
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Html () -> ByteString
forall a. Html a -> ByteString
renderBS)) [PhantomTocEntry]
htmlTitleList

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