diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/DocumentTree.hs | 22 | ||||
| -rw-r--r-- | test/Tests/Readers/Org.hs | 36 |
2 files changed, 35 insertions, 23 deletions
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs index 8c2a8482a..66ccd4655 100644 --- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs +++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Org.DocumentTree import Control.Monad (guard, void) import Data.Char (toLower, toUpper) +import Data.List ( intersperse ) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Text.Pandoc.Builder (Blocks, Inlines) @@ -224,7 +225,7 @@ headlineToHeader (Headline {..}) = do Just kw -> todoKeywordToInlines kw <> B.space Nothing -> mempty else mempty - let text = tagTitle (todoText <> headlineText) headlineTags + let text = todoText <> headlineText <> tagsToInlines headlineTags let propAttr = propertiesToAttr headlineProperties attr <- registerHeader propAttr headlineText return $ B.headerWith attr headlineLevel text @@ -259,12 +260,21 @@ propertiesToAttr properties = in (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs') -tagTitle :: Inlines -> [Tag] -> Inlines -tagTitle title tags = title <> (mconcat $ map tagToInline tags) +tagsToInlines :: [Tag] -> Inlines +tagsToInlines [] = mempty +tagsToInlines tags = + (B.space <>) . mconcat . intersperse (B.str "\160") . map tagToInline $ tags + where + tagToInline :: Tag -> Inlines + tagToInline t = tagSpan t . B.smallcaps . B.str $ fromTag t + +-- | Wrap the given inline in a span, marking it as a tag. +tagSpan :: Tag -> Inlines -> Inlines +tagSpan t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) + + + --- | Convert -tagToInline :: Tag -> Inlines -tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty -- | Read a :PROPERTIES: drawer and return the key/value pairs contained -- within. diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs index 3302e0c3e..63b32c688 100644 --- a/test/Tests/Readers/Org.hs +++ b/test/Tests/Readers/Org.hs @@ -28,6 +28,10 @@ simpleTable' :: Int -> Blocks simpleTable' n = table "" (replicate n (AlignDefault, 0.0)) +-- | Create a span for the given tag. +tagSpan :: String -> Inlines +tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) . smallcaps $ str t + tests :: [TestTree] tests = [ testGroup "Inlines" $ @@ -729,18 +733,17 @@ tests = , "* old :ARCHIVE:" , " boring" ] =?> - let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty - in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") - , para "boring" - ] + mconcat [ headerWith ("old", [], mempty) 1 + ("old" <> space <> tagSpan "ARCHIVE") + , para "boring" + ] , "include archive tree header only" =: unlines [ "#+OPTIONS: arch:headline" , "* old :ARCHIVE:" , " boring" ] =?> - let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty - in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + headerWith ("old", [], mempty) 1 ("old" <> space <> tagSpan "ARCHIVE") , "limit headline depth" =: unlines [ "#+OPTIONS: H:2" @@ -898,17 +901,16 @@ tests = , "** Call Mom :@PHONE:" , "** Call John :@PHONE:JOHN: " ] =?> - let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty - in mconcat [ headerWith ("personal", [], []) - 1 - ("Personal" <> tagSpan "PERSONAL") - , headerWith ("call-mom", [], []) - 2 - ("Call Mom" <> tagSpan "@PHONE") - , headerWith ("call-john", [], []) - 2 - ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN") - ] + mconcat [ headerWith ("personal", [], []) + 1 + ("Personal " <> tagSpan "PERSONAL") + , headerWith ("call-mom", [], []) + 2 + ("Call Mom " <> tagSpan "@PHONE") + , headerWith ("call-john", [], []) + 2 + ("Call John " <> tagSpan "@PHONE" <> "\160" <> tagSpan "JOHN") + ] , "Untagged header containing colons" =: "* This: is not: tagged" =?> |