Pagwin/psb
1
0
Fork 0
Code Issues 4 Pull requests Projects Releases Packages Wiki Activity

fixed with mempty and simplified working with attrs a bit

Browse source
This commit is contained in:
Pagwin 2026-04-06 22:37:14 -04:00
parent 5073fdb04b
commit 4bf7614eda
No known key found for this signature in database
GPG key ID: 81137023740CA260
2 changed files with 11 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Djot.hs
View file

@ -77,7 +77,7 @@ paragraph :: (Logger m, Characters s) => Attrs -> Parser s m Element
paragraph = error "todo" paragraph = error "todo"
blockAttribute :: (Logger m, Characters s) => Attrs -> Parser s m Element blockAttribute :: (Logger m, Characters s) => Attrs -> Parser s m Element
blockAttribute attrs = blockAttribute' <&> (attrs <>) >>= blockElement <|> error "eof handle" blockAttribute attrs = (blockAttribute' <&> (attrs <>) >>= blockElement) <|> error "eof handle"
blockAttribute' :: (Logger m, Characters s) => Parser s m Attrs blockAttribute' :: (Logger m, Characters s) => Parser s m Attrs
blockAttribute' = error "todo" blockAttribute' = error "todo"

20
src/Markdown.hs
View file

@ -64,22 +64,22 @@ inlineText' disallow = choice [try $ strikethrough disallow, try $ bold disallow
strikethrough disallow = do strikethrough disallow = do
content <- between' disallow (string "~~") (void $ string "~~") (inlineText' (disallow <|> (void $ string "~~"))) content <- between' disallow (string "~~") (void $ string "~~") (inlineText' (disallow <|> (void $ string "~~")))
pure $ Crossed content emptyAttrs pure $ Crossed content mempty
bold disallow = do bold disallow = do
content <- between' disallow (string "**") (disallow <|> (void $ string "**")) (inlineText' (disallow <|> (void $ string "**"))) content <- between' disallow (string "**") (disallow <|> (void $ string "**")) (inlineText' (disallow <|> (void $ string "**")))
pure $ Bold content emptyAttrs pure $ Bold content mempty
italic :: (HasCallStack) => Parser s m () -> Parser s m InlineText italic :: (HasCallStack) => Parser s m () -> Parser s m InlineText
italic disallow = do italic disallow = do
content <- between' disallow (char '*') ((void $ char '*') <|> disallow) (inlineText' (disallow <|> (void $ char '*'))) content <- between' disallow (char '*') ((void $ char '*') <|> disallow) (inlineText' (disallow <|> (void $ char '*')))
pure $ Italic content emptyAttrs pure $ Italic content mempty
underlined disallow = Underlined <$> (between' disallow (string "__") ((void $ string "__") <|> disallow) (inlineText' (disallow <|> (void $ string "__")))) underlined disallow = Underlined <$> (between' disallow (string "__") ((void $ string "__") <|> disallow) (inlineText' (disallow <|> (void $ string "__"))))
code = do code = do
contents <- T.pack <$> between' disallow (char '`') (char '`') (notFollowedBy lineEnding *> anySingle) contents <- T.pack <$> between' disallow (char '`') (char '`') (notFollowedBy lineEnding *> anySingle)
pure $ InlineCode contents emptyAttrs pure $ InlineCode contents mempty
link :: (HasCallStack) => Parser s m () -> Parser s m InlineText link :: (HasCallStack) => Parser s m () -> Parser s m InlineText
link disallow = do link disallow = do
linkText <- between' disallow (char '[') ((void $ char ']') <|> disallow) (inlineText' (disallow <|> (void $ char ']'))) linkText <- between' disallow (char '[') ((void $ char ']') <|> disallow) (inlineText' (disallow <|> (void $ char ']')))
@ -93,7 +93,7 @@ inlineText' disallow = choice [try $ strikethrough disallow, try $ bold disallow
Nothing -> pure Nothing Nothing -> pure Nothing
char ')' char ')'
pure (url, title) pure (url, title)
pure Link {linkText, url, title, misc_attrs = emptyAttrs} pure Link {linkText, url, title, misc_attrs = mempty}
image disallow = do image disallow = do
logDebug "image:before excl" logDebug "image:before excl"
@ -107,7 +107,7 @@ inlineText' disallow = choice [try $ strikethrough disallow, try $ bold disallow
Link {linkText = [Text altText], url, title} -> pure (altText, url, title) Link {linkText = [Text altText], url, title} -> pure (altText, url, title)
Link {linkText = [], url, title} -> pure ("", url, title) Link {linkText = [], url, title} -> pure ("", url, title)
_ -> fail "Image alt text must be normal text, cannot be stylized in any way" _ -> fail "Image alt text must be normal text, cannot be stylized in any way"
pure Image {altText, url, title, misc_attrs = emptyAttrs} pure Image {altText, url, title, misc_attrs = mempty}
inline_html = inline_html =
HTMLInline <$> do HTMLInline <$> do
@ -130,7 +130,7 @@ headingBlock = do
heading_level <- length <$> (some $ char '#') heading_level <- length <$> (some $ char '#')
optional spaceChar optional spaceChar
text <- many ((notFollowedBy blockEnding) *> inlineText) text <- many ((notFollowedBy blockEnding) *> inlineText)
pure $ Heading (H {level = heading_level, text}) emptyAttrs pure $ Heading (H {level = heading_level, text}) mempty
fencedCodeBlock :: (Logger m, Characters s) => Parser s m Element fencedCodeBlock :: (Logger m, Characters s) => Parser s m Element
fencedCodeBlock = between (string "```") (string "```") $ do fencedCodeBlock = between (string "```") (string "```") $ do
@ -161,7 +161,7 @@ blockquoteBlock = do
listBlock :: (Logger m, Characters s) => ListType -> Parser s m prefix -> (Int -> Parser s m List) -> Int -> Parser s m Element listBlock :: (Logger m, Characters s) => ListType -> Parser s m prefix -> (Int -> Parser s m List) -> Int -> Parser s m Element
listBlock list_type prefix child_parser_factory nest_level = do listBlock list_type prefix child_parser_factory nest_level = do
items <- some $ listItem items <- some $ listItem
pure $ List (L {list_type, items}) emptyAttrs pure $ List (L {list_type, items}) mempty
where where
listItem = do listItem = do
count nest_level ((try $ void $ char '\t') <|> (void $ (count 4 $ char ' '))) count nest_level ((try $ void $ char '\t') <|> (void $ (count 4 $ char ' ')))
@ -173,7 +173,7 @@ listBlock list_type prefix child_parser_factory nest_level = do
child <- optional $ child_parser_factory $ nest_level + 1 child <- optional $ child_parser_factory $ nest_level + 1
case child of case child of
Just c -> pure $ LI {content = [Transparent content, List c emptyAttrs]} Just c -> pure $ LI {content = [Transparent content, List c mempty]}
Nothing -> pure $ LI {content = [Transparent content]} 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
@ -227,4 +227,4 @@ htmlBlock = do
paragraphBlock :: (Logger m, Characters s) => Parser s m Element paragraphBlock :: (Logger m, Characters s) => Parser s m Element
paragraphBlock = do paragraphBlock = do
content <- P <$> many ((notFollowedBy blockEnding) *> inlineText) content <- P <$> many ((notFollowedBy blockEnding) *> inlineText)
pure $ Paragraph content emptyAttrs pure $ Paragraph content mempty