Org: support task_lists extension

The tasks lists extension is now supported by the org reader and writer;
the extension is turned on by default.

Closes: #6336

src/Text/Pandoc/Extensions.hs

@@ -381,6 +381,7 @@ getDefaultExtensions "commonmark_x"    = extensionsFromList
   ]
 getDefaultExtensions "org"             = extensionsFromList
                                           [Ext_citations,
+                                           Ext_task_lists,
                                            Ext_auto_identifiers]
 getDefaultExtensions "html"            = extensionsFromList
                                           [Ext_auto_identifiers,
@@ -515,6 +516,7 @@ getAllExtensions f = universalExtensions <> getAll f
     extensionsFromList
     [ Ext_citations
     , Ext_smart
+    , Ext_task_lists
     ]
   getAll "html"            = autoIdExtensions <>
     extensionsFromList

src/Text/Pandoc/Readers/Org/Blocks.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
 {- |
    Module      : Text.Pandoc.Readers.Org.Blocks
    Copyright   : Copyright (C) 2014-2021 Albert Krewinkel
@@ -850,16 +851,52 @@ definitionListItem parseIndentedMarker = try $ do
    definitionMarker =
      spaceChar *> string "::" <* (spaceChar <|> lookAhead newline)
 
+-- | Checkbox for tasks.
+data Checkbox
+  = UncheckedBox
+  | CheckedBox
+  | SemicheckedBox
+
+-- | Parses a checkbox in a plain list.
+checkbox :: PandocMonad m
+         => OrgParser m Checkbox
+checkbox = do
+  guardEnabled Ext_task_lists
+  try (char '[' *> status <* char ']') <?> "checkbox"
+  where
+    status = choice
+      [ UncheckedBox   <$ char ' '
+      , CheckedBox     <$ char 'X'
+      , SemicheckedBox <$ char '-'
+      ]
+
+checkboxToInlines :: Checkbox -> Inline
+checkboxToInlines = B.Str . \case
+  UncheckedBox   -> "☐"
+  SemicheckedBox -> "☐"
+  CheckedBox     -> "☒"
+
 -- | parse raw text for one list item
 listItem :: PandocMonad m
          => OrgParser m Int
          -> OrgParser m (F Blocks)
 listItem parseIndentedMarker = try . withContext ListItemState $ do
   markerLength <- try parseIndentedMarker
+  box <- optionMaybe checkbox
   firstLine <- anyLineNewline
   blank <- option "" ("\n" <$ blankline)
   rest <- T.concat <$> many (listContinuation markerLength)
-  parseFromString blocks $ firstLine <> blank <> rest
+  contents <- parseFromString blocks $ firstLine <> blank <> rest
+  return (maybe id (prependInlines . checkboxToInlines) box <$> contents)
+
+-- | Prepend inlines to blocks, adding them to the first paragraph or
+-- creating a new Plain element if necessary.
+prependInlines :: Inline -> Blocks -> Blocks
+prependInlines inlns = B.fromList . prepend . B.toList
+  where
+    prepend (Plain is : bs) = Plain (inlns : Space : is) : bs
+    prepend (Para  is : bs) = Para  (inlns : Space : is) : bs
+    prepend bs              = Plain [inlns, Space] : bs
 
 -- continuation of a list item - indented and separated by blankline or endline.
 -- Note: nested lists are parsed as continuations.

src/Text/Pandoc/Writers/Org.hs

@@ -213,25 +213,35 @@ blockToOrg (DefinitionList items) = do
 -- | Convert bullet list item (list of blocks) to Org.
 bulletListItemToOrg :: PandocMonad m => [Block] -> Org m (Doc Text)
 bulletListItemToOrg items = do
-  contents <- blockListToOrg items
+  exts <- gets $ writerExtensions . stOptions
+  contents <- blockListToOrg (taskListItemToOrg exts items)
   return $ hang 2 "- " contents $$
           if endsWithPlain items
              then cr
              else blankline
 
-
 -- | Convert ordered list item (a list of blocks) to Org.
 orderedListItemToOrg :: PandocMonad m
                      => Text   -- ^ marker for list item
                      -> [Block]  -- ^ list item (list of blocks)
                      -> Org m (Doc Text)
 orderedListItemToOrg marker items = do
-  contents <- blockListToOrg items
+  exts <- gets $ writerExtensions . stOptions
+  contents <- blockListToOrg (taskListItemToOrg exts items)
   return $ hang (T.length marker + 1) (literal marker <> space) contents $$
           if endsWithPlain items
              then cr
              else blankline
 
+-- | 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]@).
+taskListItemToOrg :: Extensions -> [Block] -> [Block]
+taskListItemToOrg = handleTaskListItem toOrg
+  where
+    toOrg (Str "☐" : Space : is) = Str "[ ]" : Space : is
+    toOrg (Str "☒" : Space : is) = Str "[X]" : Space : is
+    toOrg is = is
+
 -- | Convert definition list item (label, list of blocks) to Org.
 definitionListItemToOrg :: PandocMonad m
                         => ([Inline], [[Block]]) -> Org m (Doc Text)

