From 7852cd560398f0da22783b51fe21db4dc3eb0a54 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 31 May 2017 20:01:04 +0200 Subject: 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 | 38 ++++++++++++++---------------- src/Text/Pandoc/Readers/Org/Meta.hs | 6 +++-- test/command/3706.md | 44 +++++++++++++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 22 deletions(-) create mode 100644 test/command/3706.md diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 88ecbacd3..b650721b3 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/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)]) diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs index 5dc742403..33c212bca 100644 --- a/src/Text/Pandoc/Readers/Org/Meta.hs +++ b/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") diff --git a/test/command/3706.md b/test/command/3706.md new file mode 100644 index 000000000..00f53279e --- /dev/null +++ b/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 +[] +``` -- cgit v1.2.3