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 = 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,10 +102,10 @@ 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 ((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

View file

@ -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

View file

@ -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))