From 71bd4fb2b3778d3906a63938625ebcadca40b8c8 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <tarleb@moltkeplatz.de>
Date: Mon, 5 May 2014 14:39:25 +0200
Subject: Org reader: Read inline code blocks

Org's inline code blocks take forms like `src_haskell(print "hi")` and
are frequently used to include results from computations called from
within the document.  The blocks are read as inline code and marked with
the special class `rundoc-block`.  Proper handling and execution of
these blocks is the subject of a separate library, rundoc, which is
work in progress.

This closes #1278.
---
 src/Text/Pandoc/Readers/Org.hs | 43 +++++++++++++++++++++++++++++++++++++++---
 tests/Tests/Readers/Org.hs     | 18 ++++++++++++++++++
 2 files changed, 58 insertions(+), 3 deletions(-)

diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs
index d68ef45ef..dba61dfe0 100644
--- a/src/Text/Pandoc/Readers/Org.hs
+++ b/src/Text/Pandoc/Readers/Org.hs
@@ -43,6 +43,7 @@ import           Text.Pandoc.Shared (compactify', compactify'DL)
 
 import           Control.Applicative ( Applicative, pure
                                      , (<$>), (<$), (<*>), (<*), (*>), (<**>) )
+import           Control.Arrow (first)
 import           Control.Monad (foldM, guard, liftM, liftM2, mzero, when)
 import           Control.Monad.Reader (Reader, runReader, ask, asks)
 import           Data.Char (isAlphaNum, toLower)
@@ -721,7 +722,6 @@ bulletList = fmap B.bulletList . fmap compactify' . sequence
              <$> many1 (listItem bulletListStart)
 
 orderedList :: OrgParser (F Blocks)
--- orderedList = B.orderedList . compactify' <$> many1 (listItem orderedListStart)
 orderedList = fmap B.orderedList . fmap compactify' . sequence
               <$> many1 (listItem orderedListStart)
 
@@ -746,11 +746,11 @@ definitionListItem :: OrgParser Int
 definitionListItem parseMarkerGetLength = try $ do
   markerLength <- parseMarkerGetLength
   term <- manyTill (noneOf "\n\r") (try $ string "::")
-  first <- anyLineNewline
+  line1 <- anyLineNewline
   blank <- option "" ("\n" <$ blankline)
   cont <- concat <$> many (listContinuation markerLength)
   term' <- parseFromString inline term
-  contents' <- parseFromString parseBlocks $ first ++ blank ++ cont
+  contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont
   return $ (,) <$> term' <*> fmap (:[]) contents'
 
 
@@ -789,6 +789,7 @@ inline =
          , footnote
          , linkOrImage
          , anchor
+         , inlineCodeBlock
          , str
          , endline
          , emph
@@ -989,6 +990,42 @@ solidify = map replaceSpecialChar
            | c `elem` "_.-:" = c
            | otherwise       = '-'
 
+-- | Parses an inline code block and marks it as an babel block.
+inlineCodeBlock :: OrgParser (F Inlines)
+inlineCodeBlock = try $ do
+  string "src_"
+  lang <- many1 orgArgWordChar
+  opts <- option [] $ enclosedByPair '[' ']' blockOption
+  inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")
+  let attrClasses = [translateLang lang, rundocBlockClass]
+  let attrKeyVal  = map toRundocAttrib (("language", lang) : opts)
+  returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
+ where enclosedByPair s e p = char s *> many1Till p (char e)
+
+-- | The class-name used to mark rundoc blocks.
+rundocBlockClass :: String
+rundocBlockClass = "rundoc-block"
+
+blockOption :: OrgParser (String, String)
+blockOption = try $ (,) <$> orgArgKey <*> orgArgValue
+
+orgArgKey :: OrgParser String
+orgArgKey = try $
+  skipSpaces *> char ':'
+             *> many1 orgArgWordChar
+             <* many1 spaceChar
+
+orgArgValue :: OrgParser String
+orgArgValue = try $
+  skipSpaces *> many1 orgArgWordChar
+             <* skipSpaces
+
+orgArgWordChar :: OrgParser Char
+orgArgWordChar = alphaNum <|> oneOf "-_"
+
+toRundocAttrib :: (String, String) -> (String, String)
+toRundocAttrib = first ("rundoc-" ++)
+
 emph      :: OrgParser (F Inlines)
 emph      = fmap B.emph         <$> emphasisBetween '/'
 
diff --git a/tests/Tests/Readers/Org.hs b/tests/Tests/Readers/Org.hs
index 78684f0f1..949976aba 100644
--- a/tests/Tests/Readers/Org.hs
+++ b/tests/Tests/Readers/Org.hs
@@ -207,6 +207,24 @@ tests =
           "<<anchor>> Link here later." =?>
           (para $ spanWith ("anchor", [], []) mempty <>
                   "Link" <> space <> "here" <> space <> "later.")
+
+      , "Inline code block" =:
+          "src_emacs-lisp{(message \"Hello\")}" =?>
+          (para $ codeWith ( ""
+                           , [ "commonlisp", "rundoc-block" ]
+                           , [ ("rundoc-language", "emacs-lisp") ])
+                           "(message \"Hello\")")
+
+      , "Inline code block with arguments" =:
+          "src_sh[:export both :results output]{echo 'Hello, World'}" =?>
+          (para $ codeWith ( ""
+                           , [ "bash", "rundoc-block" ]
+                           , [ ("rundoc-language", "sh")
+                             , ("rundoc-export", "both")
+                             , ("rundoc-results", "output")
+                             ]
+                           )
+                           "echo 'Hello, World'")
       ]
 
   , testGroup "Meta Information" $
-- 
cgit v1.2.3