aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Extensions.hs2
-rw-r--r--src/Text/Pandoc/Readers/Org/Blocks.hs41
-rw-r--r--src/Text/Pandoc/Writers/Org.hs16
-rw-r--r--test/Tests/Readers/Org/Block/List.hs13
-rw-r--r--test/Tests/Writers/Org.hs57
5 files changed, 113 insertions, 16 deletions
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 82eb0e957..3b96f9e04 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/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
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 6bd046e04..d1aff701e 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/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.
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index 43ebf1807..8dfc2749c 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/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)
diff --git a/test/Tests/Readers/Org/Block/List.hs b/test/Tests/Readers/Org/Block/List.hs
index 9686b5148..2ee37081e 100644
--- a/test/Tests/Readers/Org/Block/List.hs
+++ b/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") =?>
diff --git a/test/Tests/Writers/Org.hs b/test/Tests/Writers/Org.hs
index 9cbe360da..bd6c9b7ab 100644
--- a/test/Tests/Writers/Org.hs
+++ b/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"
]
- ]
+ ]
+ ]
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-18 13:44:40 +0000