list item and handling children lists potentially being different from the parent

This commit is contained in:
Pagwin 2025-12-10 11:41:22 -05:00
parent dbb501b1da
commit 9330e44b58
No known key found for this signature in database
GPG key ID: 81137023740CA260
3 changed files with 9 additions and 5 deletions

View file

@ -64,7 +64,7 @@ generateLiElems (element : remainder) =
-- We assume child lists are stricly after our contents -- We assume child lists are stricly after our contents
-- if they aren't this is fucked -- if they aren't this is fucked
serializeInlineToHTML element.content, serializeInlineToHTML element.content,
T.concat $ map (elementToHTML . List) element.children, fromMaybe "" $ fmap (elementToHTML . List) element.child,
"</li>", "</li>",
generateLiElems remainder generateLiElems remainder
] ]

View file

@ -33,7 +33,7 @@ data BlockQuote = Q [InlineText] deriving (Show)
data ListItem = LI data ListItem = LI
{ content :: [InlineText], -- Flatten continuations into here { content :: [InlineText], -- Flatten continuations into here
children :: [List] child :: Maybe List
} }
deriving (Show) deriving (Show)

View file

@ -125,17 +125,21 @@ listBlock list_type prefix child_parser_factory nest_level = do
items <- some $ (try (listItem <* notFollowedBy blockEnding)) <|> (listItem <* lineEnding) items <- some $ (try (listItem <* notFollowedBy blockEnding)) <|> (listItem <* lineEnding)
pure $ List $ L {list_type, items} pure $ List $ L {list_type, items}
where where
listItem = error "listItem" listItem = do
prefix
content <- many inlineText
child <- optional $ child_parser_factory $ nest_level + 1
pure $ LI {content, child}
unorderedListBlock :: (Logger m, Characters s) => Int -> Parser s m Element unorderedListBlock :: (Logger m, Characters s) => Int -> Parser s m Element
unorderedListBlock = listBlock Unordered unordered_prefix (\level -> unwrap <$> unorderedListBlock level) unorderedListBlock = listBlock Unordered unordered_prefix (\level -> unwrap <$> ((try $ unorderedListBlock level) <|> orderedListBlock level))
where where
unordered_prefix = (choice $ map char "*-+") *> optional spaceChar unordered_prefix = (choice $ map char "*-+") *> optional spaceChar
-- not exhaustive but we know listBlock is returning a List -- not exhaustive but we know listBlock is returning a List
unwrap (List l) = l unwrap (List l) = l
orderedListBlock :: (Logger m, Characters s) => Int -> Parser s m Element orderedListBlock :: (Logger m, Characters s) => Int -> Parser s m Element
orderedListBlock = listBlock Ordered ordered_prefix (\level -> unwrap <$> orderedListBlock level) orderedListBlock = listBlock Ordered ordered_prefix (\level -> unwrap <$> ((try $ unorderedListBlock level) <|> orderedListBlock level))
where where
ordered_prefix = error "ordered_prefix" ordered_prefix = error "ordered_prefix"
-- not exhaustive but we know listBlock is returning a List -- not exhaustive but we know listBlock is returning a List