
  0 | module Text.Markdown.Format.Html
  1 | 
  2 | import Data.String.Extra
  3 | import Text.Markdown.Data
  4 | 
  5 | %default total
  6 | 
  7 | private
  8 | showProps : List (String, String) -> String
  9 | showProps []        = ""
 10 | showProps (p :: ps) = " \{fst p}=\"\{snd p}\"\{showProps ps}"
 11 | 
 12 | private
 13 | htmlElementProps : String -> List (String, String) -> String -> String
 14 | htmlElementProps el props contents =
 15 |   "<\{el}\{showProps props}>\{contents}</\{el}>"
 16 | 
 17 | private
 18 | htmlElement : String -> String -> String
 19 | htmlElement el contents = htmlElementProps el [] contents
 20 | 
 21 | ||| A HTML void element with no content.
 22 | |||
 23 | ||| Typical void elements are **br** and **hr**.
 24 | |||
 25 | ||| Note: the HTML5 syntax is used. Therefore, such elements are rendered as
 26 | ||| `<br>`, `<hr>`, etc. without self-closing slash.
 27 | private
 28 | htmlVoidElement : String -> String
 29 | htmlVoidElement el = "<\{el}>"
 30 | 
 31 | ||| Escape a `String` for use as a HTML attribute's value.
 32 | |||
 33 | ||| The following characters are escaped: '"', '\'', '&' '>' and '<'.
 34 | export
 35 | escapeText : String -> String
 36 | escapeText = pack . escapeHelper . unpack
 37 |   where
 38 |     escapeHelper : List Char -> List Char
 39 |     escapeHelper []           = []
 40 |     escapeHelper ('"' :: cs)  = unpack "&quot;" ++ escapeHelper cs
 41 |     escapeHelper ('\'' :: cs) = unpack "&#39;" ++ escapeHelper cs
 42 |     escapeHelper ('&' :: cs)  = unpack "&amp;" ++ escapeHelper cs
 43 |     escapeHelper ('<' :: cs)  = unpack "&lt;" ++ escapeHelper cs
 44 |     escapeHelper ('>' :: cs)  = unpack "&gt;" ++ escapeHelper cs
 45 |     escapeHelper (c :: cs)    = (c :: escapeHelper cs)
 46 | 
 47 | mutual
 48 |   private
 49 |   covering
 50 |   inlineToHtml : Inline -> String
 51 |   inlineToHtml (Text text)        = text
 52 |   inlineToHtml (Pre text)         = htmlElement "code" (escapeText text)
 53 |   inlineToHtml (Italics inlines)  = htmlElement "em" (inlinesToHtml inlines)
 54 |   inlineToHtml (Bold inlines)     = htmlElement "strong" (inlinesToHtml inlines)
 55 |   inlineToHtml (Image alt src)    = htmlElementProps
 56 |                                       "img"
 57 |                                       [("src", src), ("alt", alt)]
 58 |                                       ""
 59 |   inlineToHtml (Link desc href)   = htmlElementProps
 60 |                                       "a"
 61 |                                       [("href", href)]
 62 |                                       (inlinesToHtml desc)
 63 |   inlineToHtml (Html tag inlines) = htmlElement tag (inlinesToHtml inlines)
 64 | 
 65 |   private
 66 |   covering
 67 |   inlinesToHtml : List Inline -> String
 68 |   inlinesToHtml inlines = join "" (map inlineToHtml inlines)
 69 | 
 70 | 
 71 | private
 72 | covering
 73 | listItemsToHtml : List ListItem -> String
 74 | listItemsToHtml []        = ""
 75 | listItemsToHtml (x :: xs) =
 76 |   htmlElement "li" (inlinesToHtml x) <+> listItemsToHtml xs
 77 | 
 78 | private
 79 | covering
 80 | blockToHtml : Block -> String
 81 | blockToHtml (Header level inlines) = htmlElement
 82 |                                        ("h" ++ (show level))
 83 |                                        (inlinesToHtml inlines)
 84 | blockToHtml (UList items)          = htmlElement "ul" (listItemsToHtml items)
 85 | blockToHtml (CodeBlock text _)     = htmlElement
 86 |                                        "pre"
 87 |                                        (htmlElement "code" $ escapeText text)
 88 | blockToHtml HorizontalRules        = htmlVoidElement "hr"
 89 | blockToHtml (Paragraph inlines)    = htmlElement "p" (inlinesToHtml inlines)
 90 | 
 91 | ||| Convert a Markdown value into Html
 92 | export
 93 | covering
 94 | toHtml : Markdown -> String
 95 | toHtml (Doc els) = join "\n" (map blockToHtml els)
 96 |