fixed minor bugs
This commit is contained in:
parent
eaf5d9408c
commit
b3d9999479
3 changed files with 19 additions and 15 deletions
25
src/HTML.hs
25
src/HTML.hs
|
|
@ -43,6 +43,9 @@ compileToHTML (Doc elements) = T.concat $ map elementToHTML elements
|
|||
elementsToHTML :: [Element] -> T.Text
|
||||
elementsToHTML = T.concat . map elementToHTML
|
||||
|
||||
spaceSep :: [T.Text] -> T.Text
|
||||
spaceSep = T.intercalate " "
|
||||
|
||||
elementToHTML :: Element -> T.Text
|
||||
elementToHTML (Heading header attrs) = T.concat ["<h", tshow header.level, headerAttrs header attrs, ">", serializeInlineToHTML header.text, "</h", tshow header.level, ">"]
|
||||
--
|
||||
|
|
@ -50,10 +53,10 @@ elementToHTML (Code code_block) = T.concat ["<pre class=\"sourceCode ", language
|
|||
where
|
||||
language = fromMaybe "" code_block.language
|
||||
elementToHTML (BlockQuote (Q elems)) = T.concat ["<blockquote>", elementsToHTML elems, "</blockquote>"]
|
||||
elementToHTML (List (L {list_type = Ordered {start_number, style}, items}) attrs) = T.concat ["<ol", maybe "" handleStart start_number, maybe "" handleStyle style, ">", generateLiElems items, "</ol>"]
|
||||
elementToHTML (List (L {list_type = Unordered {style}, items}) attrs) = T.concat ["<ul", maybe "" handleStyle style, ">", generateLiElems items, "</ul>"]
|
||||
elementToHTML (List (L {list_type = Ordered {start_number, style}, items}) attrs) = spaceSep ["<ol", maybe "" handleStart start_number, maybe "" handleStyle style, ">", generateLiElems items, "</ol>"]
|
||||
elementToHTML (List (L {list_type = Unordered {style}, items}) attrs) = spaceSep ["<ul", maybe "" handleStyle style, ">", generateLiElems items, "</ul>"]
|
||||
elementToHTML (HTML (HTMLTag {html_content})) = html_content
|
||||
elementToHTML (Paragraph (P snippets) attrs) = T.concat ["<p", handleAttrs attrs, ">", serializeInlineToHTML snippets, "</p>"]
|
||||
elementToHTML (Paragraph (P snippets) attrs) = spaceSep ["<p", handleAttrs attrs, ">", serializeInlineToHTML snippets, "</p>"]
|
||||
elementToHTML (Transparent snippets) = serializeInlineToHTML snippets
|
||||
elementToHTML HorizontalRule = "<hr>"
|
||||
elementToHTML (Table _ _) = error "TODO"
|
||||
|
|
@ -71,7 +74,7 @@ handleStart start = T.concat ["start=\"", T.show start, "\""]
|
|||
|
||||
handleAttrs :: Attrs -> T.Text
|
||||
handleAttrs Attrs {attrId, attrClasses, attrKV} =
|
||||
T.concat
|
||||
spaceSep
|
||||
[ maybe "" (\id -> "id=\"" <> id <> "\"") attrId,
|
||||
"class=\"" <> T.intercalate " " attrClasses <> "\"",
|
||||
T.intercalate " " $ map (\(key, val) -> key <> "=\"" <> val <> "\"") attrKV
|
||||
|
|
@ -79,7 +82,7 @@ handleAttrs Attrs {attrId, attrClasses, attrKV} =
|
|||
|
||||
headerAttrs :: Heading -> Attrs -> T.Text
|
||||
headerAttrs header Attrs {attrId, attrClasses, attrKV} =
|
||||
T.concat
|
||||
spaceSep
|
||||
-- id is overcomplicated due to header having id logic written I don't wanna bother with
|
||||
[ maybe (genHeaderId header) (\id -> "id=\"" <> id <> "\"") attrId,
|
||||
"class=\"" <> T.intercalate " " attrClasses <> "\"",
|
||||
|
|
@ -99,12 +102,12 @@ generateLiElems (element : remainder) =
|
|||
serializeInlineToHTML :: [InlineText] -> T.Text
|
||||
serializeInlineToHTML [] = ""
|
||||
serializeInlineToHTML (Text t : remaining) = escapeText t <> serializeInlineToHTML remaining
|
||||
serializeInlineToHTML ((Bold elems attrs) : remaining) = T.concat ["<b", handleAttrs attrs, ">", serializeInlineToHTML elems, "</b>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((Italic elems attrs) : remaining) = T.concat ["<i", handleAttrs attrs, ">", serializeInlineToHTML elems, "</i>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((Crossed elems attrs) : remaining) = T.concat ["<s", handleAttrs attrs, ">", serializeInlineToHTML elems, "</s>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((InlineCode code attrs) : remaining) = T.concat ["<code", handleAttrs attrs, ">", escapeText code, "</code>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Link {linkText, url, title, misc_attrs} : remaining) = T.concat ["<a href=\"", url, "\"", handleAttrs misc_attrs, maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, ">", serializeInlineToHTML linkText, "</a>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Image {altText, url, title, misc_attrs} : remaining) = T.concat ["<img src=\"", url, "\" alt=\"", escapeText altText, "\"", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, handleAttrs misc_attrs, ">", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((Bold elems attrs) : remaining) = spaceSep ["<b", handleAttrs attrs, ">", serializeInlineToHTML elems, "</b>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((Italic elems attrs) : remaining) = spaceSep ["<i", handleAttrs attrs, ">", serializeInlineToHTML elems, "</i>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((Crossed elems attrs) : remaining) = spaceSep ["<s", handleAttrs attrs, ">", serializeInlineToHTML elems, "</s>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML ((InlineCode code attrs) : remaining) = spaceSep ["<code", handleAttrs attrs, ">", escapeText code, "</code>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Link {linkText, url, title, misc_attrs} : remaining) = T.concat ["<a href=\"", url, "\" ", handleAttrs misc_attrs, maybe "" (\t -> T.concat [" title=\"", escapeText t, "\""]) title, ">", serializeInlineToHTML linkText, "</a>", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (Image {altText, url, title, misc_attrs} : remaining) = T.concat ["<img src=\"", url, "\" alt=\"", escapeText altText, "\" ", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\" "]) title, handleAttrs misc_attrs, ">", serializeInlineToHTML remaining]
|
||||
serializeInlineToHTML (HTMLInline {inline_html_content} : remaining) = inline_html_content <> serializeInlineToHTML remaining
|
||||
serializeInlineToHTML ((Superscript _ _) : remaining) = error "TODO"
|
||||
serializeInlineToHTML ((Subscript _ _) : remaining) = error "TODO"
|
||||
|
|
|
|||
|
|
@ -90,8 +90,7 @@ data InlineText
|
|||
| -- different HTML element than Underlined
|
||||
Insert [InlineText] Attrs
|
||||
| Math Math Attrs
|
||||
| -- TODO
|
||||
FootnoteReference {label :: Text, attrs :: Attrs}
|
||||
| FootnoteReference {label :: Text, attrs :: Attrs}
|
||||
| Symbol Text
|
||||
| RawInline RawInline Attrs
|
||||
| Span [InlineText] Attrs
|
||||
|
|
|
|||
|
|
@ -174,8 +174,10 @@ listBlock list_type prefix child_parser_factory nest_level = do
|
|||
optional ((notFollowedBy blockEnding) *> lineEnding)
|
||||
|
||||
child <- optional $ child_parser_factory $ nest_level + 1
|
||||
error "TODO, child list handling works different now, child needs to be combined into content"
|
||||
pure $ LI {content = [Transparent content]}
|
||||
|
||||
case child of
|
||||
Just c -> pure $ LI {content = [Transparent content, List c emptyAttrs]}
|
||||
Nothing -> pure $ LI {content = [Transparent content]}
|
||||
|
||||
unorderedListBlock :: (Logger m, Characters s) => Int -> Parser s m Element
|
||||
unorderedListBlock = listBlock Unordered {style = Nothing} unordered_prefix (\level -> unwrap <$> ((try $ unorderedListBlock level) <|> orderedListBlock level))
|
||||
|
|
|
|||
Loading…
Reference in a new issue