{-# LANGUAGE OverloadedStrings #-}
module Language.Drasil.HTML.Render(
  genHTML, HTMLGenOptions(..), defaultHTMLGO,
  renderHTML
) where

import Data.Text (Text)
import qualified Data.Text as T (pack, show)

import Drasil.Data.Formats.HTML

import Language.Drasil.HTML.Citation (printBib)
import Language.Drasil.HTML.MathJax (mathJax3Url, mathJaxScript, blockEqn)
import Language.Drasil.HTML.Spec (printSpec, specToHTML)
import qualified Language.Drasil.Printing.AST as AST
import qualified Language.Drasil.Printing.LayoutObj as AST
import qualified Language.Drasil.TeX.Print as TeX (spec, printMath)

-- | Options for converting layout objects ('LayoutObj's) into HTML AST
newtype HTMLGenOptions = HTMLGO {HTMLGenOptions -> Text
mathJaxSrc :: Text}

-- | Default 'HTMLGenOptions' using the standard MathJax CDN URL.
defaultHTMLGO :: HTMLGenOptions
defaultHTMLGO :: HTMLGenOptions
defaultHTMLGO = Text -> HTMLGenOptions
HTMLGO Text
mathJax3Url

-- | Generate an HTML document from a Drasil 'Document'.
--   Arguments: Rendering options, CSS file name, `Document` to be rendered
genHTML :: HTMLGenOptions -> String -> AST.Document -> HTML
genHTML :: HTMLGenOptions -> String -> Document -> HTML
genHTML HTMLGenOptions
rOpts String
fn (AST.Document Title
t Title
a [LayoutObj]
c) = [HTMLHead] -> [HTMLBody] -> HTML
HTML [HTMLHead]
heads [HTMLBody]
bodies
  where
    heads :: [HTMLHead]
heads =
      [ Text -> HTMLHead
stylesheet (String -> Text
T.pack String
fn),
        Text -> HTMLHead
Title (Title -> Text
printSpec Title
t),
        [Attr] -> HTMLHead
Meta [Text -> Text -> Attr
attr Text
"charset" Text
"utf-8"],
        Text -> HTMLHead
inlineScript Text
mathJaxScript,
        Text -> [Attr] -> HTMLHead
externalScript
          (HTMLGenOptions -> Text
mathJaxSrc HTMLGenOptions
rOpts)
          [ Text -> Attr
id_ Text
"MathJax-script",
            Text -> Text -> Attr
attr Text
"async" Text
""
          ]
      ]
    bodies :: [HTMLBody]
bodies =
      [ [HTMLBody] -> HTMLBody
articleTitle (Title -> [HTMLBody]
specToHTML Title
t),
        [HTMLBody] -> HTMLBody
author (Title -> [HTMLBody]
specToHTML Title
a)
      ]
        [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> (LayoutObj -> [HTMLBody]) -> [LayoutObj] -> [HTMLBody]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HTMLGenOptions -> LayoutObj -> [HTMLBody]
loToHTML HTMLGenOptions
rOpts) [LayoutObj]
c

-- | Internal: Creates the title block for the HTML document.
articleTitle :: [HTMLBody] -> HTMLBody
articleTitle :: [HTMLBody] -> HTMLBody
articleTitle [HTMLBody]
t = [Attr] -> [HTMLBody] -> HTMLBody
Div [[Text] -> Attr
class_ [Text
"title"]] [HLevel -> [Attr] -> [HTMLBody] -> HTMLBody
Heading HLevel
H1 [] [HTMLBody]
t]

-- | Internal: Creates the author block for the HTML document.
author :: [HTMLBody] -> HTMLBody
author :: [HTMLBody] -> HTMLBody
author [HTMLBody]
a = [Attr] -> [HTMLBody] -> HTMLBody
Div [[Text] -> Attr
class_ [Text
"author"]] [HLevel -> [Attr] -> [HTMLBody] -> HTMLBody
Heading HLevel
H2 [] [HTMLBody]
a]

-- | Internal: Transforms layout objects ('LayoutObj's) into HTML.
loToHTML :: HTMLGenOptions -> AST.LayoutObj -> [HTMLBody]
loToHTML :: HTMLGenOptions -> LayoutObj -> [HTMLBody]
loToHTML HTMLGenOptions
_ (AST.EqnBlock Title
contents) =
  [Text -> HTMLBody
RawText (Text -> HTMLBody) -> Text -> HTMLBody
forall a b. (a -> b) -> a -> b
$ Text -> Text
blockEqn (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ D -> Doc
TeX.printMath (D -> Doc) -> D -> Doc
forall a b. (a -> b) -> a -> b
$ Title -> D
TeX.spec Title
contents]
loToHTML HTMLGenOptions
rOpts (AST.HDiv Tags
ts [LayoutObj]
layoutObs Title
l) =
  let classAttr :: [Attr]
classAttr = [[Text] -> Attr
class_ (String -> Text
T.pack (String -> Text) -> Tags -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tags
ts) | Bool -> Bool
not (Tags -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Tags
ts)]
      attrs :: [Attr]
attrs = Title -> [Attr]
specToIdAttr Title
l [Attr] -> [Attr] -> [Attr]
forall a. Semigroup a => a -> a -> a
<> [Attr]
classAttr
  in [[Attr] -> [HTMLBody] -> HTMLBody
Section [Attr]
attrs ((LayoutObj -> [HTMLBody]) -> [LayoutObj] -> [HTMLBody]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HTMLGenOptions -> LayoutObj -> [HTMLBody]
loToHTML HTMLGenOptions
rOpts) [LayoutObj]
layoutObs)]
loToHTML HTMLGenOptions
_ (AST.Paragraph Title
contents) = [[Attr] -> [HTMLBody] -> HTMLBody
Paragraph [[Text] -> Attr
class_ [Text
"paragraph"]] (Title -> [HTMLBody]
specToHTML Title
contents)]
loToHTML HTMLGenOptions
_ (AST.Table Tags
ts [[Title]]
rows Title
r Bool
b Title
t) = Tags -> [[Title]] -> Title -> Bool -> Title -> [HTMLBody]
makeTableHTML Tags
ts [[Title]]
rows Title
r Bool
b Title
t
loToHTML HTMLGenOptions
rOpts (AST.Definition [(String, [LayoutObj])]
ssPs Title
l) = HTMLGenOptions -> [(String, [LayoutObj])] -> Title -> [HTMLBody]
makeDefnHTML HTMLGenOptions
rOpts [(String, [LayoutObj])]
ssPs Title
l
loToHTML HTMLGenOptions
_ (AST.Header Depth
n Title
contents Title
_) =
  case Title -> [HTMLBody]
specToHTML Title
contents of
    [] -> []
    [HTMLBody]
ch -> [HLevel -> [Attr] -> [HTMLBody] -> HTMLBody
Heading (Depth -> HLevel
toHLevel Depth
n) [] [HTMLBody]
ch]
loToHTML HTMLGenOptions
_ (AST.List ListType
t) = [ListType -> HTMLBody
buildListHtml ListType
t]
loToHTML HTMLGenOptions
_ (AST.Figure Title
r Maybe Title
c String
f MaxWidthPercent
wp) =
  [[Attr] -> [HTMLBody] -> HTMLBody
Div [Text -> Attr
id_ (Title -> Text
printSpec Title
r)] [[Attr] -> [Attr] -> Text -> Text -> Text -> HTMLBody
figureImage [] [Attr]
attrs (String -> Text
T.pack String
f) Text
captionText (Text
"Figure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
captionText)]]
  where
    attrs :: [Attr]
attrs = [Text -> Text -> Attr
attr Text
"width" (MaxWidthPercent -> Text
forall a. Show a => a -> Text
T.show MaxWidthPercent
wp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%") | MaxWidthPercent
wp MaxWidthPercent -> MaxWidthPercent -> Bool
forall a. Eq a => a -> a -> Bool
/= MaxWidthPercent
100]
    captionText :: Text
captionText = (Title -> Text) -> Maybe Title -> Text
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Title -> Text
printSpec Maybe Title
c
loToHTML HTMLGenOptions
_ (AST.Bib BibRef
bib) = [BibRef -> HTMLBody
printBib BibRef
bib]
loToHTML HTMLGenOptions
_ AST.Graph {} = []
loToHTML HTMLGenOptions
_ AST.Cell {} = []
loToHTML HTMLGenOptions
_ AST.CodeBlock {} = []

-- | Internal: Generates an HTML table, called by 'loToHTML'.
makeTableHTML :: [String] -> [[AST.Spec]] -> AST.Spec -> Bool -> AST.Spec -> [HTMLBody]
makeTableHTML :: Tags -> [[Title]] -> Title -> Bool -> Title -> [HTMLBody]
makeTableHTML Tags
_ [] Title
_ Bool
_ Title
_ = String -> [HTMLBody]
forall a. HasCallStack => String -> a
error String
"No table to print (see Language.Drasil.HTML.Render)"
makeTableHTML Tags
ts ([Title]
l : [[Title]]
lls) Title
r Bool
b Title
t = [[Attr] -> [HTMLBody] -> HTMLBody
Div [Attr]
wrapperAttrs ([HTMLBody] -> HTMLBody) -> [HTMLBody] -> HTMLBody
forall a b. (a -> b) -> a -> b
$ HTMLBody
tableNode HTMLBody -> [HTMLBody] -> [HTMLBody]
forall a. a -> [a] -> [a]
: [HTMLBody
captionNode | Bool
b]]
  where
    attrs :: [Attr]
attrs = [[Text] -> Attr
class_ (String -> Text
T.pack (String -> Text) -> Tags -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Tags
ts)]
    headerRow :: Row
headerRow = [Attr] -> [Cell] -> Row
Row [] ([Attr] -> [HTMLBody] -> Cell
THeader [] ([HTMLBody] -> Cell) -> (Title -> [HTMLBody]) -> Title -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> [HTMLBody]
specToHTML (Title -> Cell) -> [Title] -> [Cell]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Title]
l)
    dataRows :: [Row]
dataRows = [Attr] -> [Cell] -> Row
Row [] ([Cell] -> Row) -> ([Title] -> [Cell]) -> [Title] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Title -> Cell) -> [Title] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Attr] -> [HTMLBody] -> Cell
TData [] ([HTMLBody] -> Cell) -> (Title -> [HTMLBody]) -> Title -> Cell
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Title -> [HTMLBody]
specToHTML) ([Title] -> Row) -> [[Title]] -> [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Title]]
lls
    tableNode :: HTMLBody
