-- | Helper functions for creating HTML printers (specifically, HTML tag wrappers).
module Language.Drasil.HTML.Helpers where

import Prelude hiding ((<>))
import Text.PrettyPrint (Doc, text, empty, ($$), (<>), (<+>), vcat, hcat, nest,
  cat, hcat)
import Data.List (intersperse)

import Language.Drasil hiding (Expr)

--import Language.Drasil.Document (Document, MaxWidthPercent)
import Language.Drasil.Printing.AST (Expr, 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 :: 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" []

ol, ul, table :: [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"

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 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"

-- | 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"]

-- | Helper for wrapping divisions or sections.
refwrap :: Doc -> Doc -> Doc
refwrap :: Doc -> Doc -> Doc
refwrap = (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
"div") [String
""]

-- | 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"

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

-- Not used since we use MathJax handles this
-- | Create and markup fractions
-- fraction :: Doc -> Doc -> Doc
-- fraction a b =
--   divTag ["fraction"] (spanTag ["fup"] a $$ spanTag ["fdn"] b)

-- Not used since we use MathJax handles this
-- -- | Build cases for case expressions
-- cases :: [(Expr,Expr)] -> (Expr -> Doc) -> Doc
-- cases ps pExpr = spanTag ["casebr"] (text "{") $$ divTag ["cases"] 
--                   (makeCases ps pExpr)

-- | Build case expressions.
makeCases :: [(Expr,Expr)] -> (Expr -> Doc) -> Doc                 
makeCases :: [(Expr, Expr)] -> (Expr -> Doc) -> Doc
makeCases [] Expr -> Doc
_ = Doc
empty
makeCases ((Expr, Expr)
p:[(Expr, Expr)]
ps) Expr -> Doc
pExpr = [String] -> Doc -> Doc
spanTag [] (Expr -> Doc
pExpr ((Expr, Expr) -> Expr
forall a b. (a, b) -> a
fst (Expr, Expr)
p) Doc -> Doc -> Doc
<> String -> Doc
text String
" , " Doc -> Doc -> Doc
<>
                          [String] -> Doc -> Doc
spanTag [String
"case"] (Expr -> Doc
pExpr ((Expr, Expr) -> Expr
forall a b. (a, b) -> b
snd (Expr, Expr)
p))) Doc -> Doc -> Doc
$$
                          [(Expr, Expr)] -> (Expr -> Doc) -> Doc
makeCases [(Expr, Expr)]
ps Expr -> Doc
pExpr