-- | Defines helper functions for creating Markdown files.
module Language.Drasil.Markdown.Helpers (
  bold, em, li, ul, divTag, centeredDiv, centeredDivId,
  reflink, reflinkInfo, reflinkURI, image, caption, heading, h, h',
  docLength
) where

import Prelude hiding ((<>), lookup)
import qualified Prelude as P ((<>))
import Data.List (intersperse)
import Data.Map (lookup)
import System.FilePath (takeFileName)
import Text.PrettyPrint (Doc, text, empty, (<>), (<+>), hcat, nest)

import Language.Drasil.Printing.Helpers (ast, ($^$), vsep)
import Language.Drasil.Printing.LayoutObj (RefMap)
import Drasil.Printers.Common

-- | 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 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 -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> 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 -> ShowS) -> [String] -> String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 String -> ShowS
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]

-- | 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 -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> Variation -> String
forall a. Show a => a -> String
show Variation
a String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> 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 -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> 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 -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> 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
foldStr ((String, Doc) -> Doc) -> [(String, Doc)] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(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 -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
"=\"") Doc -> Doc -> Doc
<> Doc
val Doc -> Doc -> Doc
<> String -> Doc
text String
"\" "

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

-- | Bold text
bold :: Doc -> Doc
bold :: Doc -> Doc
bold Doc
t = Doc
ast Doc -> Doc -> Doc
<> Doc
ast Doc -> Doc -> Doc
<> Doc
t Doc -> Doc -> Doc
<> Doc
ast Doc -> Doc -> Doc
<> Doc
ast

-- | Italicized text
em :: Doc -> Doc
em :: Doc -> Doc
em Doc
t = Doc
ast Doc -> Doc -> Doc
<> Doc
t Doc -> Doc -> Doc
<> Doc
ast

li, ul :: Doc -> Doc
-- | List tag wrapper
li :: Doc -> Doc
li = String -> [String] -> Doc -> Doc
wrap' String
"li" []
-- | Unordered list tag wrapper.
ul :: Doc -> Doc
ul = String -> [String] -> Doc -> Doc
wrap' String
"ul" []

-- | Helper for setting up section div
divTag :: Doc -> Doc
divTag :: Doc -> Doc
divTag Doc
l = ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
hcat Variation
Id String
"div" Doc
l [String
""] Doc
empty

-- | Helper for setting up centered div tags
centeredDiv :: Doc -> Doc
centeredDiv :: Doc -> Doc
centeredDiv = ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
vsep Variation
Align String
"div" (String -> Doc
text String
"center") [String
""]

-- | Helper for setting up centered div tags with an Id
centeredDivId :: Doc -> Doc -> Doc
centeredDivId :: Doc -> Doc -> Doc
centeredDivId Doc
l Doc
con = [Doc] -> Doc
vsep [String -> [(String, Doc)] -> Doc
wrapInside String
"div" [(String, Doc)]
atrs, Doc
con, String -> Doc
tagR String
"div"]
  where
    atrs :: [(String, Doc)]
atrs = [(Variation -> String
forall a. Show a => a -> String
show Variation
Id, Doc
l), (Variation -> String
forall a. Show a => a -> String
show Variation
Align, String -> Doc
text String
"center")]

-- | Helper for setting up links to references
reflink :: RefMap -> String -> Doc -> Doc
reflink :: RefMap -> String -> Doc -> Doc
reflink RefMap
rm String
ref Doc
txt = Doc -> Doc
forall a. CanTextWrap a => a -> a
brak Doc
txt Doc -> Doc -> Doc
<> Doc -> Doc
forall a. CanTextWrap a => a -> a
paren Doc
rp
  where
    fn :: Doc
fn = Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty String -> Doc
fp (String -> RefMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
lookup String
ref RefMap
rm)
    fp :: String -> Doc
fp String
s = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"./" String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
".md"
    rp :: Doc
rp = Doc
fn Doc -> Doc -> Doc
<> String -> Doc
text (String
"#" String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> String
ref)

