-- | Helper functions for creating HTML printers (specifically, HTML tag wrappers).
module Language.Drasil.HTML.Helpers (
  -- * Types
  BibFormatter(..), Variation(..),
  -- * Tag Wrappers
  html, headTag, body, title, paragraph, code, tr, th, td, figure, figcaption,
  li, pa, ba, dd, ol, ul, table, dl, img, h, divTag, spanTag, spanTag',
  image, em, sup, sub, bold,
  -- * Misc.
  wrap, wrap', wrapGen, wrapGen', wrapInside, tagL, tagR, indent,
  caption, descWrap, refwrap, refwrap', reflink, reflinkInfo, reflinkURI,
  articleTitle, author
) where
import Prelude hiding ((<>))
import Data.List (intersperse)
import Text.PrettyPrint (Doc, text, empty, (<>), (<+>), vcat, hcat, nest,
  cat)

import Language.Drasil (MaxWidthPercent)

import Language.Drasil.Printing.AST (Spec)

-- | Data type that carries functions that vary
-- for bib printing
data BibFormatter = BibFormatter {
  -- | Emphasis (italics) rendering
  BibFormatter -> Doc -> Doc
emph :: Doc -> Doc,
  -- | Spec rendering
  BibFormatter -> Spec -> Doc
spec :: Spec -> Doc
}

html, headTag, body, title, paragraph, code, tr, th, td, figure,
  figcaption, li, pa, ba, dd :: Doc -> Doc
-- | HTML tag wrapper.
html :: Doc -> Doc
html       = String -> [String] -> Doc -> Doc
wrap String
"html" []
-- | Head tag wrapper.
headTag :: Doc -> Doc
headTag   = String -> [String] -> Doc -> Doc
wrap String
"head" []
-- | Body tag wrapper.
body :: Doc -> Doc
body       = String -> [String] -> Doc -> Doc
wrap String
"body" []
-- | Title tag wrapper.
title :: Doc -> Doc
title      = String -> [String] -> Doc -> Doc
wrap String
"title" []
-- | Paragraph tag wrapper.
paragraph :: Doc -> Doc
paragraph  = String -> [String] -> Doc -> Doc
wrap String
"p" [String
"paragraph"]
-- | Code tag wrapper.
code :: Doc -> Doc
code       = String -> [String] -> Doc -> Doc
wrap String
"code" [String
"code"]
-- | Table row tag wrapper.
tr :: Doc -> Doc
tr         = String -> [String] -> Doc -> Doc
wrap String
"tr" []
-- | Table header tag wrapper.
th :: Doc -> Doc
th         = String -> [String] -> Doc -> Doc
wrap String
"th" []
-- | Table cell tag wrapper.
td :: Doc -> Doc
td         = String -> [String] -> Doc -> Doc
wrap String
"td" []
-- | Figure tag wrapper.
figure :: Doc -> Doc
figure     = String -> [String] -> Doc -> Doc
wrap String
"figure" []
-- | Figcaption tag wrapper.
figcaption :: Doc -> Doc
figcaption = String -> [String] -> Doc -> Doc
wrap String
"figcaption" []
-- | List tag wrapper.
li :: Doc -> Doc
li         = String -> [String] -> Doc -> Doc
wrap String
"li" []
-- | Paragraph in list tag wrapper.
pa :: Doc -> Doc
pa         = String -> [String] -> Doc -> Doc
wrap String
"p" []
-- | Bring attention to element wrapper.
ba :: Doc -> Doc
ba         = String -> [String] -> Doc -> Doc
wrap String
"b" []
-- | Description wrapper
dd :: Doc -> Doc
dd         = String -> [String] -> Doc -> Doc
wrap String
"dd" []

ol, ul, table, dl :: [String] -> Doc -> Doc
-- | Ordered list tag wrapper.
ol :: [String] -> Doc -> Doc
ol       = String -> [String] -> Doc -> Doc
wrap String
"ol"
-- | Unordered list tag wrapper.
ul :: [String] -> Doc -> Doc
ul       = String -> [String] -> Doc -> Doc
wrap String
"ul"
-- | Table tag wrapper.
table :: [String] -> Doc -> Doc
table    = String -> [String] -> Doc -> Doc
wrap String
"table"
-- | Description list wrapper
dl :: [String] -> Doc -> Doc
dl       = String -> [String] -> Doc -> Doc
wrap String
"dl"

img :: [(String, Doc)] -> Doc
-- | Image tag wrapper.
img :: [(String, Doc)] -> Doc
img        = String -> [(String, Doc)] -> Doc
wrapInside String
"img"

-- | Helper for HTML headers.
h :: Int -> Doc -> Doc
h :: Int -> Doc -> Doc
h Int
n       | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> Doc -> Doc
forall a. HasCallStack => String -> a
error String
"Illegal header (too small)"
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 = String -> Doc -> Doc
forall a. HasCallStack => String -> a
error String
"Illegal header (too large)"
          | Bool
otherwise = String -> [String] -> Doc -> Doc
wrap (String
"h" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) []

