Support checklists in asciidoctor writer (#7832)

The checklist syntax (similar to `task_list` in markdown) seems to be
an asciidoctor-only addition.

Co-authored-by: ricnorr <ricnorr@yandex-tream.ru>

2 files changed, 38 insertions, 7 deletions

diff --git a/src/Text/Pandoc/Writers/AsciiDoc.hs b/src/Text/Pandoc/Writers/AsciiDoc.hs
index 378d512b6..92442da3c 100644
--- a/src/Text/Pandoc/Writers/AsciiDoc.hs
+++ b/src/Text/Pandoc/Writers/AsciiDoc.hs
@@ -248,13 +248,13 @@ blockToAsciiDoc opts block@(Table _ blkCapt specs thead tbody tfoot) = do
              $ zipWith colspec aligns widths')
          <> text ","
          <> headerspec <> text "]"
-         
+
   -- construct cells and recurse in case of nested tables
   parentTableLevel <- gets tableNestingLevel
   let currentNestingLevel = parentTableLevel + 1
-  
+
   modify $ \st -> st{ tableNestingLevel = currentNestingLevel }
-  
+
   let separator = text (if parentTableLevel == 0
                           then "|"  -- top level separator
                           else "!") -- nested separator
@@ -283,7 +283,7 @@ blockToAsciiDoc opts block@(Table _ blkCapt specs thead tbody tfoot) = do
   let maxwidth = maximum $ fmap offset (head' :| rows')
   let body = if maxwidth > colwidth then vsep rows' else vcat rows'
   let border = separator <> text "==="
-  return $ 
+  return $
     caption'' $$ tablespec $$ border $$ head'' $$ body $$ border $$ blankline
 blockToAsciiDoc opts (BulletList items) = do
   inlist <- gets inList
@@ -342,12 +342,26 @@ bulletListItemToAsciiDoc :: PandocMonad m
 bulletListItemToAsciiDoc opts blocks = do
   lev <- gets bulletListLevel
   modify $ \s -> s{ bulletListLevel = lev + 1 }
-  contents <- foldM (addBlock opts) empty blocks
+  isAsciidoctor <- gets asciidoctorVariant
+  let blocksWithTasks = if isAsciidoctor
+                          then (taskListItemToAsciiDoc blocks)
+                          else blocks
+  contents <- foldM (addBlock opts) empty blocksWithTasks
   modify $ \s -> s{ bulletListLevel = lev }
   let marker = text (replicate (lev + 1) '*')
-  return $ marker <> text " " <> listBegin blocks <>
+  return $ marker <> text " " <> listBegin blocksWithTasks <>
     contents <> cr
 
+-- | Convert a list item containing text starting with @U+2610 BALLOT BOX@
+-- or @U+2612 BALLOT BOX WITH X@ to org checkbox syntax (e.g. @[X]@).
+taskListItemToAsciiDoc :: [Block] -> [Block]
+taskListItemToAsciiDoc = handleTaskListItem toOrg listExt
+  where
+    toOrg (Str "☐" : Space : is) = Str "[ ]" : Space : is
+    toOrg (Str "☒" : Space : is) = Str "[X]" : Space : is
+    toOrg is = is
+    listExt = extensionsFromList [Ext_task_lists]
+
 addBlock :: PandocMonad m
          => WriterOptions -> Doc Text -> Block -> ADW m (Doc Text)
 addBlock opts d b = do
diff --git a/test/Tests/Writers/AsciiDoc.hs b/test/Tests/Writers/AsciiDoc.hs
index 7b2dd11e8..1d1e4e068 100644
--- a/test/Tests/Writers/AsciiDoc.hs
+++ b/test/Tests/Writers/AsciiDoc.hs
@@ -9,7 +9,10 @@ import Text.Pandoc.Arbitrary ()
 import Text.Pandoc.Builder
 
 asciidoc :: (ToPandoc a) => a -> String
-asciidoc = unpack . purely (writeAsciiDoc def{ writerWrapText = WrapNone }) . toPandoc
+asciidoc = unpack . purely (writeAsciiDoc def) . toPandoc
+
+asciidoctor :: (ToPandoc a) => a -> String
+asciidoctor = unpack . purely (writeAsciiDoctor def) . toPandoc
 
 testAsciidoc :: (ToString a, ToPandoc a)
              => String
@@ -17,6 +20,12 @@ testAsciidoc :: (ToString a, ToPandoc a)
              -> TestTree
 testAsciidoc = test asciidoc
 
+testAsciidoctor :: (ToString a, ToPandoc a)
+             => String
+             -> (a, String)
+             -> TestTree
+testAsciidoctor = test asciidoctor
+
 tests :: [TestTree]
 tests = [ testGroup "emphasis"
           [ testAsciidoc "emph word before" $
@@ -76,4 +85,12 @@ tests = [ testGroup "emphasis"
                                            , "|==="
                                            ]
           ]
+        , testGroup "lists"
+          [ testAsciidoctor "bullet task list" $
+               bulletList [plain "☐ a", plain "☒ b"] =?> unlines
+                                           [ "* [ ] a"
+                                           , "* [X] b"
+                                           ]
+          ]
         ]
+