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

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

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

-- | Helper for HTML headers.
h :: Int -> Doc -> Doc
h :: Int -> Doc -> Doc
h n :: Int
n       | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = String -> Doc -> Doc
forall a. HasCallStack => String -> a
error "Illegal header (too small)"
          | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 7 = String -> Doc -> Doc
forall a. HasCallStack => String -> a
error "Illegal header (too large)"
          | Bool
otherwise = String -> [String] -> Doc -> Doc
wrap ("h" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
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 a :: 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' a :: 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' sepf :: [Doc] -> Doc
sepf _ s :: String
s _ [] = \x :: Doc
x -> 
  let tb :: String -> Doc
tb c :: String
c = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">"
  in [Doc] -> Doc
sepf [String -> Doc
tb String
s, Doc -> Doc
indent Doc
x, String -> Doc
tb (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ '/'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s]
wrapGen' sepf :: [Doc] -> Doc
sepf Class s :: String
s _ ts :: [String]
ts = \x :: Doc
x ->
  let tb :: String -> Doc
tb c :: String
c = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " class=\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String -> String) -> [String] -> String
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]
ts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\">"
  in let te :: String -> Doc
te c :: String
c = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">"
  in [Doc] -> Doc
sepf [String -> Doc
tb String
s, Doc -> Doc
indent Doc
x, String -> Doc
te String
s]
wrapGen' sepf :: [Doc] -> Doc
sepf Id s :: String
s ti :: Doc
ti _ = \x :: Doc
x ->
  let tb :: String -> Doc
tb c :: String
c = String -> Doc
text ("<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ " id=\"") Doc -> Doc -> Doc
<> Doc
ti Doc -> Doc -> Doc
<> String -> Doc
text "\">"
      te :: String -> Doc
te c :: String
c = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ ">"
  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 t :: String
t p :: [(String, Doc)]
p = String -> Doc
text ("<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ " ") Doc -> Doc -> Doc
<> (Doc -> Doc -> Doc) -> [Doc] -> Doc
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 ">"
  where foldStr :: (String, Doc) -> Doc
foldStr (attr :: String
attr, val :: Doc
val) = String -> Doc
text (String
attr String -> String -> String
forall a. [a] -> [a] -> [a]
++ "=\"") Doc -> Doc -> Doc
<> Doc
val Doc -> Doc -> Doc
<> String -> Doc
text "\" "

-- | Helper for setting up captions. 
caption :: Doc -> Doc
caption :: Doc -> Doc
caption = String -> [String] -> Doc -> Doc
wrap "p" ["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 "div") [""]

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

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

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

-- | Helper for setting up figures.
image :: Doc -> Doc -> MaxWidthPercent -> Doc
image :: Doc -> Doc -> MaxWidthPercent -> Doc
image f :: Doc
f c :: Doc
c 100 = 
  Doc -> Doc
figure (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
  [(String, Doc)] -> Doc
img [("src", Doc
f), ("alt", Doc
c)],
  Doc -> Doc
figcaption Doc
c]
image f :: Doc
f c :: Doc
c wp :: MaxWidthPercent
wp =
  Doc -> Doc
figure (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [
  [(String, Doc)] -> Doc
img [("src", Doc
f), ("alt", Doc
c), ("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]
++ "%")],
  Doc -> Doc
figcaption Doc
c]

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

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

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

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

-- | Indent the Document by 2 positions.
indent :: Doc -> Doc
indent :: Doc -> Doc
indent = Int -> Doc -> Doc
nest 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 [] _ = Doc
empty
makeCases (p :: (Expr, Expr)
p:ps :: [(Expr, Expr)]
ps) pExpr :: 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 " , " Doc -> Doc -> Doc
<>
                          [String] -> Doc -> Doc
spanTag ["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