diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Org.hs | 76 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/ParserState.hs | 15 | ||||
| -rw-r--r-- | tests/Tests/Readers/Org.hs | 25 |
3 files changed, 103 insertions, 13 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 0ccaa8782..621e7107f 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -138,7 +138,7 @@ exportSetting = choice , ignoredSetting "author" , ignoredSetting "c" , ignoredSetting "creator" - , ignoredSetting "d" + , complementableListSetting "d" setExportDrawers , ignoredSetting "date" , ignoredSetting "e" , ignoredSetting "email" @@ -164,15 +164,53 @@ booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () booleanSetting settingIdentifier setter = try $ do string settingIdentifier char ':' - value <- many nonspaceChar - let boolValue = case value of - "nil" -> False - "{}" -> False - _ -> True - updateState $ modifyExportSettings setter boolValue + value <- elispBoolean + updateState $ modifyExportSettings setter value + +-- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are +-- interpreted as true. +elispBoolean :: OrgParser Bool +elispBoolean = try $ do + value <- many1 nonspaceChar + return $ case map toLower value of + "nil" -> False + "{}" -> False + "()" -> False + _ -> True + +-- | A list or a complement list (i.e. a list starting with `not`). +complementableListSetting :: String + -> ExportSettingSetter (Either [String] [String]) + -> OrgParser () +complementableListSetting settingIdentifier setter = try $ do + _ <- string settingIdentifier <* char ':' + value <- choice [ Left <$> complementStringList + , Right <$> stringList + , (\b -> if b then Left [] else Right []) <$> elispBoolean + ] + updateState $ modifyExportSettings setter value + where + -- Read a plain list of strings. + stringList :: OrgParser [String] + stringList = try $ + char '(' + *> sepBy elispString spaces + <* char ')' + + -- Read an emacs lisp list specifying a complement set. + complementStringList :: OrgParser [String] + complementStringList = try $ + string "(not " + *> sepBy elispString spaces + <* char ')' + + elispString :: OrgParser String + elispString = try $ + char '"' + *> manyTill alphaNum (char '"') ignoredSetting :: String -> OrgParser () -ignoredSetting s = try (() <$ string s <* char ':' <* many nonspaceChar) +ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar) -- -- Parser @@ -588,11 +626,27 @@ exampleLine = try $ skipSpaces *> string ": " *> anyLine -- -- | A generic drawer which has no special meaning for org-mode. +-- Whether or not this drawer is included in the output depends on the drawers +-- export setting. genericDrawer :: OrgParser (F Blocks) genericDrawer = try $ do - drawerStart - manyTill drawerLine (try drawerEnd) - return mempty + name <- map toUpper <$> drawerStart + content <- manyTill drawerLine (try drawerEnd) + state <- getState + -- Include drawer if it is explicitly included in or not explicitly excluded + -- from the list of drawers that should be exported. PROPERTIES drawers are + -- never exported. + case (exportDrawers . orgStateExportSettings $ state) of + _ | name == "PROPERTIES" -> return mempty + Left names | name `elem` names -> return mempty + Right names | name `notElem` names -> return mempty + _ -> drawerDiv name <$> parseLines content + where + parseLines :: [String] -> OrgParser (F Blocks) + parseLines = parseFromString parseBlocks . (++ "\n") . unlines + + drawerDiv :: String -> F Blocks -> F Blocks + drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty) drawerStart :: OrgParser String drawerStart = try $ diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index f84e5e51b..6a902cd46 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -39,8 +39,9 @@ module Text.Pandoc.Readers.Org.ParserState , runF , returnF , ExportSettingSetter - , exportSubSuperscripts + , ExportSettings (..) , setExportSubSuperscripts + , setExportDrawers , modifyExportSettings ) where @@ -76,6 +77,10 @@ type OrgLinkFormatters = M.Map String (String -> String) -- These settings can be changed via OPTIONS statements. data ExportSettings = ExportSettings { exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts + , exportDrawers :: Either [String] [String] + -- ^ Specify drawer names which should be exported. @Left@ names are + -- explicitly excluded from the resulting output while @Right@ means that + -- only the listed drawer names should be included. } -- | Org-mode parser state @@ -155,6 +160,7 @@ defaultOrgParserState = OrgParserState defaultExportSettings :: ExportSettings defaultExportSettings = ExportSettings { exportSubSuperscripts = True + , exportDrawers = Left ["LOGBOOK"] } @@ -163,9 +169,16 @@ defaultExportSettings = ExportSettings -- type ExportSettingSetter a = a -> ExportSettings -> ExportSettings +-- | Set export options for sub/superscript parsing. The short syntax will +-- not be parsed if this is set set to @False@. setExportSubSuperscripts :: ExportSettingSetter Bool setExportSubSuperscripts val es = es { exportSubSuperscripts = val } +-- | Set export options for drawers. See the @exportDrawers@ in ADT +-- @ExportSettings@ for details. +setExportDrawers :: ExportSettingSetter (Either [String] [String]) +setExportDrawers val es = es { exportDrawers = val } + -- | Modify a parser state modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState modifyExportSettings setter val state = diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index c478fedd6..780053059 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -420,9 +420,10 @@ tests = , "Drawers can be arbitrary" =: unlines [ ":FOO:" + , "/bar/" , ":END:" ] =?> - (mempty::Blocks) + divWith (mempty, ["FOO", "drawer"], mempty) (para $ emph "bar") , "Anchor reference" =: unlines [ "<<link-here>> Target." @@ -475,6 +476,28 @@ tests = , "a^b" ] =?> para "a^b" + + , "Export option: directly select drawers to be exported" =: + unlines [ "#+OPTIONS: d:(\"IMPORTANT\")" + , ":IMPORTANT:" + , "23" + , ":END:" + , ":BORING:" + , "very boring" + , ":END:" + ] =?> + divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "23") + + , "Export option: exclude drawers from being exported" =: + unlines [ "#+OPTIONS: d:(not \"BORING\")" + , ":IMPORTANT:" + , "5" + , ":END:" + , ":BORING:" + , "very boring" + , ":END:" + ] =?> + divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") ] , testGroup "Basic Blocks" $ |