-- | Helper for setting up links to references with additional information.
reflinkInfo :: RefMap -> String -> Doc -> Doc -> Doc
reflinkInfo :: RefMap -> String -> Doc -> Doc -> Doc
reflinkInfo RefMap
rm String
rf Doc
txt Doc
info = RefMap -> String -> Doc -> Doc
reflink RefMap
rm String
rf Doc
txt Doc -> Doc -> Doc
<+> Doc
info

-- | Create clickable URIs with a link and a displayed text. If displayed text
-- is the same as the link, it will return @<link>@ instead of @[text](link)@.
reflinkURI :: Doc -> Doc -> Doc
reflinkURI :: Doc -> Doc -> Doc
reflinkURI Doc
ref Doc
txt
  | Doc
ref Doc -> Doc -> Bool
forall a. Eq a => a -> a -> Bool
== Doc
txt = Doc -> Doc
forall a. CanTextWrap a => a -> a
angbrac Doc
ref
  | Bool
otherwise  = Doc -> Doc
forall a. CanTextWrap a => a -> a
brak Doc
txt Doc -> Doc -> Doc
<> Doc -> Doc
forall a. CanTextWrap a => a -> a
paren Doc
ref

-- | Helper for setting up figures
image :: Doc -> Maybe Doc -> Doc
image :: Doc -> Maybe Doc -> Doc
image Doc
f Maybe Doc
Nothing = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> Doc -> Doc -> Doc
reflinkURI (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"./assets/" String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> ShowS
takeFileName (Doc -> String
forall a. Show a => a -> String
show Doc
f)) (String -> Doc
text String
"")
image Doc
f (Just Doc
c) = String -> Doc
text String
"!" Doc -> Doc -> Doc
<> Doc -> Doc -> Doc
reflinkURI (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"./assets/" String -> ShowS
forall a. Semigroup a => a -> a -> a
P.<> ShowS
takeFileName (Doc -> String
forall a. Show a => a -> String
show Doc
f)) Doc
c Doc -> Doc -> Doc
$^$ Doc -> Doc
bold (String -> Doc
text String
"Figure: " Doc -> Doc -> Doc
<> Doc
c)

-- | Helper for setting up captions
caption :: Doc -> Doc
caption :: Doc -> Doc
caption = ([Doc] -> Doc)
-> Variation -> String -> Doc -> [String] -> Doc -> Doc
wrapGen' [Doc] -> Doc
hcat Variation
Align String
"p" (String -> Doc
text String
"center") [String
""]

-- | Helper for setting up headings with an id attribute.
-- id attribute will only work for mdBook.
heading ::  Doc -> Doc -> Doc
heading :: Doc -> Doc -> Doc
heading Doc
t Doc
l = Doc
t Doc -> Doc -> Doc
<+> Doc -> Doc
forall a. CanTextWrap a => a -> a
brace (String -> Doc
text String
"#" Doc -> Doc -> Doc
<> Doc
l)

-- | Helper for setting up heading weights in mdBook.
h :: Int -> Doc
h :: Int -> Doc
h Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1     = String -> Doc
forall a. HasCallStack => String -> a
error String
"Illegal header (header weight must be > 0)."
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7     = String -> Doc
forall a. HasCallStack => String -> a
error String
"Illegal header (header weight must be < 8)"
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4     = Int -> Doc
h' Int
1
  | Bool
otherwise = Int -> Doc
h' Int
n

-- | Helper for setting up heading weights in normal Markdown.
h' :: Int -> Doc
h' :: Int -> Doc
h' Int
n
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = String -> Doc
forall a. HasCallStack => String -> a
error String
"Illegal header (header weight must be > 0)."
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7 = String -> Doc
forall a. HasCallStack => String -> a
error String
"Illegal header (header weight must be < 8)."
  | Bool
otherwise = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'#'

-- | Helper for getting length of a Doc
docLength :: Doc -> Int
docLength :: Doc -> Int
docLength Doc
d = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Doc -> String
forall a. Show a => a -> String
show Doc
d