Merge pull request #1435 from bosmacs/org-babel-exports

Org reader: Respect :exports header arguments on code blocks

1 files changed, 27 insertions, 5 deletions

diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index 7a35e2ca0..41ba5c1a6 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -341,14 +341,36 @@ verseBlock blkProp = try $ do
   fmap B.para . mconcat . intersperse (pure B.linebreak)
     <$> mapM (parseFromString parseInlines) (lines content)
 
+exportsCode :: [(String, String)] -> Bool
+exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs
+                         || ("rundoc-exports", "results") `elem` attrs)
+
+exportsResults :: [(String, String)] -> Bool
+exportsResults attrs = ("rundoc-exports", "results") `elem` attrs
+                       || ("rundoc-exports", "both") `elem` attrs
+
+followingResultsBlock :: OrgParser (Maybe String)
+followingResultsBlock =
+       optionMaybe (try $ blanklines *> stringAnyCase "#+RESULTS:"
+                                     *> blankline
+                                     *> (unlines <$> many1 exampleLine))
+
 codeBlock :: BlockProperties -> OrgParser (F Blocks)
 codeBlock blkProp = do
   skipSpaces
-  (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
-  id'           <- fromMaybe "" <$> lookupBlockAttribute "name"
-  content       <- rawBlockContent blkProp
-  let codeBlck  = B.codeBlockWith ( id', classes, kv ) content
-  maybe (pure codeBlck) (labelDiv codeBlck) <$> lookupInlinesAttr "caption"
+  (classes, kv)     <- codeHeaderArgs <|> (mempty <$ ignHeaders)
+  id'               <- fromMaybe "" <$> lookupBlockAttribute "name"
+  content           <- rawBlockContent blkProp
+  resultsContent    <- followingResultsBlock
+  let includeCode    = exportsCode kv
+  let includeResults = exportsResults kv
+  let codeBlck       = B.codeBlockWith ( id', classes, kv ) content
+  labelledBlck      <- maybe (pure codeBlck)
+                             (labelDiv codeBlck)
+                             <$> lookupInlinesAttr "caption"
+  let resultBlck     = pure $ maybe mempty (exampleCode) resultsContent
+  return $ (if includeCode then labelledBlck else mempty)
+           <> (if includeResults then resultBlck else mempty)
  where
    labelDiv blk value =
        B.divWith nullAttr <$> (mappend <$> labelledBlock value