tableNode = [Attr] -> [Row] -> HTMLBody
Table [Attr]
attrs (Row
headerRow Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
dataRows)
    captionNode :: HTMLBody
captionNode = [Attr] -> [HTMLBody] -> HTMLBody
Paragraph [[Text] -> Attr
class_ [Text
"caption"]] (Title -> [HTMLBody]
specToHTML Title
t)
    wrapperAttrs :: [Attr]
wrapperAttrs = Title -> [Attr]
specToIdAttr Title
r

-- | Internal: Generates definition tables.
makeDefnHTML :: HTMLGenOptions -> [(String, [AST.LayoutObj])] -> AST.Spec -> [HTMLBody]
makeDefnHTML :: HTMLGenOptions -> [(String, [LayoutObj])] -> Title -> [HTMLBody]
makeDefnHTML HTMLGenOptions
_ [] Title
_ = String -> [HTMLBody]
forall a. HasCallStack => String -> a
error String
"Empty definition"
makeDefnHTML HTMLGenOptions
rOpts [(String, [LayoutObj])]
ps Title
l =
  let attrs :: [Attr]
attrs = Title -> [Attr]
specToIdAttr Title
l [Attr] -> [Attr] -> [Attr]
forall a. Semigroup a => a -> a -> a
<> [[Text] -> Attr
class_ [Text
"defn-table"]]
      refRow :: Row
