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

Org reader: Respect :exports header arguments on code blocks

2 files changed, 87 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
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index f8240ca3d..d56b57a94 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -886,6 +886,66 @@ tests =
                                , "       (+ 23 42))" ]
            in codeBlockWith ("", classes, params) code'
 
+      , "Source block with results and :exports both" =:
+           unlines [ "#+BEGIN_SRC emacs-lisp :exports both"
+                   , "(progn (message \"Hello, World!\")"
+                   , "       (+ 23 42))"
+                   , "#+END_SRC"
+                   , ""
+                   , "#+RESULTS:"
+                   , ": 65"] =?>
+           let classes = [ "commonlisp"  -- as kate doesn't know emacs-lisp syntax
+                         , "rundoc-block"
+                         ]
+               params = [ ("rundoc-language", "emacs-lisp")
+                        , ("rundoc-exports", "both")
+                        ]
+               code' = unlines [ "(progn (message \"Hello, World!\")"
+                               , "       (+ 23 42))" ]
+               results' = "65\n"
+           in codeBlockWith ("", classes, params) code'
+              <>
+              codeBlockWith ("", ["example"], []) results'
+
+      , "Source block with results and :exports code" =:
+           unlines [ "#+BEGIN_SRC emacs-lisp :exports code"
+                   , "(progn (message \"Hello, World!\")"
+                   , "       (+ 23 42))"
+                   , "#+END_SRC"
+                   , ""
+                   , "#+RESULTS:"
+                   , ": 65" ] =?>
+           let classes = [ "commonlisp"  -- as kate doesn't know emacs-lisp syntax
+                         , "rundoc-block"
+                         ]
+               params = [ ("rundoc-language", "emacs-lisp")
+                        , ("rundoc-exports", "code")
+                        ]
+               code' = unlines [ "(progn (message \"Hello, World!\")"
+                               , "       (+ 23 42))" ]
+           in codeBlockWith ("", classes, params) code'
+
+      , "Source block with results and :exports results" =:
+           unlines [ "#+BEGIN_SRC emacs-lisp :exports results"
+                   , "(progn (message \"Hello, World!\")"
+                   , "       (+ 23 42))"
+                   , "#+END_SRC"
+                   , ""
+                   , "#+RESULTS:"
+                   , ": 65" ] =?>
+           let results' = "65\n"
+           in codeBlockWith ("", ["example"], []) results'
+
+      , "Source block with results and :exports none" =:
+           unlines [ "#+BEGIN_SRC emacs-lisp :exports none"
+                   , "(progn (message \"Hello, World!\")"
+                   , "       (+ 23 42))"
+                   , "#+END_SRC"
+                   , ""
+                   , "#+RESULTS:"
+                   , ": 65" ] =?>
+           rawBlock "html" ""   
+
       , "Example block" =:
            unlines [ "#+begin_example"
                    , "A chosen representation of"