HTML reader can parse checkboxes

Fixed an issue specified by bug found at jgm#9047
sspeaks · Sep 7, 2023 · 39f7fcc · 39f7fcc
1 parent d051aa9
commit 39f7fcc
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 1 deletion.
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
@@ -342,7 +342,24 @@ pListItem = do
                                 [Span (ident, [], []) ils] : xs)
                            _ -> B.divWith (ident, [], []) bs
   maybe id addId (lookup "id" attr) <$>
-    pInTags "li" block
+    pInTags "li" (pCheckBox <|> block)
+  where 
+    pCheckBox :: PandocMonad m => TagParser m Blocks
+    pCheckBox = try $ do
+      trace "pCheckBox!!!"
+      pInTag TagsRequired "label" pInput
+      where
+        pInput :: PandocMonad m => TagParser m Blocks
+        pInput = do
+              TagOpen _ attr' <- lookAhead $ pSatisfy $ matchTagOpen "input" [("type","checkbox")]
+              let attr = toStringAttr attr'
+              let isChecked = isJust $ lookup "checked" attr
+              _ <- pSelfClosing (== "input") (const True)
+              bs <- inline
+              return $ if isChecked
+                        then B.Many . Seq.singleton $ B.Plain ([B.Str "\9746", B.Space ] <> B.toList bs)
+                        else B.Many . Seq.singleton $ B.Plain ([B.Str "\9744", B.Space ] <> B.toList bs)
+
 
 -- | Parses a list item just like 'pListItem', but allows sublists outside of
 -- @li@ tags to be treated as items.

diff --git a/test/command/tasklist.md b/test/command/tasklist.md
@@ -103,3 +103,16 @@ round trip:
 -   [ ] foo
 -   [x] bar
 ```
+
+```
+% pandoc -f html -t html
+<ul class="task-list">
+<li><label><input type="checkbox" />foo</label></li>
+<li><label><input type="checkbox" checked="" />bar</label></li>
+</ul>
+^D
+<ul class="task-list">
+<li><label><input type="checkbox" />foo</label></li>
+<li><label><input type="checkbox" checked="" />bar</label></li>
+</ul>
+```