diff --git a/src/Text/Pandoc/Writers/Docx/OpenXML.hs b/src/Text/Pandoc/Writers/Docx/OpenXML.hs index 5fa61e9b3e3a..bb2ad7afe3ac 100644 --- a/src/Text/Pandoc/Writers/Docx/OpenXML.hs +++ b/src/Text/Pandoc/Writers/Docx/OpenXML.hs @@ -25,6 +25,7 @@ import Control.Applicative ((<|>)) import Control.Monad.Except (catchError) import qualified Data.ByteString.Lazy as BL import Data.Char (isLetter) +import Data.Bifunctor (first) import Text.Pandoc.Char (isCJK) import Data.Ord (comparing) import Data.String (fromString) @@ -390,20 +391,9 @@ blockToOpenXML' opts (Table attr caption colspecs thead tbodies tfoot) = do wrapBookmark tableId content blockToOpenXML' opts el | 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 + = case mapM toTaskListItem lst of + Just items -> addOpenXMLList (map (first (Just . CheckboxMarker)) items) + Nothing -> addOpenXMLList $ zip (Just BulletMarker : repeat Nothing) lst | OrderedList (start, numstyle, numdelim) lst <- el = addOpenXMLList $ zip (Just (NumberMarker numstyle numdelim start) : repeat Nothing) lst diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index c7577ca385d5..3b14b0700a6c 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -484,12 +484,11 @@ defList opts items = toList H.dl opts (items ++ [nl]) 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 +listItemToHtml opts bls = + case toTaskListItem bls of + Just (checked, (Para is:bs)) -> taskListItem checked H.p is bs + Just (checked, (Plain is:bs)) -> taskListItem checked id is bs + _ -> blockListToHtml opts bls where taskListItem checked constr is bs = do let checkbox = if checked @@ -1012,7 +1011,7 @@ blockToHtmlInner opts (Header level (ident,classes,kvs) lst) = do _ -> H.p contents' blockToHtmlInner opts (BulletList lst) = do contents <- mapM (listItemToHtml opts) lst - (if isTaskList lst then (! A.class_ "task-list") else id) <$> + (if isJust (mapM toTaskListItem lst) then (! A.class_ "task-list") else id) <$> unordList opts contents blockToHtmlInner opts (OrderedList (startnum, numstyle, _) lst) = do contents <- mapM (listItemToHtml opts) lst diff --git a/src/Text/Pandoc/Writers/Shared.hs b/src/Text/Pandoc/Writers/Shared.hs index f0d5af6cad12..0455d450ae02 100644 --- a/src/Text/Pandoc/Writers/Shared.hs +++ b/src/Text/Pandoc/Writers/Shared.hs @@ -45,12 +45,12 @@ module Text.Pandoc.Writers.Shared ( , ensureValidXmlIdentifiers , setupTranslations , isOrderedListMarker - , isTaskList + , toTaskListItem ) where import Safe (lastMay) import qualified Data.ByteString.Lazy as BL -import Control.Monad (zipWithM) +import Control.Monad (zipWithM, MonadPlus, mzero) import Data.Either (isRight) import Data.Aeson (ToJSON (..), encode) import Data.Char (chr, ord, isSpace, isLetter, isUpper) @@ -638,13 +638,9 @@ isOrderedListMarker xs = not (T.null xs) && (T.last xs `elem` ['.',')']) && isRight (runParser (anyOrderedListMarker >> eof) defaultParserState "" xs) -isTaskListItem :: [Block] -> Bool -isTaskListItem (Plain (Str "☐":Space:_):_) = True -isTaskListItem (Plain (Str "☒":Space:_):_) = True -isTaskListItem (Para (Str "☐":Space:_):_) = True -isTaskListItem (Para (Str "☒":Space:_):_) = True -isTaskListItem _ = False - -isTaskList :: [[Block]] -> Bool -isTaskList [] = False -isTaskList items = all isTaskListItem items +toTaskListItem :: MonadPlus m => [Block] -> m (Bool, [Block]) +toTaskListItem (Plain (Str "☐":Space:ils):xs) = pure (False, Plain ils:xs) +toTaskListItem (Plain (Str "☒":Space:ils):xs) = pure (True, Plain ils:xs) +toTaskListItem (Para (Str "☐":Space:ils):xs) = pure (False, Para ils:xs) +toTaskListItem (Para (Str "☒":Space:ils):xs) = pure (True, Para ils:xs) +toTaskListItem _ = mzero diff --git a/test/docx/golden/task_list.docx b/test/docx/golden/task_list.docx index f31f9c502cbd..af86040bb1fc 100644 Binary files a/test/docx/golden/task_list.docx and b/test/docx/golden/task_list.docx differ