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

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

-- | HTML class or id selector.
data Variation = Class | Id

-- | 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 -> 
  let tb :: String -> Doc
tb String
c = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"<" forall a. [a] -> [a] -> [a]
++ String
c forall a. [a] -> [a] -> [a]
++ String
">"
  in [Doc] -> Doc
sepf [String -> Doc
tb String
s, Doc -> Doc
indent Doc
x, String -> Doc
tb forall a b. (a -> b) -> a -> b
$ Char
'/'forall a. a -> [a] -> [a]
:String
s]
wrapGen' [Doc] -> Doc
sepf Variation
Class String
s Doc
_ [String]
ts = \Doc
x ->
  let tb :: String -> Doc
tb String
c = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"<" forall a. [a] -> [a] -> [a]
++ String
c forall a. [a] -> [a] -> [a]
++ String
" class=\"" forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. [a] -> [a] -> [a]
(++) (forall a. a -> [a] -> [a]
intersperse String
" " [String]
ts) forall a. [a] -> [a] -> [a]
++ String
"\">"
  in let te :: String -> Doc
te String
c = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"</" forall a. [a] -> [a] -> [a]
++ String
c forall a. [a] -> [a] -> [a]
++ String
">"
  in [Doc] -> Doc
sepf [String -> Doc
tb String
s, Doc -> Doc
indent Doc
x, String -> Doc
te String
s]
wrapGen' [Doc] -> Doc
sepf Variation
Id String
s Doc
ti [String]
_ = \Doc
x ->
  let tb :: String -> Doc
tb String
c = String -> Doc
text (String
"<" forall a. [a] -> [a] -> [a]
++ String
c forall a. [a] -> [a] -> [a]
++ String
" id=\"") Doc -> Doc -> Doc
<> Doc
ti Doc -> Doc -> Doc
<> String -> Doc
text String
"\">"
      te :: String -> Doc
te String
c = String -> Doc
text forall a b. (a -> b) -> a -> b
$ String
"</" forall a. [a] -> [a] -> [a]
++ String
c forall a. [a] -> [a] -> [a]
++ String
">"
  in [Doc] -> Doc
sepf [String -> Doc
tb String
s, Doc -> Doc
indent Doc
x, String -> Doc
te 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 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
"<" forall a. [a] -> [a] -> [a]
++ String
t forall a. [a] -> [a] -> [a]
++ String
" ") Doc -> Doc -> Doc
<> forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Doc -> 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 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 = 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=#" forall a. [a] -> [a] -> [a]
++ String
rf 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=#" forall a. [a] -> [a] -> [a]
++ String
rf 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=\"" forall a. [a] -> [a] -> [a]
++ String
rf 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 -> Doc -> MaxWidthPercent -> Doc
image :: Doc -> Doc -> MaxWidthPercent -> Doc
image Doc
f Doc
c MaxWidthPercent
100 = 
  Doc -> Doc
figure forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
  [(String, Doc)] -> Doc
img [(String
"src", Doc
f), (String
"alt", Doc
c)],
  Doc -> Doc
figcaption Doc
c]
image Doc
f Doc
c MaxWidthPercent
wp =
  Doc -> Doc
figure forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
  [(String, Doc)] -> Doc
img [(String
"src", Doc
f), (String
"alt", Doc
c), (String
"width", String -> Doc
text forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show MaxWidthPercent
wp forall a. [a] -> [a] -> [a]
++ String
"%")],
  Doc -> Doc
figcaption 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 (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 (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