refRow = [Attr] -> [Cell] -> Row
Row [] [[Attr] -> [HTMLBody] -> Cell
THeader [] [HTMLBody
"Refname"], [Attr] -> [HTMLBody] -> Cell
TData []
        [[HTMLBody] -> HTMLBody
bold_ (Title -> [HTMLBody]
specToHTML Title
l)]]
      dataRows :: [Row]
dataRows = ( \(String
f, [LayoutObj]
d) -> [Attr] -> [Cell] -> Row
Row [] [[Attr] -> [HTMLBody] -> Cell
THeader [] [String -> HTMLBody
rawText' String
f],
        [Attr] -> [HTMLBody] -> Cell
TData [] ((LayoutObj -> [HTMLBody]) -> [LayoutObj] -> [HTMLBody]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (HTMLGenOptions -> LayoutObj -> [HTMLBody]
loToHTML HTMLGenOptions
rOpts) [LayoutObj]
d)]) ((String, [LayoutObj]) -> Row) -> [(String, [LayoutObj])] -> [Row]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, [LayoutObj])]
ps
   in [[Attr] -> [Row] -> HTMLBody
Table [Attr]
attrs (Row
refRow Row -> [Row] -> [Row]
forall a. a -> [a] -> [a]
: [Row]
dataRows)]