test/Tests/Readers/Org/Block/List.hs

@@ -118,6 +118,19 @@ tests =
                 ] =?>
       bulletList [ plain "", plain "" ]
 
+  , "Task list" =:
+    T.unlines [ "- [ ] nope"
+              , "- [X] yup"
+              , "- [-] started"
+              , "  1. [X] sure"
+              , "  2. [ ] nuh-uh"
+              ] =?>
+    bulletList [ plain "☐ nope", plain "☒ yup"
+               , mconcat [ plain "☐ started"
+                         , orderedList [plain "☒ sure", plain "☐ nuh-uh"]
+                         ]
+               ]
+
   , "Simple Ordered List" =:
       ("1. Item1\n" <>
        "2. Item2\n") =?>

test/Tests/Writers/Org.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Tests.Writers.Org (tests) where
 
+import Data.Text as T
 import Test.Tasty
 import Tests.Helpers
 import Text.Pandoc
@@ -9,17 +10,51 @@ import Text.Pandoc.Builder
 
 infix 4 =:
 (=:) :: (ToString a, ToPandoc a)
-     => String -> (a, String) -> TestTree
-(=:) = test (purely (writeOrg def . toPandoc))
+     => String -> (a, Text) -> TestTree
+(=:) = test org
+
+defopts :: WriterOptions
+defopts = def
+  { writerExtensions = getDefaultExtensions "org"
+  }
+
+org :: (ToPandoc a) => a -> Text
+org = orgWithOpts defopts
+
+orgWithOpts :: (ToPandoc a) => WriterOptions -> a -> Text
+orgWithOpts opts x = purely (writeOrg opts) $ toPandoc x
+
 
 tests :: [TestTree]
-tests = [ testGroup "links"
-          -- See http://orgmode.org/manual/Internal-links.html#Internal-links
-          [ "simple link"
-              =: link "/url" "" "foo"
-              =?> "[[/url][foo]]"
-          , "internal link to anchor"
-              =: link "#my-custom-id" "" "#my-custom-id"
-              =?> "[[#my-custom-id]]"
+tests =
+  [ testGroup "links"
+    -- See http://orgmode.org/manual/Internal-links.html#Internal-links
+    [ "simple link"
+      =: link "/url" "" "foo"
+      =?> "[[/url][foo]]"
+    , "internal link to anchor"
+      =: link "#my-custom-id" "" "#my-custom-id"
+      =?> "[[#my-custom-id]]"
+    ]
+
+  , testGroup "lists"
+    [ "bullet task list"
+      =: bulletList [plain "☐ a", plain "☒ b"]
+      =?> T.unlines
+          [ "- [ ] a"
+          , "- [X] b"
           ]
-        ]
+    , "ordered task list"
+      =: orderedList [plain ("☐" <> space <> "a"), plain "☒ b"]
+      =?> T.unlines
+          [ "1. [ ] a"
+          , "2. [X] b"
+          ]
+    , test (orgWithOpts def) "bullet without task_lists" $
+      bulletList [plain "☐ a", plain "☒ b"]
+      =?> T.unlines
+          [ "- ☐ a"
+          , "- ☒ b"
+          ]
+    ]
+  ]