Docx writer: better formatting for task lists.

Task lists are now properly formatted, with no bullet.

In addition, we have removed an expensive generic traverse to
remove Space elements, and replaced it with code in
`inlinesToOpenXML`.  This should give better performance; it
also reduces XML size in the metadata, which wasn't previously
affected by the de-Spacing.

TODO: parse this in the reader so that we can have task lists round-trip.

Closes #5198.

src/Text/Pandoc/Writers/Docx.hs

@@ -709,6 +709,7 @@ mkNum marker numid =
    : case marker of
        NoMarker     -> []
        BulletMarker -> []
+       CheckboxMarker _ -> []
        NumberMarker _ _ start ->
           map (\lvl -> mknode "w:lvlOverride" [("w:ilvl",tshow (lvl :: Int))]
               $ mknode "w:startOverride" [("w:val",tshow start)] ())
@@ -725,8 +726,9 @@ mkAbstractNum marker =
 mkLvl :: ListMarker -> Int -> Element
 mkLvl marker lvl =
   mknode "w:lvl" [("w:ilvl",tshow lvl)] $
-    [ mknode "w:start" [("w:val",start)] ()
-      | marker /= NoMarker && marker /= BulletMarker ] ++
+    (case marker of
+        NumberMarker{} -> [mknode "w:start" [("w:val",start)] ()]
+        _ -> []) ++
     [ mknode "w:numFmt" [("w:val",fmt)] ()
     , mknode "w:lvlText" [("w:val", lvltxt)] ()
     , mknode "w:lvlJc" [("w:val","left")] ()
@@ -745,6 +747,8 @@ mkLvl marker lvl =
             case marker of
                  NoMarker             -> ("bullet"," ", Nothing, "1")
                  BulletMarker         -> bulletFor lvl
+                 CheckboxMarker False -> ("bullet","\9744", Nothing, "1")
+                 CheckboxMarker True  -> ("bullet","\9746", Nothing, "1")
                  NumberMarker st de n -> (styleFor st lvl
                                          ,patternFor de ("%" <> tshow (lvl + 1))
                                          ,Nothing

src/Text/Pandoc/Writers/Docx/OpenXML.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE PatternGuards       #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections       #-}
 {-# LANGUAGE ViewPatterns        #-}
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE LambdaCase          #-}
@@ -45,7 +46,6 @@ import qualified Text.Pandoc.Translations as Term
 import qualified Text.Pandoc.Class.PandocMonad as P
 import Text.Pandoc.UTF8 (fromTextLazy)
 import Text.Pandoc.Definition
-import Text.Pandoc.Generic
 import Text.Pandoc.Highlighting (highlight)
 import Text.Pandoc.Templates (compileDefaultTemplate, renderTemplate)
 import Text.Pandoc.ImageSize
@@ -200,11 +200,7 @@ writeOpenXML opts (Pandoc meta blocks) = do
              (fmap (hcat . map (literal . showContent)) . inlinesToOpenXML opts)
              (docAuthors meta)
 
-  let convertSpace (Str x : Space : Str y : xs) = Str (x <> " " <> y) : xs
-      convertSpace (Str x : Str y : xs)         = Str (x <> y) : xs
-      convertSpace xs                           = xs
-  let blocks' = bottomUp convertSpace blocks
-  doc' <- setFirstPara >> blocksToOpenXML opts blocks'
+  doc' <- setFirstPara >> blocksToOpenXML opts blocks
   let body = vcat $ map (literal . showContent) doc'
   notes' <- gets (reverse . stFootnotes)
   comments <- gets (reverse . stComments)
@@ -393,17 +389,38 @@ blockToOpenXML' opts (Table attr caption colspecs thead tbodies tfoot) = do
   let (tableId, _, _) = attr
   wrapBookmark tableId content
 blockToOpenXML' opts el
-  | BulletList lst <- el = addOpenXMLList BulletMarker lst
+  | BulletList lst <- el
+  = if isTaskList lst
+        then addOpenXMLList $
+             map (\bs ->
+              case bs of
+                (Plain (Str "\9744":Space:ils):xs)
+                 -> (Just (CheckboxMarker False),Plain ils : xs)
+                (Para (Str "\9744":Space:ils):xs)
+                 -> (Just (CheckboxMarker False),Plain ils : xs)
+                (Plain (Str "\9746":Space:ils):xs)
+                 -> (Just (CheckboxMarker True),Para ils : xs)
+                (Para (Str "\9746":Space:ils):xs)
+                 -> (Just (CheckboxMarker True),Para ils : xs)
+                _ -> (Just BulletMarker,bs)) lst
+        else addOpenXMLList $ zip (Just BulletMarker : repeat Nothing) lst
   | OrderedList (start, numstyle, numdelim) lst <- el
-  = addOpenXMLList (NumberMarker numstyle numdelim start) lst
+  = addOpenXMLList $
+    zip (Just (NumberMarker numstyle numdelim start) : repeat Nothing) lst
   where
-    addOpenXMLList marker lst = do
-      addList marker
-      numid  <- getNumId
-      exampleid <- case marker of
-                        NumberMarker Example _ _ -> gets stExampleId
+    addOpenXMLList items = do
+      exampleid <- case items of
+                        (Just (NumberMarker Example _ _),_) : _ -> gets stExampleId
                         _ -> return Nothing
-      l <- asList $ concat `fmap` mapM (listItemToOpenXML opts $ fromMaybe numid exampleid) lst
+      l <- asList $ mconcat <$>
+              mapM (\(mbmarker, bs) -> do
+                      numid <- case mbmarker of
+                        Nothing -> getNumId
+                        Just marker -> do
+                          addList marker
+                          getNumId
+                      listItemToOpenXML opts (fromMaybe numid exampleid) bs)
+              items
       setFirstPara
       return l
 blockToOpenXML' opts (DefinitionList items) = do
@@ -552,7 +569,7 @@ listItemToOpenXML opts numid bs = do
 
 -- | Convert a list of inline elements to OpenXML.
 inlinesToOpenXML :: PandocMonad m => WriterOptions -> [Inline] -> WS m [Content]
-inlinesToOpenXML opts lst = concat `fmap` mapM (inlineToOpenXML opts) lst
+inlinesToOpenXML opts lst = concat `fmap` mapM (inlineToOpenXML opts) (convertSpace lst)
 
 withNumId :: (PandocMonad m) => Int -> WS m a -> WS m a
 withNumId numid = local $ \env -> env{ envListNumId = numid }
@@ -1006,3 +1023,8 @@ toBookmarkName s
 maxListLevel :: Int
 maxListLevel = 8
 
+convertSpace :: [Inline] -> [Inline]
+convertSpace (Str x : Space : Str y : xs) = convertSpace (Str (x <> " " <> y) : xs)
+convertSpace (Str x : Str y : xs)         = convertSpace (Str (x <> y) : xs)
+convertSpace (x:xs)                       = x : convertSpace xs
+convertSpace []                           = []

src/Text/Pandoc/Writers/Docx/Types.hs

@@ -40,12 +40,15 @@ import qualified Data.Text as T
 
 data ListMarker = NoMarker
                 | BulletMarker
+                | CheckboxMarker Bool
                 | NumberMarker ListNumberStyle ListNumberDelim Int
                 deriving (Show, Read, Eq, Ord)
 
 listMarkerToId :: ListMarker -> Text
 listMarkerToId NoMarker = "990"
 listMarkerToId BulletMarker = "991"
+listMarkerToId (CheckboxMarker False) = "992"
+listMarkerToId (CheckboxMarker True) = "993"
 listMarkerToId (NumberMarker sty delim n) = T.pack $
   '9' : '9' : styNum : delimNum : show n
   where styNum = case sty of

test/Tests/Writers/Docx.hs

@@ -97,6 +97,11 @@ tests = [ testGroup "inlines"
             def
             "docx/definition_list.native"
             "docx/golden/definition_list.docx"
+          , docxTest
+            "task lists"
+            def
+            "docx/task_list.native"
+            "docx/golden/task_list.docx"
           , docxTest
             "footnotes and endnotes"
             def

test/docx/task_list.native

@@ -0,0 +1,40 @@
+[ BulletList
+    [ [ Para [ Str "\9744" , Space , Str "Unchecked" ] ]
+    , [ Para [ Str "\9746" , Space , Str "Checked" ]
+      , Para
+          [ Str "with"
+          , Space
+          , Str "continuation"
+          , Space
+          , Str "paragraph"
+          ]
+      ]
+    , [ Para [ Str "\9744" , Space , Str "Unchecked" ]
+      , BulletList
+          [ [ Plain
+                [ Str "\9746"
+                , Space
+                , Str "Checked"
+                , Space
+                , Str "sublist"
+                ]
+            , BulletList
+                [ [ Plain
+                      [ Str "\9744"
+                      , Space
+                      , Str "Unchecked"
+                      , Space
+                      , Str "subsublist"
+                      ]
+                  , OrderedList
+                      ( 1 , Decimal , Period )
+                      [ [ Plain [ Str "Numbered" , Space , Str "child" ]
+                        ]
+                      ]
+                  ]
+                ]
+            ]
+          ]
+      ]
+    ]
+]