-- | HTML attribute selector.
data Variation = Class | Id | Align | Title deriving Variation -> Variation -> Bool
(Variation -> Variation -> Bool)
-> (Variation -> Variation -> Bool) -> Eq Variation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Variation -> Variation -> Bool
== :: Variation -> Variation -> Bool
$c/= :: Variation -> Variation -> Bool
/= :: Variation -> Variation -> Bool
Eq

instance Show Variation where
  show :: Variation -> String
show Variation
Class = String
"class"
  show Variation
Id    = String
"id"
  show Variation
Align = String
"align"
  show Variation
Title = String
"title"

-- | General 'Class' wrapper function and formats the document space with 'cat'.
wrap :: String -> [String] -> Doc -> Doc
wrap :: String -> [String] -> Doc -> Doc
wrap String
a = Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen Variation
Class String
a Doc
empty

-- | General wrapper function and formats the document space with 'hcat'.
wrap' :: String -> [String] -> Doc -> Doc
wrap' :: String -> [String] -> Doc -> Doc
wrap' String
a = ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
hcat Variation
Class String
a Doc
empty

-- | Helper for wrapping HTML tags.
-- The fourth argument provides class names for the CSS.
wrapGen' :: ([Doc] -> Doc) -> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' :: ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
sepf Variation
_ String
s Doc
_ [] = \Doc
x ->
  [Doc] -> Doc
sepf [String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">", Doc -> Doc
indent Doc
x, String -> Doc
tagR String
s]
wrapGen' [Doc] -> Doc
sepf Variation
Class String
s Doc
_ [String]
ts = \Doc
x ->
  let val :: Doc
val = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (String -> String -> String) -> [String] -> String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" " [String]
ts)
  in [Doc] -> Doc
sepf [String -> Variation -> Doc -> Doc
tagL String
s Variation
Class Doc
val, Doc -> Doc
indent Doc
x, String -> Doc
tagR String
s]
wrapGen' [Doc] -> Doc
sepf Variation
v String
s Doc
ti [String]
_ = \Doc
x ->
  let con :: Doc
con = if Variation
v Variation -> Variation -> Bool
forall a. Eq a => a -> a -> Bool
== Variation
Align then Doc
x else Doc -> Doc
indent Doc
x
  in [Doc] -> Doc
sepf [String -> Variation -> Doc -> Doc
tagL String
s Variation
v Doc
ti, Doc
con, String -> Doc
tagR String
s]

-- | General wrapper that formats the document space nicely.
wrapGen :: Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen :: Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen = ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
cat

-- | Helper for creating a left HTML tag with a single attribute.
tagL :: String -> Variation -> Doc -> Doc
tagL :: String -> Variation -> Doc -> Doc
tagL String
t Variation
a Doc
v = String -> Doc
text (String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Variation -> String
forall a. Show a => a -> String
show Variation
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=\"") Doc -> Doc -> Doc
<> Doc
v Doc -> Doc -> Doc
<> String -> Doc
text String
"\">"

-- | Helper for creating a right HTML closing tag.
tagR :: String -> Doc
tagR :: String -> Doc
tagR String
t = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Helper for wrapping attributes in a tag.
--
--     * The first argument is tag name.
--     * The 'String' in the pair is the attribute name,
--     * The 'Doc' is the value for different attributes.
wrapInside :: String -> [(String, Doc)] -> Doc
wrapInside :: String -> [(String, Doc)] -> Doc
wrapInside String
t [(String, Doc)]
p = String -> Doc
text (String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") Doc -> Doc -> Doc
<> (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Doc -> Doc -> Doc
(<>) (((String, Doc) -> Doc) -> [(String, Doc)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String, Doc) -> Doc
foldStr [(String, Doc)]
p) Doc -> Doc -> Doc
<> String -> Doc
text String
">"
  where foldStr :: (String, Doc) -> Doc
foldStr (String
attr, Doc
val) = String -> Doc
text (String
attr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=\"") Doc -> Doc -> Doc
<> Doc
val Doc -> Doc -> Doc
<> String -> Doc
text String
"\" "

-- | Helper for setting up captions.
caption :: Doc -> Doc
caption :: Doc -> Doc
caption = String -> [String] -> Doc -> Doc
wrap String
"p" [String
"caption"]

descWrap :: [String] -> Doc -> Doc -> Doc
descWrap :: [String] -> Doc -> Doc -> Doc
descWrap = (Doc -> [String] -> Doc -> Doc) -> [String] -> Doc -> Doc -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen Variation
Class String
"dt")

-- | Helper for wrapping divisions or sections.
-- Arguments: Wrapper element type/tag (e.g., p, div, a), attribute value, body text
refwrap' :: String -> Doc -> Doc -> Doc
refwrap' :: String -> Doc -> Doc -> Doc
refwrap' String
a = (Doc -> [String] -> Doc -> Doc) -> [String] -> Doc -> Doc -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen Variation
Id String
a) [String
""]

refwrap :: Doc -> Doc -> Doc
refwrap :: Doc -> Doc -> Doc
refwrap = String -> Doc -> Doc -> Doc
refwrap' String
"div"

