Org reader: recognize babel result blocks with attributes

Babel result blocks can have block attributes like captions and names.
Result blocks with attributes were not recognized and were parsed as
normal blocks without attributes.

Fixes: #3706

src/Text/Pandoc/Readers/Org/Blocks.hs

@@ -122,18 +122,18 @@ attrFromBlockAttributes (BlockAttributes{..}) =
     kv      = filter ((`notElem` ["id", "class"]) . fst) blockAttrKeyValues
   in (ident, classes, kv)
 
-stringyMetaAttribute :: Monad m => (String -> Bool) -> OrgParser m (String, String)
-stringyMetaAttribute attrCheck = try $ do
+stringyMetaAttribute :: Monad m => OrgParser m (String, String)
+stringyMetaAttribute = try $ do
   metaLineStart
   attrName <- map toUpper <$> many1Till nonspaceChar (char ':')
-  guard $ attrCheck attrName
   skipSpaces
-  attrValue <- anyLine
+  attrValue <- anyLine <|> ("" <$ newline)
   return (attrName, attrValue)
 
 blockAttributes :: PandocMonad m => OrgParser m BlockAttributes
 blockAttributes = try $ do
-  kv <- many (stringyMetaAttribute attrCheck)
+  kv <- many stringyMetaAttribute
+  guard $ all (attrCheck . fst) kv
   let caption = foldl' (appendValues "CAPTION") Nothing kv
   let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
   let name    = lookup "NAME" kv
@@ -150,13 +150,7 @@ blockAttributes = try $ do
            }
  where
    attrCheck :: String -> Bool
-   attrCheck attr =
-     case attr of
-       "NAME"      -> True
-       "LABEL"     -> True
-       "CAPTION"   -> True
-       "ATTR_HTML" -> True
-       _           -> False
+   attrCheck x = x `elem` ["NAME", "LABEL", "CAPTION", "ATTR_HTML", "RESULTS"]
 
    appendValues :: String -> Maybe String -> (String, String) -> Maybe String
    appendValues attrName accValue (key, value) =
@@ -166,6 +160,7 @@ blockAttributes = try $ do
             Just acc -> Just $ acc ++ ' ':value
             Nothing  -> Just value
 
+-- | Parse key-value pairs for HTML attributes
 keyValues :: Monad m => OrgParser m [(String, String)]
 keyValues = try $
   manyTill ((,) <$> key <*> value) newline
@@ -301,16 +296,15 @@ codeBlock blockAttrs blockType = do
   skipSpaces
   (classes, kv)     <- codeHeaderArgs <|> (mempty <$ ignHeaders)
   content           <- rawBlockContent blockType
-  resultsContent    <- trailingResultsBlock
+  resultsContent    <- option mempty babelResultsBlock
   let id'            = fromMaybe mempty $ blockAttrName blockAttrs
   let codeBlck       = B.codeBlockWith ( id', classes, kv ) content
   let labelledBlck   = maybe (pure codeBlck)
                              (labelDiv codeBlck)
                              (blockAttrCaption blockAttrs)
-  let resultBlck     = fromMaybe mempty resultsContent
   return $
-    (if exportsCode kv    then labelledBlck else mempty) <>
-    (if exportsResults kv then resultBlck   else mempty)
+    (if exportsCode kv    then labelledBlck   else mempty) <>
+    (if exportsResults kv then resultsContent else mempty)
  where
    labelDiv :: Blocks -> F Inlines -> F Blocks
    labelDiv blk value =
@@ -325,12 +319,16 @@ codeBlock blockAttrs blockType = do
    exportsResults :: [(String, String)] -> Bool
    exportsResults = maybe False (`elem` ["results", "both"]) . lookup "exports"
 
-trailingResultsBlock :: PandocMonad m => OrgParser m (Maybe (F Blocks))
-trailingResultsBlock = optionMaybe . try $ do
+-- | Parse the result of an evaluated babel code block.
+babelResultsBlock :: PandocMonad m => OrgParser m (F Blocks)
+babelResultsBlock = try $ do
   blanklines
-  stringAnyCase "#+RESULTS:"
-  blankline
+  resultsMarker <|>
+    (lookAhead . void . try $
+      manyTill (metaLineStart *> anyLineNewline) resultsMarker)
   block
+ where
+  resultsMarker = try . void $ stringAnyCase "#+RESULTS:" *> blankline
 
 -- | Parse code block arguments
 codeHeaderArgs :: Monad m => OrgParser m ([String], [(String, String)])

src/Text/Pandoc/Readers/Org/Meta.hs

@@ -44,7 +44,7 @@ import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Definition
 
-import Control.Monad (mzero, void)
+import Control.Monad (mzero, void, when)
 import Data.Char (toLower)
 import Data.List (intersperse)
 import qualified Data.Map as M
@@ -75,7 +75,9 @@ declarationLine :: PandocMonad m => OrgParser m ()
 declarationLine = try $ do
   key   <- map toLower <$> metaKey
   (key', value) <- metaValue key
-  updateState $ \st -> st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
+  when (key' /= "results") $
+    updateState $ \st ->
+      st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
 
 metaKey :: Monad m => OrgParser m String
 metaKey = map toLower <$> many1 (noneOf ": \n\r")

test/command/3706.md

@@ -0,0 +1,44 @@
+Results marker can be hidden in block attributes (#3706)
+
+```
+pandoc -f org -t native
+#+BEGIN_SRC R :exports results :colnames yes
+   data.frame(Id = 1:3, Desc = rep("La",3))
+#+END_SRC
+
+#+CAPTION: Lalelu.
+#+LABEL: tab
+#+RESULTS:
+| Id | Desc |
+|----+------|
+|  1 | La   |
+|  2 | La   |
+|  3 | La   |
+^D
+[Table [Str "Lalelu."] [AlignDefault,AlignDefault] [0.0,0.0]
+ [[Plain [Str "Id"]]
+ ,[Plain [Str "Desc"]]]
+ [[[Plain [Str "1"]]
+  ,[Plain [Str "La"]]]
+ ,[[Plain [Str "2"]]
+  ,[Plain [Str "La"]]]
+ ,[[Plain [Str "3"]]
+  ,[Plain [Str "La"]]]]]
+```
+
+```
+pandoc -f org -t native
+#+BEGIN_SRC R :exports none :colnames yes
+   data.frame(Id = 1:2, Desc = rep("La",2))
+#+END_SRC
+
+#+CAPTION: Lalelu.
+#+LABEL: tab
+#+RESULTS:
+| Id | Desc |
+|----+------|
+|  1 | La   |
+|  2 | La   |
+^D
+[]
+```