@@ -45,7 +45,7 @@ import Text.Pandoc.Shared ( compactify', compactify'DL )
4545
4646import Control.Arrow ( first )
4747import Control.Monad ( foldM, guard, mzero )
48−import Data.Char ( toLower, toUpper)
48+import Data.Char ( isSpace, toLower, toUpper)
4949import Data.List ( foldl', intersperse, isPrefixOf )
5050import qualified Data.Map as M
5151import Data.Maybe ( fromMaybe, isNothing )
@@ -161,85 +161,100 @@ keyValues = try $
161161-- Org Blocks (#+BEGIN_... / #+END_...)
162162--
163163
164−type BlockProperties = (Int, String) -- (Indentation, Block-Type)
165−
166−updateIndent :: BlockProperties -> Int -> BlockProperties
167−updateIndent (_, blkType) indent = (indent, blkType)
168−
164+-- | Read an org-mode block delimited by #+BEGIN_TYPE and #+END_TYPE.
169165orgBlock :: OrgParser (F Blocks)
170166orgBlock = try $ do
171167 blockAttrs <- blockAttributes
172− blockProp@(_, blkType) <- blockHeaderStart
173− ($ blockProp) $
168+ blkType <- blockHeaderStart
169+ ($ blkType) $
174170 case blkType of
175− "comment" -> withRaw' (const mempty)
176− "html" -> withRaw' (return . (B.rawBlock blkType))
177− "latex" -> withRaw' (return . (B.rawBlock blkType))
178− "ascii" -> withRaw' (return . (B.rawBlock blkType))
179− "example" -> withRaw' (return . exampleCode)
180− "quote" -> withParsed (fmap B.blockQuote)
171+ "comment" -> rawBlockLines (const mempty)
172+ "html" -> rawBlockLines (return . (B.rawBlock blkType))
173+ "latex" -> rawBlockLines (return . (B.rawBlock blkType))
174+ "ascii" -> rawBlockLines (return . (B.rawBlock blkType))
175+ "example" -> rawBlockLines (return . exampleCode)
176+ "quote" -> parseBlockLines (fmap B.blockQuote)
181177 "verse" -> verseBlock
182178 "src" -> codeBlock blockAttrs
183− _ -> withParsed (fmap $ divWithClass blkType)
184−
185−blockHeaderStart :: OrgParser (Int, String)
186−blockHeaderStart = try $ (,) <$> indentation <*> blockType
179+ _ -> parseBlockLines (fmap $ B.divWith (mempty, [blkType], mempty))
187180 where
188− blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)
181+ blockHeaderStart :: OrgParser String
182+ blockHeaderStart = try $ do
183+ skipSpaces
184+ blockType <- stringAnyCase "#+begin_" *> orgArgWord
185+ return (map toLower blockType)
189186
190−indentation :: OrgParser Int
191−indentation = try $ do
192− tabStop <- getOption readerTabStop
193− s <- many spaceChar
194− return $ spaceLength tabStop s
187+rawBlockLines :: (String -> F Blocks) -> String -> OrgParser (F Blocks)
188+rawBlockLines f blockType = (ignHeaders *> (f <$> rawBlockContent blockType))
195189
196−spaceLength :: Int -> String -> Int
197−spaceLength tabStop s = (sum . map charLen) s
190+parseBlockLines :: (F Blocks -> F Blocks) -> String -> OrgParser (F Blocks)
191+parseBlockLines f blockType = (ignHeaders *> (f <$> parsedBlockContent))
198192 where
199− charLen ' ' = 1
200− charLen '\t' = tabStop
201− charLen _ = 0
202−
203−withRaw' :: (String -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
204−withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))
205−
206−withParsed :: (F Blocks -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
207−withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))
208−
193+ parsedBlockContent :: OrgParser (F Blocks)
194+ parsedBlockContent = try $ do
195+ raw <- rawBlockContent blockType
196+ parseFromString blocks (raw ++ "\n")
197+
198+-- | Read the raw string content of a block
199+rawBlockContent :: String -> OrgParser String
200+rawBlockContent blockType = try $ do
201+ blkLines <- manyTill rawLine blockEnder
202+ tabLen <- getOption readerTabStop
203+ return
204+ . unlines
205+ . stripIndent
206+ . map (tabsToSpaces tabLen . commaEscaped)
207+ $ blkLines
208+ where
209+ rawLine :: OrgParser String
210+ rawLine = try $ ("" <$ blankline) <|> anyLine
211+
212+ blockEnder :: OrgParser ()
213+ blockEnder = try $ skipSpaces <* stringAnyCase ("#+end_" <> blockType)
214+
215+ stripIndent :: [String] -> [String]
216+ stripIndent strs = map (drop (shortestIndent strs)) strs
217+
218+ shortestIndent :: [String] -> Int
219+ shortestIndent = minimum
220+ . map (length . takeWhile isSpace)
221+ . filter (not . null)
222+
223+ tabsToSpaces :: Int -> String -> String
224+ tabsToSpaces _ [] = []
225+ tabsToSpaces tabLen cs'@(c:cs) =
226+ case c of
227+ ' ' -> ' ':tabsToSpaces tabLen cs
228+ '\t' -> (take tabLen $ repeat ' ') ++ tabsToSpaces tabLen cs
229+ _ -> cs'
230+
231+ commaEscaped :: String -> String
232+ commaEscaped (',':cs@('*':_)) = cs
233+ commaEscaped (',':cs@('#':'+':_)) = cs
234+ commaEscaped (' ':cs) = ' ':commaEscaped cs
235+ commaEscaped ('\t':cs) = '\t':commaEscaped cs
236+ commaEscaped cs = cs
237+
238+-- | Read but ignore all remaining block headers.
209239ignHeaders :: OrgParser ()
210240ignHeaders = (() <$ newline) <|> (() <$ anyLine)
211241
212−divWithClass :: String -> Blocks -> Blocks
213−divWithClass cls = B.divWith ("", [cls], [])
214−
215−verseBlock :: BlockProperties -> OrgParser (F Blocks)
216−verseBlock blkProp = try $ do
242+verseBlock :: String -> OrgParser (F Blocks)
243+verseBlock blockType = try $ do
217244 ignHeaders
218− content <- rawBlockContent blkProp
245+ content <- rawBlockContent blockType
219246 fmap B.para . mconcat . intersperse (pure B.linebreak)
220247 <$> mapM (parseFromString inlines) (map (++ "\n") . lines $ content)
221248
222−exportsCode :: [(String, String)] -> Bool
223−exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs
224− || ("rundoc-exports", "results") `elem` attrs)
225−
226−exportsResults :: [(String, String)] -> Bool
227−exportsResults attrs = ("rundoc-exports", "results") `elem` attrs
228− || ("rundoc-exports", "both") `elem` attrs
229−
230−followingResultsBlock :: OrgParser (Maybe (F Blocks))
231−followingResultsBlock =
232− optionMaybe (try $ blanklines *> stringAnyCase "#+RESULTS:"
233− *> blankline
234− *> block)
235−
236−codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks)
237−codeBlock blockAttrs blkProp = do
249+-- | Read a code block and the associated results block if present. Which of
250+-- boths blocks is included in the output is determined using the "exports"
251+-- argument in the block header.
252+codeBlock :: BlockAttributes -> String -> OrgParser (F Blocks)
253+codeBlock blockAttrs blockType = do
238254 skipSpaces
239255 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
240− leadingIndent <- lookAhead indentation
241− content <- rawBlockContent (updateIndent blkProp leadingIndent)
242− resultsContent <- followingResultsBlock
256+ content <- rawBlockContent blockType
257+ resultsContent <- trailingResultsBlock
243258 let id' = fromMaybe mempty $ blockAttrName blockAttrs
244259 let includeCode = exportsCode kv
245260 let includeResults = exportsResults kv
@@ -248,36 +263,31 @@ codeBlock blockAttrs blkProp = do
248263 (labelDiv codeBlck)
249264 (blockAttrCaption blockAttrs)
250265 let resultBlck = fromMaybe mempty resultsContent
251− return $ (if includeCode then labelledBlck else mempty)
252− <> (if includeResults then resultBlck else mempty)
266+ return $
267+ (if includeCode then labelledBlck else mempty) <>
268+ (if includeResults then resultBlck else mempty)
253269 where
270+ labelDiv :: Blocks -> F Inlines -> F Blocks
254271 labelDiv blk value =
255− B.divWith nullAttr <$> (mappend <$> labelledBlock value
256− <*> pure blk)
257− labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
272+ B.divWith nullAttr <$> (mappend <$> labelledBlock value <*> pure blk)
258273
259−rawBlockContent :: BlockProperties -> OrgParser String
260−rawBlockContent (indent, blockType) = try $
261− unlines . map commaEscaped <$> manyTill indentedLine blockEnder
262− where
263− indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)
264− blockEnder = try $ skipSpaces *> stringAnyCase ("#+end_" <> blockType)
274+ labelledBlock :: F Inlines -> F Blocks
275+ labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
265276
266−parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
267−parsedBlockContent blkProps = try $ do
268− raw <- rawBlockContent blkProps
269− parseFromString blocks (raw ++ "\n")
277+exportsCode :: [(String, String)] -> Bool
278+exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs
279+ || ("rundoc-exports", "results") `elem` attrs)
270280
271−-- indent by specified number of spaces (or equiv. tabs)
272−indentWith :: Int -> OrgParser String
273−indentWith num = do
274− tabStop <- getOption readerTabStop
275− if num < tabStop
276− then count num (char ' ')
277− else choice [ try (count num (char ' '))
278− , try (char '\t' >> count (num - tabStop) (char ' ')) ]
281+exportsResults :: [(String, String)] -> Bool
282+exportsResults attrs = ("rundoc-exports", "results") `elem` attrs
283+ || ("rundoc-exports", "both") `elem` attrs
279284
280−type SwitchOption = (Char, Maybe String)
285+trailingResultsBlock :: OrgParser (Maybe (F Blocks))
286+trailingResultsBlock = optionMaybe . try $ do
287+ blanklines
288+ stringAnyCase "#+RESULTS:"
289+ blankline
290+ block
281291
282292-- | Parse code block arguments
283293-- TODO: We currently don't handle switches.
@@ -297,8 +307,7 @@ codeHeaderArgs = try $ do
297307 hasRundocParameters = not . null
298308 toRundocAttrib = first ("rundoc-" ++)
299309
300−
301−switch :: OrgParser SwitchOption
310+switch :: OrgParser (Char, Maybe String)
302311switch = try $ simpleSwitch <|> lineNumbersSwitch
303312 where
304313 simpleSwitch = (\c -> (c, Nothing)) <$> (oneOf "-+" *> letter)
@@ -334,24 +343,9 @@ orgParamValue :: OrgParser String
334343orgParamValue = try $
335344 skipSpaces
336345 *> notFollowedBy (char ':' )
337− *> many1 (noneOf "\t\n\r ")
346+ *> many1 nonspaceChar
338347 <* skipSpaces
339348
340−commaEscaped :: String -> String
341−commaEscaped (',':cs@('*':_)) = cs
342−commaEscaped (',':cs@('#':'+':_)) = cs
343−commaEscaped cs = cs
344−
345−example :: OrgParser (F Blocks)
346−example = try $ do
347− return . return . exampleCode =<< unlines <$> many1 exampleLine
348−
349−exampleCode :: String -> Blocks
350−exampleCode = B.codeBlockWith ("", ["example"], [])
351−
352−exampleLine :: OrgParser String
353−exampleLine = try $ exampleLineStart *> anyLine
354−
355349horizontalRule :: OrgParser (F Blocks)
356350horizontalRule = return B.horizontalRule <$ try hline
357351
@@ -444,18 +438,26 @@ figure = try $ do
444438 selfTarget :: OrgParser String
445439 selfTarget = try $ char '[' *> linkTarget <* char ']'
446440
441+--
442+-- Examples
443+--
444+
445+-- | Example code marked up by a leading colon.
446+example :: OrgParser (F Blocks)
447+example = try $ do
448+ return . return . exampleCode =<< unlines <$> many1 exampleLine
449+ where
450+ exampleLine :: OrgParser String
451+ exampleLine = try $ exampleLineStart *> anyLine
452+
453+exampleCode :: String -> Blocks
454+exampleCode = B.codeBlockWith ("", ["example"], [])
455+
447456
448457--
449458-- Comments, Options and Metadata
450459--
451460
452−addLinkFormat :: String
453− -> (String -> String)
454− -> OrgParser ()
455−addLinkFormat key formatter = updateState $ \s ->
456− let fs = orgStateLinkFormatters s
457− in s{ orgStateLinkFormatters = M.insert key formatter fs }
458−
459461specialLine :: OrgParser (F Blocks)
460462specialLine = fmap return . try $ metaLine <|> commentLine
461463
@@ -492,6 +494,14 @@ optionLine = try $ do
492494 "options" -> () <$ sepBy spaces exportSetting
493495 _ -> mzero
494496
497+addLinkFormat :: String
498+ -> (String -> String)
499+ -> OrgParser ()
500+addLinkFormat key formatter = updateState $ \s ->
501+ let fs = orgStateLinkFormatters s
502+ in s{ orgStateLinkFormatters = M.insert key formatter fs }
503+
504+
495505--
496506-- Export Settings
497507--
@@ -884,7 +894,17 @@ listContinuation markerLength = try $
884894 notFollowedBy' blankline
885895 *> (mappend <$> (concat <$> many1 listLine)
886896 <*> many blankline)
887− where listLine = try $ indentWith markerLength *> anyLineNewline
897+ where
898+ listLine = try $ indentWith markerLength *> anyLineNewline
899+
900+ -- indent by specified number of spaces (or equiv. tabs)
901+ indentWith :: Int -> OrgParser String
902+ indentWith num = do
903+ tabStop <- getOption readerTabStop
904+ if num < tabStop
905+ then count num (char ' ')
906+ else choice [ try (count num (char ' '))
907+ , try (char '\t' >> count (num - tabStop) (char ' ')) ]
888908
889909-- | Parse any line, include the final newline in the output.
890910anyLineNewline :: OrgParser String