@@ -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 )
@@ -116,7 +116,7 @@ blockAttributes = try $ do
116116 let kvAttrs = foldl' (appendValues "ATTR_HTML") Nothing kv
117117 let name = lookup "NAME" kv
118118 caption' <- maybe (return Nothing)
119− (fmap Just . parseFromString parseInlines)
119+ (fmap Just . parseFromString inlines)
120120 caption
121121 kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs
122122 return $ BlockAttributes
@@ -161,85 +161,109 @@ 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+ "export" -> exportBlock
172+ "comment" -> rawBlockLines (const mempty)
173+ "html" -> rawBlockLines (return . (B.rawBlock blkType))
174+ "latex" -> rawBlockLines (return . (B.rawBlock blkType))
175+ "ascii" -> rawBlockLines (return . (B.rawBlock blkType))
176+ "example" -> rawBlockLines (return . exampleCode)
177+ "quote" -> parseBlockLines (fmap B.blockQuote)
181178 "verse" -> verseBlock
182179 "src" -> codeBlock blockAttrs
183− _ -> withParsed (fmap $ divWithClass blkType)
184−
185−blockHeaderStart :: OrgParser (Int, String)
186−blockHeaderStart = try $ (,) <$> indentation <*> blockType
180+ _ -> parseBlockLines (fmap $ B.divWith (mempty, [blkType], mempty))
187181 where
188− blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)
182+ blockHeaderStart :: OrgParser String
183+ blockHeaderStart = try $ do
184+ skipSpaces
185+ blockType <- stringAnyCase "#+begin_" *> orgArgWord
186+ return (map toLower blockType)
189187
190−indentation :: OrgParser Int
191−indentation = try $ do
192− tabStop <- getOption readerTabStop
193− s <- many spaceChar
194− return $ spaceLength tabStop s
188+rawBlockLines :: (String -> F Blocks) -> String -> OrgParser (F Blocks)
189+rawBlockLines f blockType = (ignHeaders *> (f <$> rawBlockContent blockType))
195190
196−spaceLength :: Int -> String -> Int
197−spaceLength tabStop s = (sum . map charLen) s
191+parseBlockLines :: (F Blocks -> F Blocks) -> String -> OrgParser (F Blocks)
192+parseBlockLines f blockType = (ignHeaders *> (f <$> parsedBlockContent))
198193 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−
194+ parsedBlockContent :: OrgParser (F Blocks)
195+ parsedBlockContent = try $ do
196+ raw <- rawBlockContent blockType
197+ parseFromString blocks (raw ++ "\n")
198+
199+-- | Read the raw string content of a block
200+rawBlockContent :: String -> OrgParser String
201+rawBlockContent blockType = try $ do
202+ blkLines <- manyTill rawLine blockEnder
203+ tabLen <- getOption readerTabStop
204+ return
205+ . unlines
206+ . stripIndent
207+ . map (tabsToSpaces tabLen . commaEscaped)
208+ $ blkLines
209+ where
210+ rawLine :: OrgParser String
211+ rawLine = try $ ("" <$ blankline) <|> anyLine
212+
213+ blockEnder :: OrgParser ()
214+ blockEnder = try $ skipSpaces <* stringAnyCase ("#+end_" <> blockType)
215+
216+ stripIndent :: [String] -> [String]
217+ stripIndent strs = map (drop (shortestIndent strs)) strs
218+
219+ shortestIndent :: [String] -> Int
220+ shortestIndent = minimum
221+ . map (length . takeWhile isSpace)
222+ . filter (not . null)
223+
224+ tabsToSpaces :: Int -> String -> String
225+ tabsToSpaces _ [] = []
226+ tabsToSpaces tabLen cs'@(c:cs) =
227+ case c of
228+ ' ' -> ' ':tabsToSpaces tabLen cs
229+ '\t' -> (take tabLen $ repeat ' ') ++ tabsToSpaces tabLen cs
230+ _ -> cs'
231+
232+ commaEscaped :: String -> String
233+ commaEscaped (',':cs@('*':_)) = cs
234+ commaEscaped (',':cs@('#':'+':_)) = cs
235+ commaEscaped (' ':cs) = ' ':commaEscaped cs
236+ commaEscaped ('\t':cs) = '\t':commaEscaped cs
237+ commaEscaped cs = cs
238+
239+-- | Read but ignore all remaining block headers.
209240ignHeaders :: OrgParser ()
210241ignHeaders = (() <$ newline) <|> (() <$ anyLine)
211242
212−divWithClass :: String -> Blocks -> Blocks
213−divWithClass cls = B.divWith ("", [cls], [])
243+-- | Read a block containing code intended for export in specific backends
244+-- only.
245+exportBlock :: String -> OrgParser (F Blocks)
246+exportBlock blockType = try $ do
247+ exportType <- skipSpaces *> orgArgWord <* ignHeaders
248+ contents <- rawBlockContent blockType
249+ returnF (B.rawBlock (map toLower exportType) contents)
214250
215−verseBlock :: BlockProperties -> OrgParser (F Blocks)
216−verseBlock blkProp = try $ do
251+verseBlock :: String -> OrgParser (F Blocks)
252+verseBlock blockType = try $ do
217253 ignHeaders
218− content <- rawBlockContent blkProp
254+ content <- rawBlockContent blockType
219255 fmap B.para . mconcat . intersperse (pure B.linebreak)
220− <$> mapM (parseFromString parseInlines) (map (++ "\n") . lines $ content)
221−
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)
256+ <$> mapM (parseFromString inlines) (map (++ "\n") . lines $ content)
235257
236−codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks)
237−codeBlock blockAttrs blkProp = do
258+-- | Read a code block and the associated results block if present. Which of
259+-- boths blocks is included in the output is determined using the "exports"
260+-- argument in the block header.
261+codeBlock :: BlockAttributes -> String -> OrgParser (F Blocks)
262+codeBlock blockAttrs blockType = do
238263 skipSpaces
239264 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
240− leadingIndent <- lookAhead indentation
241− content <- rawBlockContent (updateIndent blkProp leadingIndent)
242− resultsContent <- followingResultsBlock
265+ content <- rawBlockContent blockType
266+ resultsContent <- trailingResultsBlock
243267 let id' = fromMaybe mempty $ blockAttrName blockAttrs
244268 let includeCode = exportsCode kv
245269 let includeResults = exportsResults kv
@@ -248,36 +272,31 @@ codeBlock blockAttrs blkProp = do
248272 (labelDiv codeBlck)
249273 (blockAttrCaption blockAttrs)
250274 let resultBlck = fromMaybe mempty resultsContent
251− return $ (if includeCode then labelledBlck else mempty)
252− <> (if includeResults then resultBlck else mempty)
275+ return $
276+ (if includeCode then labelledBlck else mempty) <>
277+ (if includeResults then resultBlck else mempty)
253278 where
279+ labelDiv :: Blocks -> F Inlines -> F Blocks
254280 labelDiv blk value =
255− B.divWith nullAttr <$> (mappend <$> labelledBlock value
256− <*> pure blk)
257− labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
281+ B.divWith nullAttr <$> (mappend <$> labelledBlock value <*> pure blk)
258282
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)
283+ labelledBlock :: F Inlines -> F Blocks
284+ labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
265285
266−parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
267−parsedBlockContent blkProps = try $ do
268− raw <- rawBlockContent blkProps
269− parseFromString blocks (raw ++ "\n")
286+exportsCode :: [(String, String)] -> Bool
287+exportsCode attrs = not (("rundoc-exports", "none") `elem` attrs
288+ || ("rundoc-exports", "results") `elem` attrs)
270289
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 ' ')) ]
290+exportsResults :: [(String, String)] -> Bool
291+exportsResults attrs = ("rundoc-exports", "results") `elem` attrs
292+ || ("rundoc-exports", "both") `elem` attrs
279293
280−type SwitchOption = (Char, Maybe String)
294+trailingResultsBlock :: OrgParser (Maybe (F Blocks))
295+trailingResultsBlock = optionMaybe . try $ do
296+ blanklines
297+ stringAnyCase "#+RESULTS:"
298+ blankline
299+ block
281300
282301-- | Parse code block arguments
283302-- TODO: We currently don't handle switches.
@@ -297,8 +316,7 @@ codeHeaderArgs = try $ do
297316 hasRundocParameters = not . null
298317 toRundocAttrib = first ("rundoc-" ++)
299318
300−
301−switch :: OrgParser SwitchOption
319+switch :: OrgParser (Char, Maybe String)
302320switch = try $ simpleSwitch <|> lineNumbersSwitch
303321 where
304322 simpleSwitch = (\c -> (c, Nothing)) <$> (oneOf "-+" *> letter)
@@ -334,24 +352,9 @@ orgParamValue :: OrgParser String
334352orgParamValue = try $
335353 skipSpaces
336354 *> notFollowedBy (char ':' )
337− *> many1 (noneOf "\t\n\r ")
355+ *> many1 nonspaceChar
338356 <* skipSpaces
339357
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−
355358horizontalRule :: OrgParser (F Blocks)
356359horizontalRule = return B.horizontalRule <$ try hline
357360
@@ -444,18 +447,26 @@ figure = try $ do
444447 selfTarget :: OrgParser String
445448 selfTarget = try $ char '[' *> linkTarget <* char ']'
446449
450+--
451+-- Examples
452+--
453+
454+-- | Example code marked up by a leading colon.
455+example :: OrgParser (F Blocks)
456+example = try $ do
457+ return . return . exampleCode =<< unlines <$> many1 exampleLine
458+ where
459+ exampleLine :: OrgParser String
460+ exampleLine = try $ exampleLineStart *> anyLine
461+
462+exampleCode :: String -> Blocks
463+exampleCode = B.codeBlockWith ("", ["example"], [])
464+
447465
448466--
449467-- Comments, Options and Metadata
450468--
451469
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−
459470specialLine :: OrgParser (F Blocks)
460471specialLine = fmap return . try $ metaLine <|> commentLine
461472
@@ -492,6 +503,14 @@ optionLine = try $ do
492503 "options" -> () <$ sepBy spaces exportSetting
493504 _ -> mzero
494505
506+addLinkFormat :: String
507+ -> (String -> String)
508+ -> OrgParser ()
509+addLinkFormat key formatter = updateState $ \s ->
510+ let fs = orgStateLinkFormatters s
511+ in s{ orgStateLinkFormatters = M.insert key formatter fs }
512+
513+
495514--
496515-- Export Settings
497516--
@@ -618,10 +637,10 @@ header = try $ do
618637 title <- manyTill inline (lookAhead $ optional headerTags <* newline)
619638 tags <- option [] headerTags
620639 newline
640+ let text = tagTitle title tags
621641 propAttr <- option nullAttr (keyValuesToAttr <$> propertiesDrawer)
622− inlines <- runF (tagTitle title tags) <$> getState
623− attr <- registerHeader propAttr inlines
624− return $ pure (B.headerWith attr level inlines)
642+ attr <- registerHeader propAttr (runF text def)
643+ return (B.headerWith attr level <$> text)
625644 where
626645 tagTitle :: [F Inlines] -> [String] -> F Inlines
627646 tagTitle title tags = trimInlinesF . mconcat $ title <> map tagToInlineF tags
@@ -799,7 +818,7 @@ noteBlock = try $ do
799818-- Paragraphs or Plain text
800819paraOrPlain :: OrgParser (F Blocks)
801820paraOrPlain = try $ do
802− ils <- parseInlines
821+ ils <- inlines
803822 nl <- option False (newline *> return True)
804823 -- Read block as paragraph, except if we are in a list context and the block
805824 -- is directly followed by a list item, in which case the block is read as
@@ -858,7 +877,7 @@ definitionListItem parseMarkerGetLength = try $ do
858877 line1 <- anyLineNewline
859878 blank <- option "" ("\n" <$ blankline)
860879 cont <- concat <$> many (listContinuation markerLength)
861− term' <- parseFromString parseInlines term
880+ term' <- parseFromString inlines term
862881 contents' <- parseFromString blocks $ line1 ++ blank ++ cont
863882 return $ (,) <$> term' <*> fmap (:[]) contents'
864883 where
@@ -884,7 +903,17 @@ listContinuation markerLength = try $
884903 notFollowedBy' blankline
885904 *> (mappend <$> (concat <$> many1 listLine)
886905 <*> many blankline)
887− where listLine = try $ indentWith markerLength *> anyLineNewline
906+ where
907+ listLine = try $ indentWith markerLength *> anyLineNewline
908+
909+ -- indent by specified number of spaces (or equiv. tabs)
910+ indentWith :: Int -> OrgParser String
911+ indentWith num = do
912+ tabStop <- getOption readerTabStop
913+ if num < tabStop
914+ then count num (char ' ')
915+ else choice [ try (count num (char ' '))
916+ , try (char '\t' >> count (num - tabStop) (char ' ')) ]
888917
889918-- | Parse any line, include the final newline in the output.
890919anyLineNewline :: OrgParser String