-- | Internal: Generates lists in HTML.
buildListHtml :: AST.ListType -> HTMLBody
buildListHtml :: ListType -> HTMLBody
buildListHtml (AST.Simple [(Title, ItemType, Maybe Title)]
items) = [Attr] -> [HTMLBody] -> HTMLBody
Div [[Text] -> Attr
class_ [Text
"list"]] ([HTMLBody] -> HTMLBody) -> [HTMLBody] -> HTMLBody
forall a b. (a -> b) -> a -> b
$
  (\(Title
b, ItemType
e, Maybe Title
l) -> [Attr] -> [HTMLBody] -> HTMLBody
Paragraph (Maybe Title -> [Attr]
mbIdAttr Maybe Title
l)
  (Title -> [HTMLBody]
specToHTML Title
b [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> [HTMLBody
": "] [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> ItemType -> [HTMLBody]
itemToHTML ItemType
e)) ((Title, ItemType, Maybe Title) -> HTMLBody)
-> [(Title, ItemType, Maybe Title)] -> [HTMLBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Title, ItemType, Maybe Title)]
items
buildListHtml (AST.Desc [(Title, ItemType, Maybe Title)]
items) = [Attr] -> [HTMLBody] -> HTMLBody
Div [[Text] -> Attr
class_ [Text
"list"]] ([HTMLBody] -> HTMLBody) -> [HTMLBody] -> HTMLBody
forall a b. (a -> b) -> a -> b
$
  (\(Title
b, ItemType
e, Maybe Title
l) -> [Attr] -> [HTMLBody] -> HTMLBody
Paragraph (Maybe Title -> [Attr]
mbIdAttr Maybe Title
l)
  ([[HTMLBody] -> HTMLBody
bold_ (Title -> [HTMLBody]
specToHTML Title
b), HTMLBody
": "] [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> ItemType -> [HTMLBody]
itemToHTML ItemType
e)) ((Title, ItemType, Maybe Title) -> HTMLBody)
-> [(Title, ItemType, Maybe Title)] -> [HTMLBody]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Title, ItemType, Maybe Title)]
items
buildListHtml (AST.Ordered [(ItemType, Maybe Title)]
items) = ListType -> [Attr] -> [LItem] -> HTMLBody
List ListType
Ordered [[Text] -> Attr
class_ [Text
"list"]] ([LItem] -> HTMLBody) -> [LItem] -> HTMLBody
forall a b. (a -> b) -> a -> b
$ (ItemType, Maybe Title) -> LItem
mkLItem ((ItemType, Maybe Title) -> LItem)
-> [(ItemType, Maybe Title)] -> [LItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ItemType, Maybe Title)]
items
buildListHtml (AST.Unordered [(ItemType, Maybe Title)]
items) = ListType -> [Attr] -> [LItem] -> HTMLBody
List ListType
Unordered [[Text] -> Attr
class_ [Text
"list"]] ([LItem] -> HTMLBody) -> [LItem] -> HTMLBody
forall a b. (a -> b) -> a -> b
$ (ItemType, Maybe Title) -> LItem
mkLItem ((ItemType, Maybe Title) -> LItem)
-> [(ItemType, Maybe Title)] -> [LItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ItemType, Maybe Title)]
items
buildListHtml (AST.Definitions [(Title, ItemType, Maybe Title)]
items) = ListType -> [Attr] -> [LItem] -> HTMLBody
List ListType
Unordered [[Text] -> Attr
class_ [Text
"hide-list-style-no-indent"]] ([LItem] -> HTMLBody) -> [LItem] -> HTMLBody
forall a b. (a -> b) -> a -> b
$
  (\(Title
b, ItemType
e, Maybe Title
l) -> [Attr] -> [HTMLBody] -> LItem
LItem (Maybe Title -> [Attr]
mbIdAttr Maybe Title
l) (Title -> [HTMLBody]
specToHTML Title
b [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> [HTMLBody
" is the "] [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> ItemType -> [HTMLBody]
itemToHTML ItemType
e)) ((Title, ItemType, Maybe Title) -> LItem)
-> [(Title, ItemType, Maybe Title)] -> [LItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Title, ItemType, Maybe Title)]
items

-- | Internal: Helper to create list items.
mkLItem :: (AST.ItemType, Maybe AST.Spec) -> LItem
mkLItem :: (ItemType, Maybe Title) -> LItem
mkLItem (ItemType
i, Maybe Title
l) = [Attr] -> [HTMLBody] -> LItem
LItem (Maybe Title -> [Attr]
mbIdAttr Maybe Title
l) (ItemType -> [HTMLBody]
itemToHTML ItemType
i)

-- | Internal: Converts a 'Spec' label into an ID 'Attr' list, omitting empty labels.
specToIdAttr :: AST.Spec -> [Attr]
specToIdAttr :: Title -> [Attr]
specToIdAttr Title
AST.EmptyS = []
specToIdAttr Title
s          = [Text -> Attr
id_ (Title -> Text
printSpec Title
s)]

-- | Internal: Convert @Maybe Spec@s into ID `Attr`s if the `Spec` exists.
mbIdAttr :: Maybe AST.Spec -> [Attr]
mbIdAttr :: Maybe Title -> [Attr]
mbIdAttr = (Title -> [Attr]) -> Maybe Title -> [Attr]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Title -> [Attr]
specToIdAttr

-- | Internal: Generates list items.
itemToHTML :: AST.ItemType -> [HTMLBody]
itemToHTML :: ItemType -> [HTMLBody]
itemToHTML (AST.Flat Title
s)     = Title -> [HTMLBody]
specToHTML Title
s
itemToHTML (AST.Nested Title
s ListType
l) = Title -> [HTMLBody]
specToHTML Title
s [HTMLBody] -> [HTMLBody] -> [HTMLBody]
forall a. Semigroup a => a -> a -> a
<> [ListType -> HTMLBody
buildListHtml ListType
l]