From 1bb4f0c497a352a12a546fd9f1dff570bdee4018 Mon Sep 17 00:00:00 2001
From: "Craig S. Bosma" <craig.bosma@gmail.com>
Date: Mon, 14 Jul 2014 19:14:46 -0500
Subject: Org reader: Respect :exports header arguments on code blocks

Adds support to the org reader for conditionally exporting either the code block,
results block immediately following, both, or neither, depending on the value
of the `:exports` header argument. If no such argument is supplied, the default
org behavior (for most languages) of exporting code is used.
---
 src/Text/Pandoc/Readers/Org.hs | 32 ++++++++++++++++++----
 tests/Tests/Readers/Org.hs     | 60 ++++++++++++++++++++++++++++++++++++++++++
 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"
-- 
cgit v1.2.3