-- | Helper for setting up links to references.
reflink :: String -> Doc -> Doc
reflink :: String -> Doc -> Doc
reflink String
rf Doc
txt = String -> Doc
text (String
"<a href=#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">") Doc -> Doc -> Doc
<> Doc
txt Doc -> Doc -> Doc
<> String -> Doc
text String
"</a>"

-- | Helper for setting up links to references with additional information.
reflinkInfo :: String -> Doc -> Doc -> Doc
reflinkInfo :: String -> Doc -> Doc -> Doc
reflinkInfo String
rf Doc
txt Doc
info = String -> Doc
text (String
"<a href=#" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">") Doc -> Doc -> Doc
<> Doc
txt Doc -> Doc -> Doc
<> String -> Doc
text String
"</a>" Doc -> Doc -> Doc
<+> Doc
info

-- | Helper for setting up links to external URIs.
reflinkURI :: String -> Doc -> Doc
reflinkURI :: String -> Doc -> Doc
reflinkURI String
rf Doc
txt = String -> Doc
text (String
"<a href=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rf String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\">") Doc -> Doc -> Doc
<> Doc
txt Doc -> Doc -> Doc
<> String -> Doc
text String
"</a>"

-- | Helper for setting up figures.
image :: Doc -> Maybe Doc -> MaxWidthPercent -> Doc
image :: Doc -> Maybe Doc -> MaxWidthPercent -> Doc
image Doc
f Maybe Doc
Nothing MaxWidthPercent
wp =
  Doc -> Doc
figure (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [[(String, Doc)] -> Doc
img ([(String, Doc)] -> Doc) -> [(String, Doc)] -> Doc
forall a b. (a -> b) -> a -> b
$ [(String
"src", Doc
f), (String
"alt", String -> Doc
text String
"")] [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. [a] -> [a] -> [a]
++ [(String
"width", String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ MaxWidthPercent -> String
forall a. Show a => a -> String
show MaxWidthPercent
wp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"%") | MaxWidthPercent
wp MaxWidthPercent -> MaxWidthPercent -> Bool
forall a. Eq a => a -> a -> Bool
/= MaxWidthPercent
100]]
image Doc
f (Just Doc
c) MaxWidthPercent
wp =
  Doc -> Doc
figure (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [[(String, Doc)] -> Doc
img ([(String, Doc)] -> Doc) -> [(String, Doc)] -> Doc
forall a b. (a -> b) -> a -> b
$ [(String
"src", Doc
f), (String
"alt", Doc
c)] [(String, Doc)] -> [(String, Doc)] -> [(String, Doc)]
forall a. [a] -> [a] -> [a]
++ [(String
"width", String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ MaxWidthPercent -> String
forall a. Show a => a -> String
show MaxWidthPercent
wp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"%") | MaxWidthPercent
wp MaxWidthPercent -> MaxWidthPercent -> Bool
forall a. Eq a => a -> a -> Bool
/= MaxWidthPercent
100], Doc -> Doc
figcaption (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Figure: " Doc -> Doc -> Doc
<> Doc
c]

em, sup, sub, bold :: Doc -> Doc
-- | Emphasis (italics) tag.
em :: Doc -> Doc
em = String -> [String] -> Doc -> Doc
wrap' String
"em" []
-- | Superscript tag.
sup :: Doc -> Doc
sup = String -> [String] -> Doc -> Doc
wrap' String
"sup" []
-- | Subscript tag.
sub :: Doc -> Doc
sub = String -> [String] -> Doc -> Doc
wrap' String
"sub" []
-- | Bold tag.
bold :: Doc -> Doc
bold = String -> [String] -> Doc -> Doc
wrap' String
"b" []

articleTitle, author :: Doc -> Doc
-- | Title header.
articleTitle :: Doc -> Doc
articleTitle Doc
t = [String] -> Doc -> Doc
divTag [String
"title"]  (Int -> Doc -> Doc
h Int
1 Doc
t)
-- | Author header.
author :: Doc -> Doc
author Doc
a        = [String] -> Doc -> Doc
divTag [String
"author"] (Int -> Doc -> Doc
h Int
2 Doc
a)

-- | Div tag wrapper.
divTag :: [String] -> Doc -> Doc
divTag :: [String] -> Doc -> Doc
divTag = String -> [String] -> Doc -> Doc
wrap String
"div"

-- | Span tag wrapper.
spanTag :: [String] -> Doc -> Doc
spanTag :: [String] -> Doc -> Doc
spanTag = String -> [String] -> Doc -> Doc
wrap String
"span"

-- | Span tag wrapper with a title attribute.
spanTag' :: Doc -> Doc -> Doc
spanTag' :: Doc -> Doc -> Doc
spanTag' Doc
t = ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
hcat Variation
Title String
"span" Doc
t [String
""]

-- | Indent the Document by 2 positions.
indent :: Doc -> Doc
indent :: Doc -> Doc
indent = Int -> Doc -> Doc
nest Int
2