Ignore leading space in org code blocks

Fixes #2862

Also fix up tab handling for leading whitespace in code blocks.

src/Text/Pandoc/Readers/Org.hs

@@ -391,6 +391,9 @@ lookupBlockAttribute key =
 
 type BlockProperties = (Int, String)  -- (Indentation, Block-Type)
 
+updateIndent :: BlockProperties -> Int -> BlockProperties
+updateIndent (_, blkType) indent = (indent, blkType)
+
 orgBlock :: OrgParser (F Blocks)
 orgBlock = try $ do
   blockProp@(_, blkType) <- blockHeaderStart
@@ -407,11 +410,23 @@ orgBlock = try $ do
       _         -> withParsed (fmap $ divWithClass blkType)
 
 blockHeaderStart :: OrgParser (Int, String)
-blockHeaderStart = try $ (,) <$> indent <*> blockType
+blockHeaderStart = try $ (,) <$> indentation <*> blockType
  where
-  indent    = length      <$> many spaceChar
   blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)
 
+indentation :: OrgParser Int
+indentation = try $ do
+  tabStop  <- getOption readerTabStop
+  s        <- many spaceChar
+  return $ spaceLength tabStop s
+
+spaceLength :: Int -> String -> Int
+spaceLength tabStop s = (sum . map charLen) s
+ where
+  charLen ' '  = 1
+  charLen '\t' = tabStop
+  charLen _    = 0
+
 withRaw'   :: (String   -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
 withRaw'   f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))
 
@@ -450,7 +465,8 @@ codeBlock blkProp = do
   skipSpaces
   (classes, kv)     <- codeHeaderArgs <|> (mempty <$ ignHeaders)
   id'               <- fromMaybe "" <$> lookupBlockAttribute "name"
-  content           <- rawBlockContent blkProp
+  leadingIndent     <- lookAhead indentation
+  content           <- rawBlockContent (updateIndent blkProp leadingIndent)
   resultsContent    <- followingResultsBlock
   let includeCode    = exportsCode kv
   let includeResults = exportsResults kv
@@ -472,7 +488,7 @@ rawBlockContent (indent, blockType) = try $
   unlines . map commaEscaped <$> manyTill indentedLine blockEnder
  where
    indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)
-   blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
+   blockEnder = try $ skipSpaces *> stringAnyCase ("#+end_" <> blockType)
 
 parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
 parsedBlockContent blkProps = try $ do

tests/Tests/Readers/Org.hs

@@ -1054,6 +1054,33 @@ tests =
                        "  where greeting = \"moin\"\n"
            in codeBlockWith attr' code'
 
+      , "Source block with indented code" =:
+           unlines [ "  #+BEGIN_SRC haskell"
+                   , "    main = putStrLn greeting"
+                   , "      where greeting = \"moin\""
+                   , "  #+END_SRC" ] =?>
+           let attr' = ("", ["haskell"], [])
+               code' = "main = putStrLn greeting\n" ++
+                       "  where greeting = \"moin\"\n"
+           in codeBlockWith attr' code'
+
+      , "Source block with tab-indented code" =:
+           unlines [ "\t#+BEGIN_SRC haskell"
+                   , "\tmain = putStrLn greeting"
+                   , "\t  where greeting = \"moin\""
+                   , "\t#+END_SRC" ] =?>
+           let attr' = ("", ["haskell"], [])
+               code' = "main = putStrLn greeting\n" ++
+                       "  where greeting = \"moin\"\n"
+           in codeBlockWith attr' code'
+
+      , "Empty source block" =:
+           unlines [ "  #+BEGIN_SRC haskell"
+                   , "  #+END_SRC" ] =?>
+           let attr' = ("", ["haskell"], [])
+               code' = ""
+           in codeBlockWith attr' code'
+
       , "Source block between paragraphs" =:
            unlines [ "Low German greeting"
                    , "  #+BEGIN_SRC haskell"