fixed minor bugs

This commit is contained in:
Pagwin 2026-04-06 16:29:01 -04:00
parent eaf5d9408c
commit b3d9999479
No known key found for this signature in database
GPG key ID: 81137023740CA260
3 changed files with 19 additions and 15 deletions

View file

@ -43,6 +43,9 @@ compileToHTML (Doc elements) = T.concat $ map elementToHTML elements
elementsToHTML :: [Element] -> T.Text elementsToHTML :: [Element] -> T.Text
elementsToHTML = T.concat . map elementToHTML elementsToHTML = T.concat . map elementToHTML
spaceSep :: [T.Text] -> T.Text
spaceSep = T.intercalate " "
elementToHTML :: Element -> T.Text elementToHTML :: Element -> T.Text
elementToHTML (Heading header attrs) = T.concat ["<h", tshow header.level, headerAttrs header attrs, ">", serializeInlineToHTML header.text, "</h", tshow header.level, ">"] 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 where
language = fromMaybe "" code_block.language language = fromMaybe "" code_block.language
elementToHTML (BlockQuote (Q elems)) = T.concat ["<blockquote>", elementsToHTML elems, "</blockquote>"] 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 = 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) = T.concat ["<ul", maybe "" handleStyle style, ">", generateLiElems items, "</ul>"] 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 (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 (Transparent snippets) = serializeInlineToHTML snippets
elementToHTML HorizontalRule = "<hr>" elementToHTML HorizontalRule = "<hr>"
elementToHTML (Table _ _) = error "TODO" elementToHTML (Table _ _) = error "TODO"
@ -71,7 +74,7 @@ handleStart start = T.concat ["start=\"", T.show start, "\""]
handleAttrs :: Attrs -> T.Text handleAttrs :: Attrs -> T.Text
handleAttrs Attrs {attrId, attrClasses, attrKV} = handleAttrs Attrs {attrId, attrClasses, attrKV} =
T.concat spaceSep
[ maybe "" (\id -> "id=\"" <> id <> "\"") attrId, [ maybe "" (\id -> "id=\"" <> id <> "\"") attrId,
"class=\"" <> T.intercalate " " attrClasses <> "\"", "class=\"" <> T.intercalate " " attrClasses <> "\"",
T.intercalate " " $ map (\(key, val) -> key <> "=\"" <> val <> "\"") attrKV T.intercalate " " $ map (\(key, val) -> key <> "=\"" <> val <> "\"") attrKV
@ -79,7 +82,7 @@ handleAttrs Attrs {attrId, attrClasses, attrKV} =
headerAttrs :: Heading -> Attrs -> T.Text headerAttrs :: Heading -> Attrs -> T.Text
headerAttrs header Attrs {attrId, attrClasses, attrKV} = 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 -- id is overcomplicated due to header having id logic written I don't wanna bother with
[ maybe (genHeaderId header) (\id -> "id=\"" <> id <> "\"") attrId, [ maybe (genHeaderId header) (\id -> "id=\"" <> id <> "\"") attrId,
"class=\"" <> T.intercalate " " attrClasses <> "\"", "class=\"" <> T.intercalate " " attrClasses <> "\"",
@ -99,10 +102,10 @@ generateLiElems (element : remainder) =
serializeInlineToHTML :: [InlineText] -> T.Text serializeInlineToHTML :: [InlineText] -> T.Text
serializeInlineToHTML [] = "" serializeInlineToHTML [] = ""
serializeInlineToHTML (Text t : remaining) = escapeText t <> serializeInlineToHTML remaining serializeInlineToHTML (Text t : remaining) = escapeText t <> serializeInlineToHTML remaining
serializeInlineToHTML ((Bold elems attrs) : remaining) = T.concat ["<b", handleAttrs attrs, ">", serializeInlineToHTML elems, "</b>", serializeInlineToHTML remaining] serializeInlineToHTML ((Bold elems attrs) : remaining) = spaceSep ["<b", handleAttrs attrs, ">", serializeInlineToHTML elems, "</b>", serializeInlineToHTML remaining]
serializeInlineToHTML ((Italic elems attrs) : remaining) = T.concat ["<i", handleAttrs attrs, ">", serializeInlineToHTML elems, "</i>", serializeInlineToHTML remaining] serializeInlineToHTML ((Italic elems attrs) : remaining) = spaceSep ["<i", handleAttrs attrs, ">", serializeInlineToHTML elems, "</i>", serializeInlineToHTML remaining]
serializeInlineToHTML ((Crossed elems attrs) : remaining) = T.concat ["<s", handleAttrs attrs, ">", serializeInlineToHTML elems, "</s>", serializeInlineToHTML remaining] serializeInlineToHTML ((Crossed elems attrs) : remaining) = spaceSep ["<s", handleAttrs attrs, ">", serializeInlineToHTML elems, "</s>", serializeInlineToHTML remaining]
serializeInlineToHTML ((InlineCode code attrs) : remaining) = T.concat ["<code", handleAttrs attrs, ">", escapeText code, "</code>", 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 (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 (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 (HTMLInline {inline_html_content} : remaining) = inline_html_content <> serializeInlineToHTML remaining

View file

@ -90,8 +90,7 @@ data InlineText
| -- different HTML element than Underlined | -- different HTML element than Underlined
Insert [InlineText] Attrs Insert [InlineText] Attrs
| Math Math Attrs | Math Math Attrs
| -- TODO | FootnoteReference {label :: Text, attrs :: Attrs}
FootnoteReference {label :: Text, attrs :: Attrs}
| Symbol Text | Symbol Text
| RawInline RawInline Attrs | RawInline RawInline Attrs
| Span [InlineText] Attrs | Span [InlineText] Attrs

View file

@ -174,8 +174,10 @@ listBlock list_type prefix child_parser_factory nest_level = do
optional ((notFollowedBy blockEnding) *> lineEnding) optional ((notFollowedBy blockEnding) *> lineEnding)
child <- optional $ child_parser_factory $ nest_level + 1 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 :: (Logger m, Characters s) => Int -> Parser s m Element
unorderedListBlock = listBlock Unordered {style = Nothing} unordered_prefix (\level -> unwrap <$> ((try $ unorderedListBlock level) <|> orderedListBlock level)) unorderedListBlock = listBlock Unordered {style = Nothing} unordered_prefix (\level -> unwrap <$> ((try $ unorderedListBlock level) <|> orderedListBlock level))