From 5ffa4abf727779cee317aab81c143e3e2d3cb7d6 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
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 +++
 3 files changed, 40 insertions(+), 8 deletions(-)

(limited to 'src/Text/Pandoc')

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
-- 
cgit v1.2.3