{-# HLINT ignore "Avoid lambda using `infix`" #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Language.Ltml.HTML.Common
    ( -- * Custom State Monad
      HtmlReaderState
    , ReaderStateMonad
    , runReaderState
    , GlobalState (..)
    , ReaderState (..)
    , initGlobalState
    , initReaderState

      -- * SectionID Functions
    , incSectionID
    , incInsertedSectionID
    , resetInsertedSectionID
    , incSuperSectionID

      -- * Footnotes
    , FootnoteMap
    , convertLabelMap
    , addUsedFootnotes
    , FootnoteSet
    , NumLabel (..)

      -- * Table of Contents
    , ToC
    , TocEntry
    , TocCategory (..)
    , addTocEntry
    , addPhantomTocEntry
    , PhantomTocEntry
    , RenderedTocEntry
    , Result (..)
    , result

      -- * Enum Styles
    , EnumStyleMap

      -- * Labels
    , LabelWrapper
    , TocEntryWrapper
    , anchorLink
    , pageLink
    , mainPageAnchorLink
    , collectExportSection
    , exportLink
    , setHasErrors

      -- * @ Delayed @ data type
    , Delayed (..)
    , evalDelayed
    , returnNow
    ) where

import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Monad.State (State, get, modify, runState)
import Data.Aeson (FromJSON, ToJSON)
import Data.ByteString.Lazy (ByteString)
import Data.DList (DList, snoc)
import qualified Data.DList as DList (empty)
import Data.Map (Map)
import qualified Data.Map as Map (empty)
import Data.OpenApi (ToSchema)
import Data.Set (Set)
import qualified Data.Set as Set (empty)
import Data.Text (Text, cons, pack)
import GHC.Generics (Generic)
import Language.Lsd.AST.Common (Fallback, NavTocHeading)
import Language.Lsd.AST.Format
import Language.Lsd.AST.Type.Enum (EnumFormat)
import Language.Lsd.AST.Type.Section (SectionFormat)
import Language.Ltml.AST.Footnote (Footnote)
import Language.Ltml.AST.Label (Label (unLabel))
import qualified Language.Ltml.HTML.CSS.Classes as Class
import Language.Ltml.HTML.CSS.Util (cssClass_, (<#>))
import Lucid (Html, a_, div_, href_, span_, toHtml)

-- TODO: Third ConfigState? With custom Reader Monad that is read only

-- | The Reader Monad is used for local tracking (e.g. enumNestingLevel).
--   The State Monad is used for global tracking (e.g. sectionIDs).
--   The Delayed type is used for delaying the actual lookup of references in the GlobalState.
--   This allows forward references, because at first a delayed object is build,
--   which is then evaluated aterwards with the final GlobalState.
type HtmlReaderState = ReaderStateMonad (Delayed (Html ()))

type ReaderStateMonad a = ReaderT ReaderState (State GlobalState) a

runReaderState
    :: ReaderStateMonad a -> ReaderState -> GlobalState -> (a, GlobalState)
runReaderState :: forall a.
ReaderStateMonad a
-> ReaderState -> GlobalState -> (a, GlobalState)
runReaderState ReaderStateMonad a
ma ReaderState
readerState = State GlobalState a -> GlobalState -> (a, GlobalState)
forall s a. State s a -> s -> (a, s)
runState (ReaderStateMonad a -> ReaderState -> State GlobalState a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderStateMonad a
ma ReaderState
readerState)

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

data GlobalState = GlobalState
    { GlobalState -> Bool
hasFlagged :: Bool
    -- ^ Is set True at every (Flagged ...); used to determine if current Flagged
    --   has any Flagged children
    , GlobalState -> Int
currentSuperSectionID :: Int
    -- ^ Tracks the current super-section number
    , GlobalState -> Int
currentSectionID :: Int
    -- ^ Tracks the current section number
    , GlobalState -> Int
currentInsertedSectionID :: Int
    -- ^ Tracks the current inserted section number
    , GlobalState -> Int
currentParagraphID :: Int
    -- ^ Tracks the current paragraph number in the current section
    , GlobalState -> Int
currentSentenceID :: Int
    -- ^ Tracks the current sentence number in the current paragraph
    , GlobalState -> Int
currentEnumItemID :: Int
    -- ^ Tracks the current enum item number in the current enumeration
    , GlobalState -> Int
currentFootnoteID :: Int
    -- ^ Tracks the id of the next footnote
    , GlobalState -> FootnoteMap
usedFootnoteMap :: FootnoteMap
    -- ^ Maps all used footnotes labels to their id as an Int as Html
    --   and their text as Delayed Html, since they can also include references;
    --   This map is build during rendering with entries from "footnoteMap"
    --   from 'ReaderState' and an additional id;
    --   Note: This map is document-scoped. Thus, it is reset when entering
    --         the next document.
    , GlobalState -> FootnoteSet
locallyUsedFootnotes :: FootnoteSet
    -- ^ Holds a set of all footnotes that were used in the current section.
    --   When leaving a section, this is reset to the intial value.
    --   It is used to collect footnotes that should be rendered at the end
    --   of the current section (in ascending order of their footnote id).
    , GlobalState -> [(Label, HtmlT Identity ())]
labels :: [(Label, Html ())]
    -- ^ Holds all labels and the Html element that should be displayed when this label is referenced
    , GlobalState -> ToC
tableOfContents :: ToC
    -- ^ Holds all entries for the table of contents as (Maybe key (e.g. § 1),
    --   title, HTML id as anchor link, category). The title is wrapped into 'Result'.
    --   In case of an parse error this title will be set to an Error title.
    --   The 'Left' constructor holds metadata for the Frontend,
    --   which is ignored when rendering the 'ToC'.
    , GlobalState -> Text
mangledLabelName :: Text
    -- ^ Mangled prefix name for generating new label names that do not exist in source language
    , GlobalState -> Int
mangledLabelID :: Int
    -- ^ Mangled postfix ID which is incremented and added to mangledLabelName to create unique htmlID
    , GlobalState -> EnumStyleMap
enumStyles :: EnumStyleMap
    -- ^ Maps EnumFormats to their css class name which implements the fitting Counter
    , GlobalState -> Text
mangledEnumCounterName :: Text
    -- ^ Holds prefix for generating new css class names for enum counter styles
    , GlobalState -> Int
mangledEnumCounterID :: Int
    -- ^ Holds postfix id which makes enum counter class name unique
    , GlobalState -> [(Text, Delayed Text, Delayed (HtmlT Identity ()))]
exportSections :: [(Text, Delayed Text, Delayed (Html ()))]
    -- ^ Collects all (non-super) sections as their their @htmlID@, their 'Html' and their title
    , GlobalState -> Fallback NavTocHeading
documentFallbackTitle :: Fallback NavTocHeading
    -- ^ Holds a fallback ToC title to send to the Frontend, if parsing the main
    --   Document failes. This is set by the DocumentContainer.
    , GlobalState -> Delayed (HtmlT Identity ())
mainDocumentTitleHtml :: Delayed (Html ())
    -- ^ Styled title of the main Document for building exported sections
    , GlobalState -> Delayed Text
mainDocumentTitle :: Delayed Text
    -- ^ Raw title of the main Document for building HTML headers
    , GlobalState -> Bool
hasErrors :: Bool
    -- ^ True if any error occured while parsing;
    --   Note: "soft" errors like undefined labels are not catched
    }

data ReaderState = ReaderState
    { ReaderState -> Bool
shouldRender :: Bool
    -- ^ Is set True at every (Flagged True ...); to tell child Flagged to render
    , ReaderState -> Bool
hasGlobalToC :: Bool
    -- ^ Signals if a Document should have a global or local ToC (if it has any);
    --   Is set by the DocumentContainer
    , ReaderState -> Bool
appendixHasGlobalToC :: Bool
    -- ^ Should Documents inside of an AppendixSection should have a global ToC?
    --   This also means all Headings of those Documents appear in the global ToC
    , ReaderState -> Int
currentAppendixElementID :: Int
    -- ^ Tracks the current appendix element (document) id;
    --   This is in ReaderState, since it is controlled from the AppendixSection
    , ReaderState -> IdentifierFormat
appendixElementIdFormat :: IdentifierFormat
    -- ^ Tracks the identifier format of the current appendix element (document)
    , ReaderState -> TocKeyFormat
appendixElementTocKeyFormat :: TocKeyFormat
    -- ^ Tracks the toc key format of the current appendix element (document)
    , ReaderState -> Maybe Label
appendixElementMLabel :: Maybe Label
    -- ^ Holds the Maybe Label of the current (Node Document) in appendices;
    --   Used as a jump id inside the Document Heading
    , ReaderState -> Either (HeadingFormat 'False) (HeadingFormat 'True)
documentHeadingFormat :: Either (HeadingFormat False) (HeadingFormat True)
    -- ^ Holds format for current document heading
    --   (comes from DocumentContainer or AppendixSection)
    , ReaderState -> SectionFormat
localSectionFormat :: SectionFormat
    -- ^ Defines the local 'SectionFormat'; is set by the 'SectionFormatted' wrapper
    , ReaderState -> Bool
isSingleParagraph :: Bool
    -- ^ Signals the child paragraph that it is the only child and thus should
    --   not have an visible identifier
    , ReaderState -> IdentifierFormat
currentEnumIDFormatString :: IdentifierFormat
    -- ^ Holds the FormatString that describes how the current enum item shoud
    --   be referenced
    , ReaderState -> Map Label Footnote
footnoteMap :: Map Label Footnote
    -- ^ Holds a map of all footnotes in the current document;
    --   This is generated by the parser; some footnotes in this map
    --   might never be rendered (if they are not referenced from any section)
    , ReaderState -> LabelWrapper
labelWrapperFunc :: LabelWrapper
    -- ^ Wrapper around the Reference Html inside the TextTree (e.g. for adding anchor links)
    , ReaderState -> LabelWrapper
footnoteWrapperFunc :: LabelWrapper
    -- ^ Wrapper around Footnote reference Html inside the TextTree (e.g. for adding anchor links)
    , ReaderState -> TocEntryWrapper
tocEntryWrapperFunc :: TocEntryWrapper
    -- ^ Wrapper around an ToC entry (e.g. for adding anchor links)
    , ReaderState -> TocEntryWrapper
tocButtonWrapperFunc :: TocEntryWrapper
    -- ^ Wrapper around the button in the right column of the ToC (e.g. for adding page links)
    , ReaderState -> LabelWrapper
exportLinkWrapper :: LabelWrapper
    -- ^ Wrapper around the ID of a section at the end of it (e.g. for adding export links)
    }

initGlobalState :: GlobalState
initGlobalState :: GlobalState
initGlobalState =
    GlobalState
        { hasFlagged :: Bool
hasFlagged = Bool
False
        , currentSuperSectionID :: Int
currentSuperSectionID = Int
1
        , currentSectionID :: Int
currentSectionID = Int
0
        , currentInsertedSectionID :: Int
currentInsertedSectionID = Int
0
        , currentParagraphID :: Int
currentParagraphID = Int
1
        , currentSentenceID :: Int
currentSentenceID = Int
0
        , currentEnumItemID :: Int
currentEnumItemID = Int
1
        , currentFootnoteID :: Int
currentFootnoteID = Int
1
        , usedFootnoteMap :: FootnoteMap
usedFootnoteMap = []
        , locallyUsedFootnotes :: FootnoteSet
locallyUsedFootnotes = FootnoteSet
forall a. Set a
Set.empty
        , labels :: [(Label, HtmlT Identity ())]
labels = []
        , tableOfContents :: ToC
tableOfContents = ToC
forall a. DList a
DList.empty
        , mangledLabelName :: Text
mangledLabelName = Text
"_TOC_ENTRY_"
        , mangledLabelID :: Int
mangledLabelID = Int
0
        , enumStyles :: EnumStyleMap
enumStyles = []
        , mangledEnumCounterName :: Text
mangledEnumCounterName = Text
"_ENUM_STYLE_"
        , mangledEnumCounterID :: Int
mangledEnumCounterID = Int
0
        , exportSections :: [(Text, Delayed Text, Delayed (HtmlT Identity ()))]
exportSections = []
        , documentFallbackTitle :: Fallback NavTocHeading
documentFallbackTitle = [Char] -> Fallback NavTocHeading
forall a. HasCallStack => [Char] -> a
error [Char]
"Undefined Main Document Fallback Heading!"
        , mainDocumentTitleHtml :: Delayed (HtmlT Identity ())
mainDocumentTitleHtml = Delayed (HtmlT Identity ())
forall a. Monoid a => a
mempty
        , mainDocumentTitle :: Delayed Text
mainDocumentTitle = Delayed Text
forall a. Monoid a => a
mempty
        , hasErrors :: Bool
hasErrors = Bool
False
        }

initReaderState :: ReaderState
initReaderState :: ReaderState
initReaderState =
    ReaderState
        { shouldRender :: Bool
shouldRender = Bool
False
        , hasGlobalToC :: Bool
hasGlobalToC = Bool
False
        , appendixHasGlobalToC :: Bool
appendixHasGlobalToC = Bool
False
        , currentAppendixElementID :: Int
currentAppendixElementID = Int
1
        , appendixElementIdFormat :: IdentifierFormat
appendixElementIdFormat = [Char] -> IdentifierFormat
forall a. HasCallStack => [Char] -> a
error [Char]
"Undefined appendix element id format!"
        , appendixElementTocKeyFormat :: TocKeyFormat
appendixElementTocKeyFormat = [Char] -> TocKeyFormat
forall a. HasCallStack => [Char] -> a
error [Char]
"Undefined appendix element ToC format!"
        , appendixElementMLabel :: Maybe Label
appendixElementMLabel = Maybe Label
forall a. Maybe a
Nothing
        , documentHeadingFormat :: Either (HeadingFormat 'False) (HeadingFormat 'True)
documentHeadingFormat = [Char] -> Either (HeadingFormat 'False) (HeadingFormat 'True)
forall a. HasCallStack => [Char] -> a
error [Char]
"Undefined HeadingFormat!"
        , localSectionFormat :: SectionFormat
localSectionFormat = [Char] -> SectionFormat
forall a. HasCallStack => [Char] -> a
error [Char]
"Undefined SectionFormat!"
        , isSingleParagraph :: Bool
isSingleParagraph = Bool
False
        , currentEnumIDFormatString :: IdentifierFormat
currentEnumIDFormatString = [Char] -> IdentifierFormat
forall a. HasCallStack => [Char] -> a
error [Char]
"Undefined enum id format!"
        , footnoteMap :: Map Label Footnote
footnoteMap = Map Label Footnote
forall k a. Map k a
Map.empty
        , -- \| Default rendering method is "preview", so no anchor links
          --    and no export links at all
          labelWrapperFunc :: LabelWrapper
labelWrapperFunc = (HtmlT Identity () -> HtmlT Identity ()) -> LabelWrapper
forall a b. a -> b -> a
const HtmlT Identity () -> HtmlT Identity ()
forall a. a -> a
id -- anchorLink
        , footnoteWrapperFunc :: LabelWrapper
footnoteWrapperFunc = (HtmlT Identity () -> HtmlT Identity ()) -> LabelWrapper
forall a b. a -> b -> a
const HtmlT Identity () -> HtmlT Identity ()
forall a. a -> a
id
        , tocEntryWrapperFunc :: TocEntryWrapper
tocEntryWrapperFunc = LabelWrapper -> TocEntryWrapper
forall a b. a -> b -> a
const (LabelWrapper -> TocEntryWrapper)
-> LabelWrapper -> TocEntryWrapper
forall a b. (a -> b) -> a -> b
$ (HtmlT Identity () -> HtmlT Identity ()) -> LabelWrapper
forall a b. a -> b -> a
const HtmlT Identity () -> HtmlT Identity ()
forall a. a -> a
id
        , tocButtonWrapperFunc :: TocEntryWrapper
tocButtonWrapperFunc = LabelWrapper -> TocEntryWrapper
forall a b. a -> b -> a
const LabelWrapper
anchorLink
        , exportLinkWrapper :: LabelWrapper
exportLinkWrapper = (HtmlT Identity () -> HtmlT Identity ()) -> LabelWrapper
forall a b. a -> b -> a
const HtmlT Identity () -> HtmlT Identity ()
forall a. Monoid a => a
mempty
        }

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

-- | Increments currentSectionID in GlobalState
incSectionID :: ReaderT r (State GlobalState) ()
incSectionID :: forall r. ReaderT r (State GlobalState) ()
incSectionID = (GlobalState -> GlobalState) -> ReaderT r (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentSectionID = currentSectionID s + 1})

-- | Increments currentInsertedSectionID in GlobalState
incInsertedSectionID :: ReaderT r (State GlobalState) ()
incInsertedSectionID :: forall r. ReaderT r (State GlobalState) ()
incInsertedSectionID = (GlobalState -> GlobalState) -> ReaderT r (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentInsertedSectionID = currentInsertedSectionID s + 1})

-- | Reset currentInsertedSectionID to initial value
resetInsertedSectionID :: ReaderT r (State GlobalState) ()
resetInsertedSectionID :: forall r. ReaderT r (State GlobalState) ()
resetInsertedSectionID =
    (GlobalState -> GlobalState) -> ReaderT r (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        (\GlobalState
s -> GlobalState
s {currentInsertedSectionID = currentInsertedSectionID initGlobalState})

-- | Increments currentSuperSectionID in GlobalState
incSuperSectionID :: ReaderT r (State GlobalState) ()
incSuperSectionID :: forall r. ReaderT r (State GlobalState) ()
incSuperSectionID = (GlobalState -> GlobalState) -> ReaderT r (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {currentSuperSectionID = currentSuperSectionID s + 1})

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

-- | Maps Label to (ID, Text) as int and (delayed) html
type FootnoteMap = [(Label, (Int, Html (), Delayed (Html ())))]

-- | Converts FootnoteMap to Label Map used for "normal" references
convertLabelMap :: FootnoteMap -> [(Label, Html ())]
convertLabelMap :: FootnoteMap -> [(Label, HtmlT Identity ())]
convertLabelMap = ((Label, (Int, HtmlT Identity (), Delayed (HtmlT Identity ())))
 -> (Label, HtmlT Identity ()))
-> FootnoteMap -> [(Label, HtmlT Identity ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(Label
label, (Int
_, HtmlT Identity ()
idHtml, Delayed (HtmlT Identity ())
_)) -> (Label
label, HtmlT Identity ()
idHtml))

-- | Adds used footnotes of base state to add state (appends at the front)
addUsedFootnotes
    :: GlobalState
    -- ^ Base State
    -> GlobalState
    -- ^ Add State
    -> GlobalState
addUsedFootnotes :: GlobalState -> GlobalState -> GlobalState
addUsedFootnotes GlobalState
base GlobalState
add =
    GlobalState
base
        { locallyUsedFootnotes = locallyUsedFootnotes add <> locallyUsedFootnotes base
        }

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

-- | Set of footnote labels with their respective footnote id
type FootnoteSet = Set NumLabel

-- | Used for sorted insertion into the set of footnotes;
--   The Labels must be sorted by their footnote id
newtype NumLabel = NumLabel {NumLabel -> (Int, Label)
unNumLabel :: (Int, Label)}

instance Eq NumLabel where
    (NumLabel (Int
a, Label
_)) == :: NumLabel -> NumLabel -> Bool
== (NumLabel (Int
b, Label
_)) = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b

instance Ord NumLabel where
    compare :: NumLabel -> NumLabel -> Ordering
compare (NumLabel (Int
a, Label
_)) (NumLabel (Int
b, Label
_)) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
b

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

-- | The ToC uses a difference list to get constant time appending at the end, which has no speed draw backs,
--   since the list is evaluated only ones when building the ToC Html at the end of rendering.
type ToC = DList (Either PhantomTocEntry TocEntry)

type TocEntry = (Maybe (Html ()), Result (Delayed (Html ())), Text, TocCategory)

data TocCategory = SomeSection | Other

-- | Toc Entry that only exists to send info to the Frontend;
--   It is ignored when rendering a ToC
type PhantomTocEntry = (Maybe (Html ()), Result (Html ()))

-- | Add entry to table of contents with: key Html (e.g. § 1), title Html and html anchor link id;
--   If Label is present uses it as the anchor link id, otherwise it creates a new mangled label name;
--   the used label name is returned;
addTocEntry
    :: Maybe (Html ())
    -> Result (Delayed (Html ()))
    -> Maybe Label
    -> TocCategory
    -> ReaderStateMonad Text
addTocEntry :: Maybe (HtmlT Identity ())
-> Result (Delayed (HtmlT Identity ()))
-> Maybe Label
-> TocCategory
-> ReaderStateMonad Text
addTocEntry Maybe (HtmlT Identity ())
mKey Result (Delayed (HtmlT Identity ()))
title Maybe Label
mLabel TocCategory
cat = do
    GlobalState
globalState <- ReaderT ReaderState (State GlobalState) GlobalState
forall s (m :: * -> *). MonadState s m => m s
get
    Text
htmlId <- case Maybe Label
mLabel of
        -- \| Create new mangled name for non existing label
        Maybe Label
Nothing ->
            -- \| Build mangled name by appending unique id to mangled label name
            let mangledLabel :: Text
mangledLabel = GlobalState -> Text
mangledLabelName GlobalState
globalState Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (GlobalState -> Int
mangledLabelID GlobalState
globalState))
             in do
                    -- \| Increment mangled label id for next mangled label
                    (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {mangledLabelID = mangledLabelID s + 1})
                    Text -> ReaderStateMonad Text
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
mangledLabel
        Just Label
label -> Text -> ReaderStateMonad Text
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ReaderStateMonad Text) -> Text -> ReaderStateMonad Text
forall a b. (a -> b) -> a -> b
$ Label -> Text
unLabel Label
label
    (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        ( \GlobalState
s ->
            GlobalState
s
                { tableOfContents = snoc (tableOfContents s) (Right (mKey, title, htmlId, cat))
                }
        )
    Text -> ReaderStateMonad Text
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
htmlId

-- | Adds a phantom entry into the table of contents, which is ignored when rendering.
--   Its only purpose is to tell the frontend if a parse error occured in this segment.
--   This is only meant to be used for segments that do not have a normal Toc entry,
--   like @SimpleSection@s.
addPhantomTocEntry
    :: Result (Html ()) -> ReaderStateMonad ()
addPhantomTocEntry :: Result (HtmlT Identity ())
-> ReaderT ReaderState (State GlobalState) ()
addPhantomTocEntry Result (HtmlT Identity ())
resHtml =
    -- \| Phantom Entries do not have an ID and are not Delayed;
    --    Nothing is still needed to fit into the (ID, Title) scheme
    let tocEntry :: (Maybe a, Result (HtmlT Identity ()))
tocEntry = (Maybe a
forall a. Maybe a
Nothing, Result (HtmlT Identity ())
resHtml)
     in (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {tableOfContents = snoc (tableOfContents s) (Left tocEntry)})

-- | Type of exported ToC Entries (especially for Frontend);
--   @Result@ signals if the generated title was parsed successfully or not
type RenderedTocEntry = (Maybe ByteString, Result ByteString)

data Result a = Success a | Error a
    deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> [Char]
(Int -> Result a -> ShowS)
-> (Result a -> [Char]) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
showsPrec :: Int -> Result a -> ShowS
$cshow :: forall a. Show a => Result a -> [Char]
show :: Result a -> [Char]
$cshowList :: forall a. Show a => [Result a] -> ShowS
showList :: [Result a] -> ShowS
Show, (forall x. Result a -> Rep (Result a) x)
-> (forall x. Rep (Result a) x -> Result a) -> Generic (Result a)
forall x. Rep (Result a) x -> Result a
forall x. Result a -> Rep (Result a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Result a) x -> Result a
forall a x. Result a -> Rep (Result a) x
$cfrom :: forall a x. Result a -> Rep (Result a) x
from :: forall x. Result a -> Rep (Result a) x
$cto :: forall a x. Rep (Result a) x -> Result a
to :: forall x. Rep (Result a) x -> Result a
Generic)

instance (ToJSON a) => ToJSON (Result a)

instance (FromJSON a) => FromJSON (Result a)

instance (ToSchema a) => ToSchema (Result a)

-- | Takes a @Result a@, a success function and an error function.
--   Applies one of the two functions depending on the 'Result' constructor.
result :: (a -> b) -> (a -> b) -> Result a -> b
result :: forall a b. (a -> b) -> (a -> b) -> Result a -> b
result a -> b
fSuc a -> b
fErr Result a
res = case Result a
res of
    Success a
a -> a -> b
fSuc a
a
    Error a
a -> a -> b
fErr a
a

instance Functor Result where
    fmap :: forall a b. (a -> b) -> Result a -> Result b
fmap a -> b
f (Success a
a) = b -> Result b
forall a. a -> Result a
Success (a -> b
f a
a)
    fmap a -> b
f (Error a
a) = b -> Result b
forall a. a -> Result a
Error (a -> b
f a
a)

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

-- | Maps EnumFormat to css class name which implements the counter:
--   Is used for reusing already existing classes, if the same EnumFormat occurs again
type EnumStyleMap = [(EnumFormat, Text)]

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

-- | Type of function thats used to wrap Label information around Html;
--   e.g. for adding anchor links
type LabelWrapper = Label -> Html () -> Html ()

type TocEntryWrapper = TocCategory -> LabelWrapper

-- | Converts 'Label' into @<a href = "#<label>">@ for jumping to a HTML id
anchorLink :: LabelWrapper
anchorLink :: LabelWrapper
anchorLink Label
label =
    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
a_
        [ Class -> Attributes
cssClass_ Class
Class.AnchorLink
        , Text -> Attributes
href_ (Char -> Text -> Text
cons Char
'#' (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Label -> Text
unLabel Label
label)
        ]

-- | Converts 'Label' into @<a href = "<path>/<label>.html">@ for jumping
--   to another page
pageLink
    :: FilePath
    -- ^ Path prefix
    -> TocEntryWrapper
pageLink :: [Char] -> TocEntryWrapper
pageLink [Char]
_ TocCategory
Other Label
_ = HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a b. a -> b -> a
const HtmlT Identity ()
forall a. Monoid a => a
mempty
pageLink [Char]
path TocCategory
_ Label
label =
    [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
a_ [Class -> Attributes
cssClass_ Class
Class.ButtonLink, Text -> Attributes
href_ ([Char] -> Label -> Text
labelPath [Char]
path Label
label)]

-- | Converts 'Label' into @<a href = "<path>#<label>">@ for jumping
--   to another pages anchor
mainPageAnchorLink :: FilePath -> LabelWrapper
mainPageAnchorLink :: [Char] -> LabelWrapper
mainPageAnchorLink [Char]
path Label
label = [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
a_ [Class -> Attributes
cssClass_ Class
Class.AnchorLink, Text -> Attributes
href_ ([Char] -> Text
pack [Char]
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Label -> Text
unLabel Label
label)]

-- | Builds a link with 'labelPath', prefix "Zur Einzelansicht"
--   and adds some vertical spacing
exportLink :: FilePath -> LabelWrapper
exportLink :: [Char] -> LabelWrapper
exportLink [Char]
path Label
label =
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
div_
        (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
a_ [Class -> Attributes
cssClass_ Class
Class.AnchorLink, Text -> Attributes
href_ ([Char] -> Label -> Text
labelPath [Char]
path Label
label)]
        (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
span_ ([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
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml (Text
"↗ " :: Text)) HtmlT Identity () -> HtmlT Identity () -> HtmlT Identity ()
forall a. Semigroup a => a -> a -> a
<>)

-- | Builds "<path>/<label>.html"
labelPath :: FilePath -> Label -> Text
labelPath :: [Char] -> Label -> Text
labelPath [Char]
path Label
label = [Char] -> Text
pack [Char]
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" 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
".html"

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

-- | Adds a 'Section' with @htmlId@ and HTML @title@ to 'GlobalState'
collectExportSection
    :: Text -> Delayed Text -> Delayed (Html ()) -> ReaderStateMonad ()
collectExportSection :: Text
-> Delayed Text
-> Delayed (HtmlT Identity ())
-> ReaderT ReaderState (State GlobalState) ()
collectExportSection Text
htmlId Delayed Text
title Delayed (HtmlT Identity ())
sectionHtml =
    (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        (\GlobalState
s -> GlobalState
s {exportSections = (htmlId, title, sectionHtml) : exportSections s})

-- | Sets the 'hasErrors' flag to @True@
setHasErrors :: ReaderStateMonad ()
setHasErrors :: ReaderT ReaderState (State GlobalState) ()
setHasErrors = (GlobalState -> GlobalState)
-> ReaderT ReaderState (State GlobalState) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\GlobalState
s -> GlobalState
s {hasErrors = True})

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

data Delayed a = Now a | Later (GlobalState -> a)

evalDelayed :: GlobalState -> Delayed a -> a
evalDelayed :: forall a. GlobalState -> Delayed a -> a
evalDelayed GlobalState
_ (Now a
a) = a
a
evalDelayed GlobalState
s (Later GlobalState -> a
fa) = GlobalState -> a
fa GlobalState
s

returnNow :: a -> ReaderStateMonad (Delayed a)
returnNow :: forall a. a -> ReaderStateMonad (Delayed a)
returnNow = Delayed a -> ReaderT ReaderState (State GlobalState) (Delayed a)
forall a. a -> ReaderT ReaderState (State GlobalState) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delayed a -> ReaderT ReaderState (State GlobalState) (Delayed a))
-> (a -> Delayed a)
-> a
-> ReaderT ReaderState (State GlobalState) (Delayed a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Delayed a
forall a. a -> Delayed a
Now

instance (Monoid a) => Monoid (Delayed a) where
    mempty :: Delayed a
mempty = a -> Delayed a
forall a. a -> Delayed a
Now a
forall a. Monoid a => a
mempty

instance (Semigroup a) => Semigroup (Delayed a) where
    Now a
a <> :: Delayed a -> Delayed a -> Delayed a
<> Now a
b = a -> Delayed a
forall a. a -> Delayed a
Now (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    Now a
a <> Later GlobalState -> a
fb = (GlobalState -> a) -> Delayed a
forall a. (GlobalState -> a) -> Delayed a
Later (\GlobalState
s -> a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> GlobalState -> a
fb GlobalState
s)
    Later GlobalState -> a
fa <> Now a
b = (GlobalState -> a) -> Delayed a
forall a. (GlobalState -> a) -> Delayed a
Later (\GlobalState
s -> GlobalState -> a
fa GlobalState
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    Later GlobalState -> a
fa <> Later GlobalState -> a
fb = (GlobalState -> a) -> Delayed a
forall a. (GlobalState -> a) -> Delayed a
Later (\GlobalState
s -> GlobalState -> a
fa GlobalState
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> GlobalState -> a
fb GlobalState
s)

instance Functor Delayed where
    fmap :: forall a b. (a -> b) -> Delayed a -> Delayed b
fmap a -> b
f (Now a
a) = b -> Delayed b
forall a. a -> Delayed a
Now (b -> Delayed b) -> b -> Delayed b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
    fmap a -> b
f (Later GlobalState -> a
fa) = (GlobalState -> b) -> Delayed b
forall a. (GlobalState -> a) -> Delayed a
Later (a -> b
f (a -> b) -> (GlobalState -> a) -> GlobalState -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> a
fa)

instance Applicative Delayed where
    pure :: forall a. a -> Delayed a
pure = a -> Delayed a
forall a. a -> Delayed a
Now

    Now a -> b
fa <*> :: forall a b. Delayed (a -> b) -> Delayed a -> Delayed b
<*> Now a
a = b -> Delayed b
forall a. a -> Delayed a
Now (a -> b
fa a
a)
    Now a -> b
fa <*> Later GlobalState -> a
fsa = (GlobalState -> b) -> Delayed b
forall a. (GlobalState -> a) -> Delayed a
Later (a -> b
fa (a -> b) -> (GlobalState -> a) -> GlobalState -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GlobalState -> a
fsa)
    Later GlobalState -> a -> b
fsfa <*> Now a
a = (GlobalState -> b) -> Delayed b
forall a. (GlobalState -> a) -> Delayed a
Later (\GlobalState
s -> GlobalState -> a -> b
fsfa GlobalState
s a
a)
    Later GlobalState -> a -> b
fsfa <*> Later GlobalState -> a
fsa = (GlobalState -> b) -> Delayed b
forall a. (GlobalState -> a) -> Delayed a
Later (\GlobalState
s -> GlobalState -> a -> b
fsfa GlobalState
s (GlobalState -> a
fsa GlobalState
s))

instance Monad Delayed where
    return :: forall a. a -> Delayed a
return = a -> Delayed a
forall a. a -> Delayed a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    Now a
a >>= :: forall a b. Delayed a -> (a -> Delayed b) -> Delayed b
>>= a -> Delayed b
fa = a -> Delayed b
fa a
a
    Later GlobalState -> a
fsa >>= a -> Delayed b
fa =
        (GlobalState -> b) -> Delayed b
forall a. (GlobalState -> a) -> Delayed a
Later
            ( \GlobalState
s -> case a -> Delayed b
fa (a -> Delayed b) -> a -> Delayed b
forall a b. (a -> b) -> a -> b
$ GlobalState -> a
fsa GlobalState
s of
                Now b
b -> b
b
                Later GlobalState -> b
fsb -> GlobalState -> b
fsb GlobalState
s
            )