Org reader: modify handling of example blocks. (#5717)

* Org reader: allow the `-i` switch to ignore leading spaces.

* Org reader: handle awkwardly-aligned code blocks within lists.

Code blocks in Org lists must have their #+BEGIN_ aligned in a
reasonable way, but their other components can be positioned otherwise.

2 files changed, 43 insertions, 14 deletions

diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 8ee9c025d..cba876f06 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -186,7 +186,7 @@ orgBlock = try $ do
       "html"    -> rawBlockLines (return . B.rawBlock (lowercase blkType))
       "latex"   -> rawBlockLines (return . B.rawBlock (lowercase blkType))
       "ascii"   -> rawBlockLines (return . B.rawBlock (lowercase blkType))
-      "example" -> rawBlockLines (return . exampleCode)
+      "example" -> exampleBlock blockAttrs
       "quote"   -> parseBlockLines (fmap B.blockQuote)
       "verse"   -> verseBlock
       "src"     -> codeBlock blockAttrs
@@ -200,6 +200,16 @@ orgBlock = try $ do
    lowercase :: String -> String
    lowercase = map toLower
 
+exampleBlock :: PandocMonad m => BlockAttributes -> String -> OrgParser m (F Blocks)
+exampleBlock blockAttrs _label = do
+  skipSpaces
+  (classes, kv) <- switchesAsAttributes
+  newline
+  content <- rawBlockContent "example"
+  let id' = fromMaybe mempty $ blockAttrName blockAttrs
+  let codeBlck = B.codeBlockWith (id', "example":classes, kv) content
+  return . return $ codeBlck
+
 rawBlockLines :: Monad m => (String   -> F Blocks) -> String -> OrgParser m (F Blocks)
 rawBlockLines f blockType = ignHeaders *> (f <$> rawBlockContent blockType)
 
@@ -216,11 +226,13 @@ rawBlockContent :: Monad m => String -> OrgParser m String
 rawBlockContent blockType = try $ do
   blkLines <- manyTill rawLine blockEnder
   tabLen <- getOption readerTabStop
-  return
-    . unlines
-    . stripIndent
-    . map (tabsToSpaces tabLen . commaEscaped)
-    $ blkLines
+  trimP <- orgStateTrimLeadBlkIndent <$> getState
+  let stripIndent strs = if trimP then map (drop (shortestIndent strs)) strs else strs
+  (unlines
+   . stripIndent
+   . map (tabsToSpaces tabLen . commaEscaped)
+   $ blkLines)
+   <$ updateState (\s -> s { orgStateTrimLeadBlkIndent = True })
  where
    rawLine :: Monad m => OrgParser m String
    rawLine = try $ ("" <$ blankline) <|> anyLine
@@ -228,9 +240,6 @@ rawBlockContent blockType = try $ do
    blockEnder :: Monad m => OrgParser m ()
    blockEnder = try $ skipSpaces <* stringAnyCase ("#+end_" <> blockType)
 
-   stripIndent :: [String] -> [String]
-   stripIndent strs = map (drop (shortestIndent strs)) strs
-
    shortestIndent :: [String] -> Int
    shortestIndent = foldr (min . length . takeWhile isSpace) maxBound
                     . filter (not . null)
@@ -357,12 +366,19 @@ switchPolarity = (SwitchMinus <$ char '-') <|> (SwitchPlus <$ char '+')
 
 -- | Parses a source block switch option.
 switch :: Monad m => OrgParser m (Char, Maybe String, SwitchPolarity)
-switch = try $ lineNumberSwitch <|> labelSwitch <|> simpleSwitch
+switch = try $ lineNumberSwitch <|> labelSwitch
+               <|> whitespaceSwitch <|> simpleSwitch
  where
    simpleSwitch = (\pol c -> (c, Nothing, pol)) <$> switchPolarity <*> letter
    labelSwitch = genericSwitch 'l' $
      char '"' *> many1Till nonspaceChar (char '"')
 
+whitespaceSwitch :: Monad m => OrgParser m (Char, Maybe String, SwitchPolarity)
+whitespaceSwitch = do
+  string "-i"
+  updateState $ \s -> s { orgStateTrimLeadBlkIndent = False }
+  return ('i', Nothing, SwitchMinus)
+
 -- | Generic source block switch-option parser.
 genericSwitch :: Monad m
               => Char
@@ -821,11 +837,22 @@ listItem parseIndentedMarker = try . withContext ListItemState $ do
 
 -- continuation of a list item - indented and separated by blankline or endline.
 -- Note: nested lists are parsed as continuations.
-listContinuation :: Monad m => Int
-                 -> OrgParser m String
+listContinuation :: PandocMonad m => Int -> OrgParser m String
 listContinuation markerLength = try $ do
   notFollowedBy' blankline
-  mappend <$> (concat <$> many1 listLine)
+  mappend <$> (concat <$> many1 (listContinuation' markerLength))
           <*> many blankline
  where
-   listLine = try $ indentWith markerLength *> anyLineNewline
+   listContinuation' indentation =
+      blockLines indentation <|> listLine indentation
+   listLine indentation = try $ indentWith indentation *> anyLineNewline
+  -- The block attributes and start must be appropriately indented,
+  -- but the contents, and end do not.
+   blockLines indentation =
+      try $ lookAhead (indentWith indentation
+                       >> blockAttributes
+                       >>= (\blockAttrs ->
+                              case attrFromBlockAttributes blockAttrs of
+                                ("", [], []) -> count 1 anyChar
+                                _ -> indentWith indentation))
+            >> (snd <$> withRaw orgBlock)
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index 374741893..d6dde8b22 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -117,6 +117,7 @@ data OrgParserState = OrgParserState
   , orgStateSelectTags           :: Set.Set Tag
   , orgStateSelectTagsChanged    :: Bool
   , orgStateTodoSequences        :: [TodoSequence]
+  , orgStateTrimLeadBlkIndent    :: Bool
   , orgLogMessages               :: [LogMessage]
   , orgMacros                    :: M.Map Text Macro
   }
@@ -184,6 +185,7 @@ defaultOrgParserState = OrgParserState
   , orgStateParserContext = NullState
   , orgStateSelectTags = Set.singleton $ Tag "export"
   , orgStateSelectTagsChanged = False
+  , orgStateTrimLeadBlkIndent = True
   , orgStateTodoSequences = []
   , orgLogMessages = []
   , orgMacros = M.empty