Implement task lists (#5139)

Closes #3051

4 files changed, 54 insertions, 15 deletions

diff --git a/src/Text/Pandoc/Writers/CommonMark.hs b/src/Text/Pandoc/Writers/CommonMark.hs
index 6299b0263..e28fa71a9 100644
--- a/src/Text/Pandoc/Writers/CommonMark.hs
+++ b/src/Text/Pandoc/Writers/CommonMark.hs
@@ -46,7 +46,8 @@ import Network.HTTP (urlEncode)
 import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
-import Text.Pandoc.Shared (isTightList, linesToPara, substitute, capitalize)
+import Text.Pandoc.Shared (isTightList, taskListItemToAscii, linesToPara,
+                           substitute, capitalize)
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Walk (query, walk, walkM)
 import Text.Pandoc.Writers.HTML (writeHtml5String, tagWithAttributes)
@@ -115,24 +116,28 @@ blockToNodes opts (Para xs) ns =
 blockToNodes opts (LineBlock lns) ns = blockToNodes opts (linesToPara lns) ns
 blockToNodes _ (CodeBlock (_,classes,_) xs) ns = return
   (node (CODE_BLOCK (T.pack (unwords classes)) (T.pack xs)) [] : ns)
-blockToNodes opts (RawBlock fmt xs) ns
-  | fmt == Format "html" && isEnabled Ext_raw_html opts
+blockToNodes opts (RawBlock (Format f) xs) ns
+  | f == "html" && isEnabled Ext_raw_html opts
               = return (node (HTML_BLOCK (T.pack xs)) [] : ns)
-  | (fmt == Format "latex" || fmt == Format "tex") && isEnabled Ext_raw_tex opts
+  | (f == "latex" || f == "tex") && isEnabled Ext_raw_tex opts
+              = return (node (CUSTOM_BLOCK (T.pack xs) T.empty) [] : ns)
+  | f == "markdown"
               = return (node (CUSTOM_BLOCK (T.pack xs) T.empty) [] : ns)
   | otherwise = return ns
 blockToNodes opts (BlockQuote bs) ns = do
   nodes <- blocksToNodes opts bs
   return (node BLOCK_QUOTE nodes : ns)
 blockToNodes opts (BulletList items) ns = do
-  nodes <- mapM (blocksToNodes opts) items
+  let exts = writerExtensions opts
+  nodes <- mapM (blocksToNodes opts . taskListItemToAscii exts) items
   return (node (LIST ListAttributes{
                    listType = BULLET_LIST,
                    listDelim = PERIOD_DELIM,
                    listTight = isTightList items,
                    listStart = 1 }) (map (node ITEM) nodes) : ns)
 blockToNodes opts (OrderedList (start, _sty, delim) items) ns = do
-  nodes <- mapM (blocksToNodes opts) items
+  let exts = writerExtensions opts
+  nodes <- mapM (blocksToNodes opts . taskListItemToAscii exts) items
   return (node (LIST ListAttributes{
                    listType = ORDERED_LIST,
                    listDelim = case delim of
@@ -292,10 +297,12 @@ inlineToNodes opts (Image alt ils (url,'f':'i':'g':':':tit)) =
   inlineToNodes opts (Image alt ils (url,tit))
 inlineToNodes opts (Image _ ils (url,tit)) =
   (node (IMAGE (T.pack url) (T.pack tit)) (inlinesToNodes opts ils) :)
-inlineToNodes opts (RawInline fmt xs)
-  | fmt == Format "html" && isEnabled Ext_raw_html opts
+inlineToNodes opts (RawInline (Format f) xs)
+  | f == "html" && isEnabled Ext_raw_html opts
               = (node (HTML_INLINE (T.pack xs)) [] :)
-  | (fmt == Format "latex" || fmt == Format "tex") && isEnabled Ext_raw_tex opts
+  | (f == "latex" || f == "tex") && isEnabled Ext_raw_tex opts
+              = (node (CUSTOM_INLINE (T.pack xs) T.empty) [] :)
+  | f == "markdown"
               = (node (CUSTOM_INLINE (T.pack xs) T.empty) [] :)
   | otherwise = id
 inlineToNodes opts (Quoted qt ils) =
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 8cdadca5b..98b86a7c9 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -365,6 +365,24 @@ defList :: PandocMonad m
         => WriterOptions -> [Html] -> StateT WriterState m Html
 defList opts items = toList H.dl opts (items ++ [nl opts])
 
+listItemToHtml :: PandocMonad m
+               => WriterOptions -> [Block] -> StateT WriterState m Html
+listItemToHtml opts bls
+  | Plain (Str "☐":Space:is) : bs <- bls = taskListItem False id  is bs
+  | Plain (Str "☒":Space:is) : bs <- bls = taskListItem True  id  is bs
+  | Para  (Str "☐":Space:is) : bs <- bls = taskListItem False H.p is bs
+  | Para  (Str "☒":Space:is) : bs <- bls = taskListItem True  H.p is bs
+  | otherwise = blockListToHtml opts bls
+  where
+    taskListItem checked constr is bs = do
+      let checkbox  = if checked
+                      then checkbox' ! A.checked ""
+                      else checkbox'
+          checkbox' = H.input ! A.type_ "checkbox" ! A.disabled "" >> nl opts
+      isContents <- inlineListToHtml opts is
+      bsContents <- blockListToHtml opts bs
+      return $ constr (checkbox >> isContents) >> bsContents
+
 -- | Construct table of contents from list of elements.
 tableOfContents :: PandocMonad m => WriterOptions -> [Element]
                 -> StateT WriterState m (Maybe Html)
@@ -824,10 +842,10 @@ blockToHtml opts (Header level attr@(_,classes,_) lst) = do
               6 -> H.h6 contents'
               _ -> H.p contents'
 blockToHtml opts (BulletList lst) = do
-  contents <- mapM (blockListToHtml opts) lst
+  contents <- mapM (listItemToHtml opts) lst
   unordList opts contents
 blockToHtml opts (OrderedList (startnum, numstyle, _) lst) = do
-  contents <- mapM (blockListToHtml opts) lst
+  contents <- mapM (listItemToHtml opts) lst
   html5 <- gets stHtml5
   let numstyle' = case numstyle of
                        Example -> "decimal"
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index f9bee886e..7441152a6 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -924,8 +924,20 @@ listItemToLaTeX lst
   -- this will keep the typesetter from throwing an error.
   | (Header{} :_) <- lst =
     blockListToLaTeX lst >>= return . (text "\\item ~" $$) . nest 2
-  | otherwise = blockListToLaTeX lst >>= return .  (text "\\item" $$) .
-                      nest 2
+  | Plain (Str "☐":Space:is) : bs <- lst = taskListItem False is bs
+  | Plain (Str "☒":Space:is) : bs <- lst = taskListItem True  is bs
+  | Para  (Str "☐":Space:is) : bs <- lst = taskListItem False is bs
+  | Para  (Str "☒":Space:is) : bs <- lst = taskListItem True  is bs
+  | otherwise = blockListToLaTeX lst >>= return . (text "\\item" $$) . nest 2
+  where
+    taskListItem checked is bs = do
+      let checkbox  = if checked
+                      then "$\\boxtimes$"
+                      else "$\\square$"
+      isContents <- inlineListToLaTeX is
+      bsContents <- blockListToLaTeX bs
+      return $ "\\item" <> brackets checkbox
+        $$ nest 2 (isContents $+$ bsContents)
 
 defListItemToLaTeX :: PandocMonad m => ([Inline], [[Block]]) -> LW m Doc
 defListItemToLaTeX (term, defs) = do
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index c0c6e8ebf..7babbe982 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -765,7 +765,8 @@ itemEndsWithTightList bs =
 -- | Convert bullet list item (list of blocks) to markdown.
 bulletListItemToMarkdown :: PandocMonad m => WriterOptions -> [Block] -> MD m Doc
 bulletListItemToMarkdown opts bs = do
-  contents <- blockListToMarkdown opts bs
+  let exts = writerExtensions opts
+  contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
   let sps = replicate (writerTabStop opts - 2) ' '
   let start = text ('-' : ' ' : sps)
   -- remove trailing blank line if item ends with a tight list
@@ -781,7 +782,8 @@ orderedListItemToMarkdown :: PandocMonad m
                           -> [Block]       -- ^ list item (list of blocks)
                           -> MD m Doc
 orderedListItemToMarkdown opts marker bs = do
-  contents <- blockListToMarkdown opts bs
+  let exts = writerExtensions opts
+  contents <- blockListToMarkdown opts $ taskListItemToAscii exts bs
   let sps = case length marker - writerTabStop opts of
                    n | n > 0 -> text $ replicate n ' '
                    _ -> text " "