git.iko.soy/typeable/pandoc
on master help sign in
Org reader: support minlevel option for includes

The level of headers in included files can be shifted to a higher level by specifying a minimum header level via the `:minlevel` parameter. E.g. `#+include: "tour.org" :minlevel 1` will shift the headers in tour.org such that the topmost headers become level 1 headers. Fixes: #4154

commite5c8b650041a270b58e2f72e18eb28a32f153954 authorAlbert Krewinkel <albert@zeitkraut.de> dateMon 25 Dec 2017, 23:31 (9 years ago) parent2d443ec
3 files changed+115−15
compare with master
unifiedsplit
pandoc.cabal+1 src/Text/Pandoc/Readers/Org/Blocks.hs+37−14 test/Tests/Readers/Org/Directive.hs+77−1
pandoc.cabal+1
@@ -606,6 +606,7 @@ test-suite test-pandoc
606606 pandoc-types >= 1.17.3 && < 1.18,
607607 bytestring >= 0.9 && < 0.11,
608608 text >= 0.11 && < 1.3,
609+ time >= 1.5 && < 1.9,
609610 directory >= 1 && < 1.4,
610611 filepath >= 1.1 && < 1.5,
611612 hslua >= 0.9 && < 0.10,
src/Text/Pandoc/Readers/Org/Blocks.hs+37−14
@@ -41,7 +41,6 @@ import Text.Pandoc.Readers.Org.Shared (cleanLinkString, isImageFilename,
4141 originalLang, translateLang)
4242
4343import Text.Pandoc.Builder (Blocks, Inlines)
44−import qualified Text.Pandoc.Builder as B
4544import Text.Pandoc.Class (PandocMonad)
4645import Text.Pandoc.Definition
4746import Text.Pandoc.Options
@@ -54,6 +53,9 @@ import Data.List (foldl', isPrefixOf)
5453import Data.Maybe (fromMaybe, isJust, isNothing)
5554import Data.Monoid ((<>))
5655
56+import qualified Text.Pandoc.Builder as B
57+import qualified Text.Pandoc.Walk as Walk
58+
5759--
5860-- parsing blocks
5961--
@@ -509,19 +511,18 @@ include :: PandocMonad m => OrgParser m (F Blocks)
509511include = try $ do
510512 metaLineStart <* stringAnyCase "include:" <* skipSpaces
511513 filename <- includeTarget
512− blockType <- optionMaybe $ skipSpaces *> many1 alphaNum
513− blocksParser <- case blockType of
514− Just "example" ->
515− return $ pure . B.codeBlock <$> parseRaw
516− Just "export" -> do
517− format <- skipSpaces *> many (noneOf "\n\r\t ")
518− return $ pure . B.rawBlock format <$> parseRaw
519− Just "src" -> do
520− language <- skipSpaces *> many (noneOf "\n\r\t ")
521− let attr = (mempty, [language], mempty)
522− return $ pure . B.codeBlockWith attr <$> parseRaw
523− _ -> return $ pure . B.fromList <$> blockList
524− anyLine
514+ includeArgs <- many (try $ skipSpaces *> many1 alphaNum)
515+ params <- keyValues
516+ blocksParser <- case includeArgs of
517+ ("example" : _) -> return $ pure . B.codeBlock <$> parseRaw
518+ ["export"] -> return . returnF $ B.fromList []
519+ ("export" : format : []) -> return $ pure . B.rawBlock format <$> parseRaw
520+ ("src" : rest) -> do
521+ let attr = case rest of
522+ [lang] -> (mempty, [lang], mempty)
523+ _ -> nullAttr
524+ return $ pure . B.codeBlockWith attr <$> parseRaw
525+ _ -> return $ return . B.fromList . blockFilter params <$> blockList
525526 insertIncludedFileF blocksParser ["."] filename
526527 where
527528 includeTarget :: PandocMonad m => OrgParser m FilePath
@@ -532,6 +533,28 @@ include = try $ do
532533 parseRaw :: PandocMonad m => OrgParser m String
533534 parseRaw = many anyChar
534535
536+ blockFilter :: [(String, String)] -> [Block] -> [Block]
537+ blockFilter params blks =
538+ let minlvl = lookup "minlevel" params
539+ in case (minlvl >>= safeRead :: Maybe Int) of
540+ Nothing -> blks
541+ Just lvl -> let levels = Walk.query headerLevel blks
542+ -- CAVE: partial function in else
543+ curMin = if null levels then 0 else minimum levels
544+ in Walk.walk (shiftHeader (curMin - lvl)) blks
545+
546+ headerLevel :: Block -> [Int]
547+ headerLevel (Header lvl _attr _content) = [lvl]
548+ headerLevel _ = []
549+
550+ shiftHeader :: Int -> Block -> Block
551+ shiftHeader shift blk =
552+ if shift <= 0
553+ then blk
554+ else case blk of
555+ (Header lvl attr content) -> Header (lvl - shift) attr content
556+ _ -> blk
557+
535558rawExportLine :: PandocMonad m => OrgParser m Blocks
536559rawExportLine = try $ do
537560 metaLineStart
test/Tests/Readers/Org/Directive.hs+77−1
@@ -1,13 +1,42 @@
11{-# LANGUAGE OverloadedStrings #-}
22module Tests.Readers.Org.Directive (tests) where
33
4+import Control.Arrow (second)
5+import Data.Time (UTCTime (UTCTime), secondsToDiffTime)
6+import Data.Time.Calendar (Day (ModifiedJulianDay))
47import Test.Tasty (TestTree, testGroup)
5−import Tests.Helpers ((=?>))
8+import Tests.Helpers ((=?>), ToString, purely, test)
69import Tests.Readers.Org.Shared ((=:), tagSpan)
710import Text.Pandoc
811import Text.Pandoc.Builder
12+import qualified Data.ByteString as BS
13+import qualified Data.Map as Map
914import qualified Data.Text as T
1015
16+testWithFiles :: (ToString c)
17+ => [(FilePath, BS.ByteString)]
18+ -> String -- ^ name of test case
19+ -> (T.Text, c) -- ^ (input, expected value)
20+ -> TestTree
21+testWithFiles fileDefs = test (orgWithFiles fileDefs)
22+ where
23+orgWithFiles :: [(FilePath, BS.ByteString)] -> T.Text -> Pandoc
24+orgWithFiles fileDefs input =
25+ let readOrg' = readOrg def{ readerExtensions = getDefaultExtensions "org" }
26+ in flip purely input $ \inp -> do
27+ modifyPureState (\st -> st { stFiles = files fileDefs })
28+ readOrg' inp
29+
30+
31+files :: [(FilePath, BS.ByteString)] -> FileTree
32+files fileDefs =
33+ let dummyTime = UTCTime (ModifiedJulianDay 125) (secondsToDiffTime 0)
34+ fileInfo content = FileInfo
35+ { infoFileMTime = dummyTime
36+ , infoFileContents = content
37+ }
38+ in FileTree (Map.fromList (map (second fileInfo) fileDefs))
39+
1140tests :: [TestTree]
1241tests =
1342 [ testGroup "export options"
@@ -125,4 +154,51 @@ tests =
125154 ] =?>
126155 headerWith ("headline", [], mempty) 1 "Headline"
127156 ]
157+
158+ , testGroup "Include"
159+ [ testWithFiles [("./other.org", "content of other file\n")]
160+ "file inclusion"
161+ (T.unlines [ "#+include: \"other.org\"" ] =?>
162+ plain "content of other file")
163+
164+ , testWithFiles [("./world.org", "World\n\n")]
165+ "Included file belongs to item"
166+ (T.unlines [ "- Hello,\n #+include: \"world.org\"" ] =?>
167+ bulletList [para "Hello," <> para "World"])
168+
169+ , testWithFiles [("./level3.org", "*** Level3\n\n")]
170+ "Default include preserves level"
171+ (T.unlines [ "#+include: \"level3.org\"" ] =?>
172+ headerWith ("level3", [], []) 3 "Level3")
173+
174+ , testWithFiles [("./level3.org", "*** Level3\n\n")]
175+ "Minlevel shifts level"
176+ (T.unlines [ "#+include: \"level3.org\" :minlevel 1" ] =?>
177+ headerWith ("level3", [], []) 1 "Level3")
178+
179+ , testWithFiles [("./src.hs", "putStrLn outString\n")]
180+ "Include file as source code snippet"
181+ (T.unlines [ "#+include: \"src.hs\" src haskell" ] =?>
182+ codeBlockWith ("", ["haskell"], []) "putStrLn outString\n")
183+
184+ , testWithFiles [("./export-latex.org", "\\emph{Hello}\n")]
185+ "Include file as export snippet"
186+ (T.unlines [ "#+include: \"export-latex.org\" export latex" ] =?>
187+ rawBlock "latex" "\\emph{Hello}\n")
188+
189+ , testWithFiles [("./subdir/foo-bar.latex", "foo\n"),
190+ ("./hello.lisp", "(print \"Hello!\")\n")
191+ ]
192+ "include directive is limited to one line"
193+ (T.unlines [ "#+INCLUDE: \"hello.lisp\" src lisp"
194+ , "#+include: \"subdir/foo-bar.latex\" export latex"
195+ , "bar"
196+ ] =?>
197+ mconcat
198+ [ codeBlockWith ("", ["lisp"], []) "(print \"Hello!\")\n"
199+ , rawBlock "latex" "foo\n"
200+ , para "bar"
201+ ]
202+ )
203+ ]
128204 ]