From 2f8d6755f4a799544fba2dc364004f5035b45c90 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 1 Jul 2016 20:45:00 +0200 Subject: Org reader: improve tag and properties type safety Specific newtype definitions are used to replace stringly typing of tags and properties. Type safety is increased while readability is improved. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 82 ++++++++++++++++++++++++----------- 1 file changed, 57 insertions(+), 25 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 32deb1fc8..5423b1b83 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -53,6 +53,35 @@ import qualified Data.Map as M import Data.Maybe ( fromMaybe, isNothing ) import Network.HTTP ( urlEncode ) +-- +-- Org headers +-- +newtype Tag = Tag { fromTag :: String } + deriving (Show, Eq) + +-- | Create a tag containing the given string. +toTag :: String -> Tag +toTag = Tag + +-- | The key (also called name or type) of a property. +newtype PropertyKey = PropertyKey { fromKey :: String } + deriving (Show, Eq, Ord) + +-- | Create a property key containing the given string. Org mode keys are +-- case insensitive and are hence converted to lower case. +toPropertyKey :: String -> PropertyKey +toPropertyKey = PropertyKey . map toLower + +-- | The value assigned to a property. +newtype PropertyValue = PropertyValue { fromValue :: String } + +-- | Create a property value containing the given string. +toPropertyValue :: String -> PropertyValue +toPropertyValue = PropertyValue + +-- | Key/value pairs from a PROPERTIES drawer +type Properties = [(PropertyKey, PropertyValue)] + -- -- parsing blocks @@ -381,30 +410,22 @@ drawerEnd = try $ -- | Read a :PROPERTIES: drawer and return the key/value pairs contained -- within. -propertiesDrawer :: OrgParser [(String, String)] +propertiesDrawer :: OrgParser Properties propertiesDrawer = try $ do drawerType <- drawerStart guard $ map toUpper drawerType == "PROPERTIES" manyTill property (try drawerEnd) where - property :: OrgParser (String, String) + property :: OrgParser (PropertyKey, PropertyValue) property = try $ (,) <$> key <*> value - key :: OrgParser String - key = try $ skipSpaces *> char ':' *> many1Till nonspaceChar (char ':') + key :: OrgParser PropertyKey + key = fmap toPropertyKey . try $ + skipSpaces *> char ':' *> many1Till nonspaceChar (char ':') - value :: OrgParser String - value = try $ skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline) - -keyValuesToAttr :: [(String, String)] -> Attr -keyValuesToAttr kvs = - let - lowerKvs = map (\(k, v) -> (map toLower k, v)) kvs - id' = fromMaybe mempty . lookup "custom_id" $ lowerKvs - cls = fromMaybe mempty . lookup "class" $ lowerKvs - kvs' = filter (flip notElem ["custom_id", "class"] . fst) lowerKvs - in - (id', words cls, kvs') + value :: OrgParser PropertyValue + value = fmap toPropertyValue . try $ + skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline) -- @@ -624,23 +645,34 @@ header = try $ do tags <- option [] headerTags newline let text = tagTitle title tags - propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer) + propAttr <- option nullAttr (propertiesToAttr <$> propertiesDrawer) attr <- registerHeader propAttr (runF text def) return (B.headerWith attr level <$> text) where - tagTitle :: [F Inlines] -> [String] -> F Inlines + tagTitle :: [F Inlines] -> [Tag] -> F Inlines tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags - tagToInlineF :: String -> F Inlines - tagToInlineF t = return $ B.spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + tagToInlineF :: Tag -> F Inlines + tagToInlineF t = + return $ B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty - headerTags :: OrgParser [String] + headerTags :: OrgParser [Tag] headerTags = try $ let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':' - in skipSpaces - *> char ':' - *> many1 tag - <* skipSpaces + in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces) + +propertiesToAttr :: Properties -> Attr +propertiesToAttr properties = + let + toStringPair prop = (fromKey (fst prop), fromValue (snd prop)) + customIdKey = toPropertyKey "custom_id" + classKey = toPropertyKey "class" + id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties + cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties + kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst) + $ properties + in + (id', words cls, kvs') -- -- cgit v1.2.3 From 17484ed01a7659beddd93114d2ff542005df2465 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 1 Jul 2016 21:14:04 +0200 Subject: Org reader: parse as headlines, convert to blocks Emacs org-mode is based on outline-mode, which treats documents as trees with headlines are nodes. The reader is refactored to parse into a similar tree structure. This simplifies transformations acting on document (sub-)trees. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 133 ++++++++++++++++++++++------------ 1 file changed, 86 insertions(+), 47 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 5423b1b83..9ebb22d13 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} {- Copyright (C) 2014-2016 Albert Krewinkel @@ -46,7 +47,7 @@ import Text.Pandoc.Compat.Monoid ((<>)) import Text.Pandoc.Options import Text.Pandoc.Shared ( compactify', compactify'DL ) -import Control.Monad ( foldM, guard, mzero ) +import Control.Monad ( foldM, guard, mzero, void ) import Data.Char ( isSpace, toLower, toUpper) import Data.List ( foldl', intersperse, isPrefixOf ) import qualified Data.Map as M @@ -82,6 +83,82 @@ toPropertyValue = PropertyValue -- | Key/value pairs from a PROPERTIES drawer type Properties = [(PropertyKey, PropertyValue)] +-- | Org mode headline (i.e. a document subtree). +data Headline = Headline + { headlineLevel :: Int + , headlineText :: Inlines + , headlineTags :: [Tag] + , headlineProperties :: Properties + , headlineContents :: Blocks + , headlineChildren :: [Headline] + } + +-- +-- Parsing headlines and subtrees +-- + +-- | Read an Org mode headline and its contents (i.e. a document subtree). +-- @lvl@ gives the minimum acceptable level of the tree. +headline :: Int -> OrgParser (F Headline) +headline lvl = try $ do + level <- headerStart + guard (lvl <= level) + title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle + tags <- option [] headerTags + newline + properties <- option mempty propertiesDrawer + contents <- blocks + children <- many (headline (lvl + 1)) + return $ do + title' <- title + contents' <- contents + children' <- sequence children + return $ Headline + { headlineLevel = level + , headlineText = title' + , headlineTags = tags + , headlineProperties = properties + , headlineContents = contents' + , headlineChildren = children' + } + where + endOfTitle :: OrgParser () + endOfTitle = void . lookAhead $ optional headerTags *> newline + + headerTags :: OrgParser [Tag] + headerTags = try $ + let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':' + in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces) + +-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks +headlineToBlocks :: Headline -> OrgParser Blocks +headlineToBlocks (Headline {..}) = do + let text = tagTitle headlineText headlineTags + let propAttr = propertiesToAttr headlineProperties + attr <- registerHeader propAttr headlineText + let header = B.headerWith attr headlineLevel text + childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren) + return $ header <> headlineContents <> childrenBlocks + +propertiesToAttr :: Properties -> Attr +propertiesToAttr properties = + let + toStringPair prop = (fromKey (fst prop), fromValue (snd prop)) + customIdKey = toPropertyKey "custom_id" + classKey = toPropertyKey "class" + id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties + cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties + kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst) + $ properties + in + (id', words cls, kvs') + +tagTitle :: Inlines -> [Tag] -> Inlines +tagTitle title tags = title <> (mconcat $ map tagToInline tags) + +tagToInline :: Tag -> Inlines +tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty + -- -- parsing blocks @@ -90,9 +167,11 @@ type Properties = [(PropertyKey, PropertyValue)] -- | Get a list of blocks. blockList :: OrgParser [Block] blockList = do - blocks' <- blocks - st <- getState - return . B.toList $ runF blocks' st + initialBlocks <- blocks + headlines <- sequence <$> manyTill (headline 1) eof + st <- getState + headlineBlocks <- fmap mconcat . sequence . map headlineToBlocks $ runF headlines st + return . B.toList $ (runF initialBlocks st) <> headlineBlocks -- | Get the meta information safed in the state. meta :: OrgParser Meta @@ -101,7 +180,7 @@ meta = do return $ runF (orgStateMeta st) st blocks :: OrgParser (F Blocks) -blocks = mconcat <$> manyTill block eof +blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof) block :: OrgParser (F Blocks) block = choice [ mempty <$ blanklines @@ -111,7 +190,6 @@ block = choice [ mempty <$ blanklines , example , genericDrawer , specialLine - , header , horizontalRule , list , latexFragment @@ -633,47 +711,6 @@ parseFormat = try $ do rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r") tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:"")) --- --- Headers --- - --- | Headers -header :: OrgParser (F Blocks) -header = try $ do - level <- headerStart - title <- manyTill inline (lookAhead $ optional headerTags <* newline) - tags <- option [] headerTags - newline - let text = tagTitle title tags - propAttr <- option nullAttr (propertiesToAttr <$> propertiesDrawer) - attr <- registerHeader propAttr (runF text def) - return (B.headerWith attr level <$> text) - where - tagTitle :: [F Inlines] -> [Tag] -> F Inlines - tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags - - tagToInlineF :: Tag -> F Inlines - tagToInlineF t = - return $ B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty - - headerTags :: OrgParser [Tag] - headerTags = try $ - let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':' - in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces) - -propertiesToAttr :: Properties -> Attr -propertiesToAttr properties = - let - toStringPair prop = (fromKey (fst prop), fromValue (snd prop)) - customIdKey = toPropertyKey "custom_id" - classKey = toPropertyKey "class" - id' = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties - cls = fromMaybe mempty . fmap fromValue . lookup classKey $ properties - kvs' = map toStringPair . filter ((`notElem` [customIdKey, classKey]) . fst) - $ properties - in - (id', words cls, kvs') - -- -- Tables @@ -838,6 +875,8 @@ noteBlock = try $ do -- Paragraphs or Plain text paraOrPlain :: OrgParser (F Blocks) paraOrPlain = try $ do + -- Make sure we are not looking at a headline + notFollowedBy' (char '*' *> (oneOf " *")) ils <- inlines nl <- option False (newline *> return True) -- Read block as paragraph, except if we are in a list context and the block -- cgit v1.2.3 From 1ebaf6de117d74145a58d63a41a4c69b87aaa771 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 1 Jul 2016 21:17:55 +0200 Subject: Org reader: refactor comment tree handling Comment trees were handled after parsing, as pattern matching on lists is easier than matching on sequences. The new method of reading documents as trees allows for more elegant subtree removal. --- src/Text/Pandoc/Readers/Org.hs | 39 +---------------------------------- src/Text/Pandoc/Readers/Org/Blocks.hs | 21 ++++++++++++++++++- 2 files changed, 21 insertions(+), 39 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index d593f856d..4e1c926da 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -52,41 +52,4 @@ parseOrg :: OrgParser Pandoc parseOrg = do blocks' <- blockList meta' <- meta - return . Pandoc meta' $ removeUnwantedBlocks blocks' - where - removeUnwantedBlocks :: [Block] -> [Block] - removeUnwantedBlocks = dropCommentTrees . filter (/= Null) - --- | Drop COMMENT headers and the document tree below those headers. -dropCommentTrees :: [Block] -> [Block] -dropCommentTrees [] = [] -dropCommentTrees (b:bs) = - maybe (b:dropCommentTrees bs) - (dropCommentTrees . flip dropUntilHeaderAboveLevel bs) - (commentHeaderLevel b) - --- | Return the level of a header starting a comment or :noexport: tree and --- Nothing otherwise. -commentHeaderLevel :: Block -> Maybe Int -commentHeaderLevel blk = - case blk of - (Header level _ ((Str "COMMENT"):_)) -> Just level - (Header level _ title) | hasNoExportTag title -> Just level - _ -> Nothing - where - hasNoExportTag :: [Inline] -> Bool - hasNoExportTag = any isNoExportTag - - isNoExportTag :: Inline -> Bool - isNoExportTag (Span ("", ["tag"], [("data-tag-name", "noexport")]) []) = True - isNoExportTag _ = False - --- | Drop blocks until a header on or above the given level is seen -dropUntilHeaderAboveLevel :: Int -> [Block] -> [Block] -dropUntilHeaderAboveLevel n = dropWhile (not . isHeaderLevelLowerEq n) - -isHeaderLevelLowerEq :: Int -> Block -> Bool -isHeaderLevelLowerEq n blk = - case blk of - (Header level _ _) -> n >= level - _ -> False + return $ Pandoc meta' blocks' diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 9ebb22d13..c9e9d2ced 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} {- Copyright (C) 2014-2016 Albert Krewinkel @@ -52,6 +53,7 @@ import Data.Char ( isSpace, toLower, toUpper) import Data.List ( foldl', intersperse, isPrefixOf ) import qualified Data.Map as M import Data.Maybe ( fromMaybe, isNothing ) +import qualified Data.Sequence as S import Network.HTTP ( urlEncode ) -- @@ -132,7 +134,24 @@ headline lvl = try $ do -- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks headlineToBlocks :: Headline -> OrgParser Blocks -headlineToBlocks (Headline {..}) = do +headlineToBlocks hdln@(Headline {..}) = + case () of + _ | any isNoExportTag headlineTags -> return mempty + _ | isCommentTitle headlineText -> return mempty + _ -> headlineToHeader hdln + +isNoExportTag :: Tag -> Bool +isNoExportTag = (== toTag "noexport") + +-- | Check if the title starts with COMMENT. +-- FIXME: This accesses builder internals not intended for use in situations +-- as these. Replace once keyword parsing is supported. +isCommentTitle :: Inlines -> Bool +isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT" +isCommentTitle _ = False + +headlineToHeader :: Headline -> OrgParser Blocks +headlineToHeader (Headline {..}) = do let text = tagTitle headlineText headlineTags let propAttr = propertiesToAttr headlineProperties attr <- registerHeader propAttr headlineText -- cgit v1.2.3 From c4cf6d237f1017d36eeafad162570754506a6093 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 1 Jul 2016 22:44:29 +0200 Subject: Org reader: support archived trees export options Handling of archived trees can be modified using the `arch` option. Archived trees are either dropped, exported completely, or collapsed to include just the header when the `arch` option is nil, non-nil, or `headline`, respectively. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 49 ++++++++++++++++++++++++++---- src/Text/Pandoc/Readers/Org/ParserState.hs | 21 +++++++++++-- tests/Tests/Readers/Org.hs | 24 +++++++++++++++ 3 files changed, 86 insertions(+), 8 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index c9e9d2ced..5d4a0cae2 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -137,27 +137,43 @@ headlineToBlocks :: Headline -> OrgParser Blocks headlineToBlocks hdln@(Headline {..}) = case () of _ | any isNoExportTag headlineTags -> return mempty + _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln _ | isCommentTitle headlineText -> return mempty - _ -> headlineToHeader hdln + _ -> headlineToHeaderWithContents hdln isNoExportTag :: Tag -> Bool isNoExportTag = (== toTag "noexport") +isArchiveTag :: Tag -> Bool +isArchiveTag = (== toTag "ARCHIVE") + -- | Check if the title starts with COMMENT. -- FIXME: This accesses builder internals not intended for use in situations --- as these. Replace once keyword parsing is supported. +-- like these. Replace once keyword parsing is supported. isCommentTitle :: Inlines -> Bool isCommentTitle xs = (B.Many . S.take 1 . B.unMany) xs == B.str "COMMENT" isCommentTitle _ = False +archivedHeadlineToBlocks :: Headline -> OrgParser Blocks +archivedHeadlineToBlocks hdln = do + archivedTreesOption <- getExportSetting exportArchivedTrees + case archivedTreesOption of + ArchivedTreesNoExport -> return mempty + ArchivedTreesExport -> headlineToHeaderWithContents hdln + ArchivedTreesHeadlineOnly -> headlineToHeader hdln + +headlineToHeaderWithContents :: Headline -> OrgParser Blocks +headlineToHeaderWithContents hdln@(Headline {..}) = do + header <- headlineToHeader hdln + childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren) + return $ header <> headlineContents <> childrenBlocks + headlineToHeader :: Headline -> OrgParser Blocks headlineToHeader (Headline {..}) = do let text = tagTitle headlineText headlineTags let propAttr = propertiesToAttr headlineProperties attr <- registerHeader propAttr headlineText - let header = B.headerWith attr headlineLevel text - childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren) - return $ header <> headlineContents <> childrenBlocks + return $ B.headerWith attr headlineLevel text propertiesToAttr :: Properties -> Attr propertiesToAttr properties = @@ -629,7 +645,7 @@ exportSetting = choice , ignoredSetting ":" , ignoredSetting "<" , ignoredSetting "\\n" - , ignoredSetting "arch" + , archivedTreeSetting "arch" setExportArchivedTrees , ignoredSetting "author" , ignoredSetting "c" , ignoredSetting "creator" @@ -673,6 +689,27 @@ elispBoolean = try $ do "()" -> False _ -> True +archivedTreeSetting :: String + -> ExportSettingSetter ArchivedTreesOption + -> OrgParser () +archivedTreeSetting settingIdentifier setter = try $ do + string settingIdentifier + char ':' + value <- archivedTreesHeadlineSetting <|> archivedTreesBoolean + updateState $ modifyExportSettings setter value + where + archivedTreesHeadlineSetting = try $ do + string "headline" + lookAhead (newline <|> spaceChar) + return ArchivedTreesHeadlineOnly + + archivedTreesBoolean = try $ do + exportBool <- elispBoolean + return $ + if exportBool + then ArchivedTreesExport + else ArchivedTreesNoExport + -- | A list or a complement list (i.e. a list starting with `not`). complementableListSetting :: String -> ExportSettingSetter (Either [String] [String]) diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 0c58183f9..93be92ae8 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -42,6 +42,8 @@ module Text.Pandoc.Readers.Org.ParserState , returnF , ExportSettingSetter , ExportSettings (..) + , ArchivedTreesOption (..) + , setExportArchivedTrees , setExportDrawers , setExportEmphasizedText , setExportSmartQuotes @@ -78,10 +80,17 @@ type OrgNoteTable = [OrgNoteRecord] -- link-type, the corresponding function transforms the given link string. type OrgLinkFormatters = M.Map String (String -> String) +-- | Options for the way archived trees are handled. +data ArchivedTreesOption = + ArchivedTreesExport -- ^ Export the complete tree + | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting + | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents + -- | Export settings -- These settings can be changed via OPTIONS statements. data ExportSettings = ExportSettings - { exportDrawers :: Either [String] [String] + { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees + , 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. @@ -159,7 +168,8 @@ defaultOrgParserState = OrgParserState defaultExportSettings :: ExportSettings defaultExportSettings = ExportSettings - { exportDrawers = Left ["LOGBOOK"] + { exportArchivedTrees = ArchivedTreesHeadlineOnly + , exportDrawers = Left ["LOGBOOK"] , exportEmphasizedText = True , exportSmartQuotes = True , exportSpecialStrings = True @@ -174,8 +184,15 @@ optionsToParserState opts = -- -- Setter for exporting options -- + +-- This whole section could be scraped if we were using lenses. + type ExportSettingSetter a = a -> ExportSettings -> ExportSettings +-- | Set export options for archived trees. +setExportArchivedTrees :: ExportSettingSetter ArchivedTreesOption +setExportArchivedTrees val es = es { exportArchivedTrees = val } + -- | Set export options for drawers. See the @exportDrawers@ in ADT -- @ExportSettings@ for details. setExportDrawers :: ExportSettingSetter (Either [String] [String]) diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index 7612d88f1..f57858a55 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -587,6 +587,30 @@ tests = , ":END:" ] =?> divWith (mempty, ["IMPORTANT", "drawer"], mempty) (para "5") + + , "Export option: don't include archive trees" =: + unlines [ "#+OPTIONS: arch:nil" + , "* old :ARCHIVE:" + ] =?> + (mempty ::Blocks) + + , "Export option: include complete archive trees" =: + unlines [ "#+OPTIONS: arch:t" + , "* old :ARCHIVE:" + , " boring" + ] =?> + let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty + in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + , para "boring" + ] + + , "Export option: 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") ] , testGroup "Basic Blocks" $ -- cgit v1.2.3 From c1f6bd2640ba028af61ec51f744842350a53246b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 2 Jul 2016 10:04:47 +0200 Subject: Org reader: put export setting parser into module Export option parsing is distinct enough from general block parsing to justify putting it into a separate module. --- pandoc.cabal | 1 + src/Text/Pandoc/Readers/Org/Blocks.hs | 118 +------------------ src/Text/Pandoc/Readers/Org/ExportSettings.hs | 159 ++++++++++++++++++++++++++ src/Text/Pandoc/Readers/Org/ParserState.hs | 105 +++++------------ 4 files changed, 192 insertions(+), 191 deletions(-) create mode 100644 src/Text/Pandoc/Readers/Org/ExportSettings.hs (limited to 'src/Text/Pandoc/Readers') diff --git a/pandoc.cabal b/pandoc.cabal index 54f452514..3976eddca 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -399,6 +399,7 @@ Library Text.Pandoc.Readers.Odt.Arrows.Utils, Text.Pandoc.Readers.Org.BlockStarts, Text.Pandoc.Readers.Org.Blocks, + Text.Pandoc.Readers.Org.ExportSettings, Text.Pandoc.Readers.Org.Inlines, Text.Pandoc.Readers.Org.ParserState, Text.Pandoc.Readers.Org.Parsing, diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 5d4a0cae2..af178d400 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Org.Blocks ) where import Text.Pandoc.Readers.Org.BlockStarts +import Text.Pandoc.Readers.Org.ExportSettings ( exportSettings ) import Text.Pandoc.Readers.Org.Inlines import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing @@ -620,7 +621,7 @@ optionLine = try $ do key <- metaKey case key of "link" -> parseLinkFormat >>= uncurry addLinkFormat - "options" -> () <$ sepBy spaces exportSetting + "options" -> exportSettings _ -> mzero addLinkFormat :: String @@ -630,121 +631,6 @@ addLinkFormat key formatter = updateState $ \s -> let fs = orgStateLinkFormatters s in s{ orgStateLinkFormatters = M.insert key formatter fs } - --- --- Export Settings --- - --- | Read and process org-mode specific export options. -exportSetting :: OrgParser () -exportSetting = choice - [ booleanSetting "^" setExportSubSuperscripts - , booleanSetting "'" setExportSmartQuotes - , booleanSetting "*" setExportEmphasizedText - , booleanSetting "-" setExportSpecialStrings - , ignoredSetting ":" - , ignoredSetting "<" - , ignoredSetting "\\n" - , archivedTreeSetting "arch" setExportArchivedTrees - , ignoredSetting "author" - , ignoredSetting "c" - , ignoredSetting "creator" - , complementableListSetting "d" setExportDrawers - , ignoredSetting "date" - , ignoredSetting "e" - , ignoredSetting "email" - , ignoredSetting "f" - , ignoredSetting "H" - , ignoredSetting "inline" - , ignoredSetting "num" - , ignoredSetting "p" - , ignoredSetting "pri" - , ignoredSetting "prop" - , ignoredSetting "stat" - , ignoredSetting "tags" - , ignoredSetting "tasks" - , ignoredSetting "tex" - , ignoredSetting "timestamp" - , ignoredSetting "title" - , ignoredSetting "toc" - , ignoredSetting "todo" - , ignoredSetting "|" - ] "export setting" - -booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () -booleanSetting settingIdentifier setter = try $ do - string settingIdentifier - char ':' - 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 - -archivedTreeSetting :: String - -> ExportSettingSetter ArchivedTreesOption - -> OrgParser () -archivedTreeSetting settingIdentifier setter = try $ do - string settingIdentifier - char ':' - value <- archivedTreesHeadlineSetting <|> archivedTreesBoolean - updateState $ modifyExportSettings setter value - where - archivedTreesHeadlineSetting = try $ do - string "headline" - lookAhead (newline <|> spaceChar) - return ArchivedTreesHeadlineOnly - - archivedTreesBoolean = try $ do - exportBool <- elispBoolean - return $ - if exportBool - then ArchivedTreesExport - else ArchivedTreesNoExport - --- | 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 ':' <* many1 nonspaceChar) - - parseLinkFormat :: OrgParser ((String, String -> String)) parseLinkFormat = try $ do linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs new file mode 100644 index 000000000..9f844c8dd --- /dev/null +++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs @@ -0,0 +1,159 @@ +{- +Copyright (C) 2014-2016 Albert Krewinkel + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +-} + +{- | + Module : Text.Pandoc.Readers.Org.Options + Copyright : Copyright (C) 2016 Albert Krewinkel + License : GNU GPL, version 2 or above + + Maintainer : Albert Krewinkel + +Parsers for Org-mode export options. +-} +module Text.Pandoc.Readers.Org.ExportSettings + ( exportSettings + ) where + +import Text.Pandoc.Readers.Org.ParserState +import Text.Pandoc.Readers.Org.Parsing + +import Control.Monad ( void ) +import Data.Char ( toLower ) + +-- | Read and handle space separated org-mode export settings. +exportSettings :: OrgParser () +exportSettings = void $ sepBy spaces exportSetting + +-- | Setter function for export settings. +type ExportSettingSetter a = a -> ExportSettings -> ExportSettings + +-- | Read and process a single org-mode export option. +exportSetting :: OrgParser () +exportSetting = choice + [ booleanSetting "^" (\val es -> es { exportSubSuperscripts = val }) + , booleanSetting "'" (\val es -> es { exportSmartQuotes = val }) + , booleanSetting "*" (\val es -> es { exportEmphasizedText = val }) + , booleanSetting "-" (\val es -> es { exportSpecialStrings = val }) + , ignoredSetting ":" + , ignoredSetting "<" + , ignoredSetting "\\n" + , archivedTreeSetting "arch" (\val es -> es { exportArchivedTrees = val }) + , ignoredSetting "author" + , ignoredSetting "c" + , ignoredSetting "creator" + , complementableListSetting "d" (\val es -> es { exportDrawers = val }) + , ignoredSetting "date" + , ignoredSetting "e" + , ignoredSetting "email" + , ignoredSetting "f" + , ignoredSetting "H" + , ignoredSetting "inline" + , ignoredSetting "num" + , ignoredSetting "p" + , ignoredSetting "pri" + , ignoredSetting "prop" + , ignoredSetting "stat" + , ignoredSetting "tags" + , ignoredSetting "tasks" + , ignoredSetting "tex" + , ignoredSetting "timestamp" + , ignoredSetting "title" + , ignoredSetting "toc" + , ignoredSetting "todo" + , ignoredSetting "|" + ] "export setting" + +genericExportSetting :: OrgParser a + -> String + -> ExportSettingSetter a + -> OrgParser () +genericExportSetting optionParser settingIdentifier setter = try $ do + _ <- string settingIdentifier *> char ':' + value <- optionParser + updateState $ modifyExportSettings value + where + modifyExportSettings val st = + st { orgStateExportSettings = setter val . orgStateExportSettings $ st } + +-- | A boolean option, either nil (False) or non-nil (True). +booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () +booleanSetting = genericExportSetting elispBoolean + +-- | Either the string "headline" or an elisp boolean and treated as an +-- @ArchivedTreesOption@. +archivedTreeSetting :: String + -> ExportSettingSetter ArchivedTreesOption + -> OrgParser () +archivedTreeSetting = + genericExportSetting $ archivedTreesHeadlineSetting <|> archivedTreesBoolean + where + archivedTreesHeadlineSetting = try $ do + _ <- string "headline" + lookAhead (newline <|> spaceChar) + return ArchivedTreesHeadlineOnly + + archivedTreesBoolean = try $ do + exportBool <- elispBoolean + return $ + if exportBool + then ArchivedTreesExport + else ArchivedTreesNoExport + +-- | A list or a complement list (i.e. a list starting with `not`). +complementableListSetting :: String + -> ExportSettingSetter (Either [String] [String]) + -> OrgParser () +complementableListSetting = genericExportSetting $ choice + [ Left <$> complementStringList + , Right <$> stringList + , (\b -> if b then Left [] else Right []) <$> elispBoolean + ] + 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 '"') + +-- | Read but ignore the export setting. +ignoredSetting :: String -> OrgParser () +ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar) + +-- | 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 diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 93be92ae8..19524960b 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -40,16 +40,8 @@ module Text.Pandoc.Readers.Org.ParserState , trimInlinesF , runF , returnF - , ExportSettingSetter , ExportSettings (..) , ArchivedTreesOption (..) - , setExportArchivedTrees - , setExportDrawers - , setExportEmphasizedText - , setExportSmartQuotes - , setExportSpecialStrings - , setExportSubSuperscripts - , modifyExportSettings , optionsToParserState ) where @@ -80,26 +72,6 @@ type OrgNoteTable = [OrgNoteRecord] -- link-type, the corresponding function transforms the given link string. type OrgLinkFormatters = M.Map String (String -> String) --- | Options for the way archived trees are handled. -data ArchivedTreesOption = - ArchivedTreesExport -- ^ Export the complete tree - | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting - | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents - --- | Export settings --- These settings can be changed via OPTIONS statements. -data ExportSettings = ExportSettings - { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees - , 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. - , exportEmphasizedText :: Bool -- ^ Parse emphasized text - , exportSmartQuotes :: Bool -- ^ Parse quotes smartly - , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly - , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts - } - -- | Org-mode parser state data OrgParserState = OrgParserState { orgStateAnchorIds :: [String] @@ -142,9 +114,6 @@ instance HasHeaderMap OrgParserState where extractHeaderMap = orgStateHeaderMap updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) } -instance Default ExportSettings where - def = defaultExportSettings - instance Default OrgParserState where def = defaultOrgParserState @@ -166,60 +135,46 @@ defaultOrgParserState = OrgParserState , orgStateParserContext = NullState } -defaultExportSettings :: ExportSettings -defaultExportSettings = ExportSettings - { exportArchivedTrees = ArchivedTreesHeadlineOnly - , exportDrawers = Left ["LOGBOOK"] - , exportEmphasizedText = True - , exportSmartQuotes = True - , exportSpecialStrings = True - , exportSubSuperscripts = True - } - optionsToParserState :: ReaderOptions -> OrgParserState optionsToParserState opts = def { orgStateOptions = opts } - -- --- Setter for exporting options +-- Export Settings -- --- This whole section could be scraped if we were using lenses. - -type ExportSettingSetter a = a -> ExportSettings -> ExportSettings - --- | Set export options for archived trees. -setExportArchivedTrees :: ExportSettingSetter ArchivedTreesOption -setExportArchivedTrees val es = es { exportArchivedTrees = 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 } - --- | Set export options for emphasis parsing. -setExportEmphasizedText :: ExportSettingSetter Bool -setExportEmphasizedText val es = es { exportEmphasizedText = val } - --- | Set export options for parsing of smart quotes. -setExportSmartQuotes :: ExportSettingSetter Bool -setExportSmartQuotes val es = es { exportSmartQuotes = val } +-- | Options for the way archived trees are handled. +data ArchivedTreesOption = + ArchivedTreesExport -- ^ Export the complete tree + | ArchivedTreesNoExport -- ^ Exclude archived trees from exporting + | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents --- | Set export options for parsing of special strings (like em/en dashes or --- ellipses). -setExportSpecialStrings :: ExportSettingSetter Bool -setExportSpecialStrings val es = es { exportSpecialStrings = val } +-- | Export settings +-- These settings can be changed via OPTIONS statements. +data ExportSettings = ExportSettings + { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees + , 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. + , exportEmphasizedText :: Bool -- ^ Parse emphasized text + , exportSmartQuotes :: Bool -- ^ Parse quotes smartly + , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly + , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts + } --- | 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 } +instance Default ExportSettings where + def = defaultExportSettings --- | Modify a parser state -modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState -modifyExportSettings setter val state = - state { orgStateExportSettings = setter val . orgStateExportSettings $ state } +defaultExportSettings :: ExportSettings +defaultExportSettings = ExportSettings + { exportArchivedTrees = ArchivedTreesHeadlineOnly + , exportDrawers = Left ["LOGBOOK"] + , exportEmphasizedText = True + , exportSmartQuotes = True + , exportSpecialStrings = True + , exportSubSuperscripts = True + } -- -- cgit v1.2.3 From 5ffa4abf727779cee317aab81c143e3e2d3cb7d6 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 2 Jul 2016 10:52:49 +0200 Subject: Org reader: support headline levels export setting The depths of headlines can be modified using the `H` option. Deeper headlines will be converted to lists. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 33 ++++++++++++++++++++++----- src/Text/Pandoc/Readers/Org/ExportSettings.hs | 12 ++++++++-- src/Text/Pandoc/Readers/Org/ParserState.hs | 3 +++ tests/Tests/Readers/Org.hs | 12 ++++++++++ 4 files changed, 52 insertions(+), 8 deletions(-) (limited to 'src/Text/Pandoc/Readers') diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index af178d400..023afe6e1 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -111,7 +111,7 @@ headline lvl = try $ do newline properties <- option mempty propertiesDrawer contents <- blocks - children <- many (headline (lvl + 1)) + children <- many (headline (level + 1)) return $ do title' <- title contents' <- contents @@ -135,12 +135,14 @@ headline lvl = try $ do -- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks headlineToBlocks :: Headline -> OrgParser Blocks -headlineToBlocks hdln@(Headline {..}) = +headlineToBlocks hdln@(Headline {..}) = do + maxHeadlineLevels <- getExportSetting exportHeadlineLevels case () of - _ | any isNoExportTag headlineTags -> return mempty - _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln - _ | isCommentTitle headlineText -> return mempty - _ -> headlineToHeaderWithContents hdln + _ | any isNoExportTag headlineTags -> return mempty + _ | any isArchiveTag headlineTags -> archivedHeadlineToBlocks hdln + _ | isCommentTitle headlineText -> return mempty + _ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln + _ -> headlineToHeaderWithContents hdln isNoExportTag :: Tag -> Bool isNoExportTag = (== toTag "noexport") @@ -163,6 +165,25 @@ archivedHeadlineToBlocks hdln = do ArchivedTreesExport -> headlineToHeaderWithContents hdln ArchivedTreesHeadlineOnly -> headlineToHeader hdln +headlineToHeaderWithList :: Headline -> OrgParser Blocks +headlineToHeaderWithList hdln@(Headline {..}) = do + maxHeadlineLevels <- getExportSetting exportHeadlineLevels + header <- headlineToHeader hdln + listElements <- sequence (map headlineToBlocks headlineChildren) + let listBlock = if null listElements + then mempty + else B.orderedList listElements + let headerText = if maxHeadlineLevels == headlineLevel + then header + else flattenHeader header + return $ headerText <> headlineContents <> listBlock + where + flattenHeader :: Blocks -> Blocks + flattenHeader blks = + case B.toList blks of + (Header _ _ inlns:_) -> B.para (B.fromList inlns) + _ -> mempty + headlineToHeaderWithContents :: Headline -> OrgParser Blocks headlineToHeaderWithContents hdln@(Headline {..}) = do header <- headlineToHeader hdln diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs index 9f844c8dd..b48acc9c4 100644 --- a/src/Text/Pandoc/Readers/Org/ExportSettings.hs +++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs @@ -32,8 +32,9 @@ module Text.Pandoc.Readers.Org.ExportSettings import Text.Pandoc.Readers.Org.ParserState import Text.Pandoc.Readers.Org.Parsing -import Control.Monad ( void ) +import Control.Monad ( mzero, void ) import Data.Char ( toLower ) +import Data.Maybe ( listToMaybe ) -- | Read and handle space separated org-mode export settings. exportSettings :: OrgParser () @@ -61,7 +62,7 @@ exportSetting = choice , ignoredSetting "e" , ignoredSetting "email" , ignoredSetting "f" - , ignoredSetting "H" + , integerSetting "H" (\val es -> es { exportHeadlineLevels = val }) , ignoredSetting "inline" , ignoredSetting "num" , ignoredSetting "p" @@ -94,6 +95,13 @@ genericExportSetting optionParser settingIdentifier setter = try $ do booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser () booleanSetting = genericExportSetting elispBoolean +-- | An integer-valued option. +integerSetting :: String -> ExportSettingSetter Int -> OrgParser () +integerSetting = genericExportSetting parseInt + where + parseInt = try $ + many1 digit >>= maybe mzero (return . fst) . listToMaybe . reads + -- | Either the string "headline" or an elisp boolean and treated as an -- @ArchivedTreesOption@. archivedTreeSetting :: String diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 19524960b..48e7717cd 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -158,6 +158,8 @@ data ExportSettings = ExportSettings -- explicitly excluded from the resulting output while @Right@ means that -- only the listed drawer names should be included. , exportEmphasizedText :: Bool -- ^ Parse emphasized text + , exportHeadlineLevels :: Int + -- ^ Maximum depth of headlines, deeper headlines are convert to list , exportSmartQuotes :: Bool -- ^ Parse quotes smartly , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts @@ -171,6 +173,7 @@ defaultExportSettings = ExportSettings { exportArchivedTrees = ArchivedTreesHeadlineOnly , exportDrawers = Left ["LOGBOOK"] , exportEmphasizedText = True + , exportHeadlineLevels = 3 , exportSmartQuotes = True , exportSpecialStrings = True , exportSubSuperscripts = True diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs index f57858a55..fdd9bc6bf 100644 --- a/tests/Tests/Readers/Org.hs +++ b/tests/Tests/Readers/Org.hs @@ -611,6 +611,18 @@ tests = ] =?> let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE") + + , "Export option: limit headline depth" =: + unlines [ "#+OPTIONS: H:2" + , "* section" + , "** subsection" + , "*** list item 1" + , "*** list item 2" + ] =?> + mconcat [ headerWith ("section", [], []) 1 "section" + , headerWith ("subsection", [], []) 2 "subsection" + , orderedList [ para "list item 1", para "list item 2" ] + ] ] , testGroup "Basic Blocks" $ -- cgit v1.2.3