@@ -50,7 +50,7 @@ import Data.Char (isAlphaNum, toLower)
5050import Data.Default
5151import Data.List (intersperse, isPrefixOf, isSuffixOf)
5252import qualified Data.Map as M
53−import Data.Maybe (listToMaybe, fromMaybe, isJust)
53+import Data.Maybe (fromMaybe, isJust)
5454import Data.Monoid (Monoid, mconcat, mempty, mappend)
5555import Network.HTTP (urlEncode)
5656
@@ -162,7 +162,8 @@ popInlineCharStack = updateState $ \s ->
162162 s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }
163163
164164surroundingEmphasisChar :: OrgParser [Char]
165−surroundingEmphasisChar = take 1 . drop 1 . orgStateEmphasisCharStack <$> getState
165+surroundingEmphasisChar =
166+ take 1 . drop 1 . orgStateEmphasisCharStack <$> getState
166167
167168startEmphasisNewlinesCounting :: Int -> OrgParser ()
168169startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->
@@ -170,7 +171,7 @@ startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->
170171
171172decEmphasisNewlinesCount :: OrgParser ()
172173decEmphasisNewlinesCount = updateState $ \s ->
173− s{ orgStateEmphasisNewlines = (\n -> n - 1) <$> orgStateEmphasisNewlines s }
174+ s{ orgStateEmphasisNewlines = (\n -> n - 1) <$> orgStateEmphasisNewlines s }
174175
175176newlinesCountWithinLimits :: OrgParser Bool
176177newlinesCountWithinLimits = do
@@ -275,7 +276,7 @@ parseBlockAttributes = do
275276 where
276277 attribute :: OrgParser (String, String)
277278 attribute = try $ do
278− key <- metaLineStart *> many1Till (noneOf "\n\r") (char ':')
279+ key <- metaLineStart *> many1Till nonspaceChar (char ':')
279280 val <- skipSpaces *> anyLine
280281 return (map toLower key, val)
281282
@@ -296,57 +297,74 @@ lookupInlinesAttr attr = try $ do
296297-- Org Blocks (#+BEGIN_... / #+END_...)
297298--
298299
300+type BlockProperties = (Int, String) -- (Indentation, Block-Type)
301+
299302orgBlock :: OrgParser (F Blocks)
300303orgBlock = try $ do
301− (indent, blockType, args) <- blockHeader
302− content <- rawBlockContent indent blockType
303− contentBlocks <- parseFromString parseBlocks (content ++ "\n")
304− let classArgs = [ translateLang . fromMaybe [] $ listToMaybe args ]
305− case blockType of
306− "comment" -> return mempty
307− "html" -> returnF $ B.rawBlock "html" content
308− "latex" -> returnF $ B.rawBlock "latex" content
309− "ascii" -> returnF $ B.rawBlock "ascii" content
310− "example" -> returnF $ exampleCode content
311− "quote" -> return $ B.blockQuote <$> contentBlocks
312− "verse" -> parseVerse content
313− "src" -> codeBlockWithAttr classArgs content
314− _ -> return $ B.divWith ("", [blockType], []) <$> contentBlocks
304+ blockProp@(_, blkType) <- blockHeaderStart
305+ ($ blockProp) $
306+ case blkType of
307+ "comment" -> withRaw' (const mempty)
308+ "html" -> withRaw' (return . (B.rawBlock blkType))
309+ "latex" -> withRaw' (return . (B.rawBlock blkType))
310+ "ascii" -> withRaw' (return . (B.rawBlock blkType))
311+ "example" -> withRaw' (return . exampleCode)
312+ "quote" -> withParsed (fmap B.blockQuote)
313+ "verse" -> verseBlock
314+ "src" -> codeBlock
315+ _ -> withParsed (fmap $ divWithClass blkType)
316+
317+blockHeaderStart :: OrgParser (Int, String)
318+blockHeaderStart = try $ (,) <$> indent <*> blockType
315319 where
316− parseVerse :: String -> OrgParser (F Blocks)
317− parseVerse cs =
318− fmap B.para . mconcat . intersperse (pure B.linebreak)
319− <$> mapM (parseFromString parseInlines) (lines cs)
320−
321−blockHeader :: OrgParser (Int, String, [String])
322−blockHeader = (,,) <$> blockIndent
323− <*> blockType
324− <*> (skipSpaces *> blockArgs)
325− where blockIndent = length <$> many spaceChar
326− blockType = map toLower <$> (stringAnyCase "#+begin_" *> many letter)
327− blockArgs = manyTill (many nonspaceChar <* skipSpaces) newline
328−
329−codeBlockWithAttr :: [String] -> String -> OrgParser (F Blocks)
330−codeBlockWithAttr classArgs content = do
331− identifier <- fromMaybe "" <$> lookupBlockAttribute "name"
332− caption <- lookupInlinesAttr "caption"
333− let codeBlck = B.codeBlockWith (identifier, classArgs, []) content
334− return $ maybe (pure codeBlck) (labelDiv codeBlck) caption
320+ indent = length <$> many spaceChar
321+ blockType = map toLower <$> (stringAnyCase "#+begin_" *> many orgArgWordChar)
322+
323+withRaw' :: (String -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
324+withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))
325+
326+withParsed :: (F Blocks -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)
327+withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))
328+
329+ignHeaders :: OrgParser ()
330+ignHeaders = (() <$ newline) <|> (() <$ anyLine)
331+
332+divWithClass :: String -> Blocks -> Blocks
333+divWithClass cls = B.divWith ("", [cls], [])
334+
335+verseBlock :: BlockProperties -> OrgParser (F Blocks)
336+verseBlock blkProp = try $ do
337+ ignHeaders
338+ content <- rawBlockContent blkProp
339+ fmap B.para . mconcat . intersperse (pure B.linebreak)
340+ <$> mapM (parseFromString parseInlines) (lines content)
341+
342+codeBlock :: BlockProperties -> OrgParser (F Blocks)
343+codeBlock blkProp = do
344+ skipSpaces
345+ (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
346+ id' <- fromMaybe "" <$> lookupBlockAttribute "name"
347+ content <- rawBlockContent blkProp
348+ let codeBlck = B.codeBlockWith ( id', classes, kv ) content
349+ maybe (pure codeBlck) (labelDiv codeBlck) <$> lookupInlinesAttr "caption"
335350 where
336351 labelDiv blk value =
337352 B.divWith nullAttr <$> (mappend <$> labelledBlock value
338353 <*> pure blk)
339354 labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
340355
341−rawBlockContent :: Int -> String -> OrgParser String
342−rawBlockContent indent blockType =
356+rawBlockContent :: BlockProperties -> OrgParser String
357+rawBlockContent (indent, blockType) = try $
343358 unlines . map commaEscaped <$> manyTill indentedLine blockEnder
344359 where
345− indentedLine = try $ choice [ blankline *> pure "\n"
346− , indentWith indent *> anyLine
347− ]
360+ indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)
348361 blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
349362
363+parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
364+parsedBlockContent blkProps = try $ do
365+ raw <- rawBlockContent blkProps
366+ parseFromString parseBlocks (raw ++ "\n")
367+
350368-- indent by specified number of spaces (or equiv. tabs)
351369indentWith :: Int -> OrgParser String
352370indentWith num = do
@@ -356,6 +374,34 @@ indentWith num = do
356374 else choice [ try (count num (char ' '))
357375 , try (char '\t' >> count (num - tabStop) (char ' ')) ]
358376
377+type SwitchOption = (Char, Maybe String)
378+
379+orgArgWord :: OrgParser String
380+orgArgWord = many1 orgArgWordChar
381+
382+-- | Parse code block arguments
383+-- TODO: We currently don't handle switches.
384+codeHeaderArgs :: OrgParser ([String], [(String, String)])
385+codeHeaderArgs = try $ do
386+ language <- skipSpaces *> orgArgWord
387+ _ <- skipSpaces *> (try $ switch `sepBy` (many1 spaceChar))
388+ parameters <- manyTill blockOption newline
389+ let pandocLang = translateLang language
390+ return $
391+ if hasRundocParameters parameters
392+ then ( [ pandocLang, rundocBlockClass ]
393+ , map toRundocAttrib (("language", language) : parameters)
394+ )
395+ else ([ pandocLang ], parameters)
396+ where hasRundocParameters = not . null
397+
398+switch :: OrgParser SwitchOption
399+switch = try $ simpleSwitch <|> lineNumbersSwitch
400+ where
401+ simpleSwitch = (\c -> (c, Nothing)) <$> (oneOf "-+" *> letter)
402+ lineNumbersSwitch = (\ls -> ('l', Just ls)) <$>
403+ (string "-l \"" *> many1Till nonspaceChar (char '"'))
404+
359405translateLang :: String -> String
360406translateLang "C" = "c"
361407translateLang "C++" = "cpp"
@@ -367,6 +413,32 @@ translateLang "sh" = "bash"
367413translateLang "sqlite" = "sql"
368414translateLang cs = cs
369415
416+-- | Prefix used for Rundoc classes and arguments.
417+rundocPrefix :: String
418+rundocPrefix = "rundoc-"
419+
420+-- | The class-name used to mark rundoc blocks.
421+rundocBlockClass :: String
422+rundocBlockClass = rundocPrefix ++ "block"
423+
424+blockOption :: OrgParser (String, String)
425+blockOption = try $ (,) <$> orgArgKey <*> orgArgValue
426+
427+orgArgKey :: OrgParser String
428+orgArgKey = try $
429+ skipSpaces *> char ':'
430+ *> many1 orgArgWordChar
431+
432+orgArgValue :: OrgParser String
433+orgArgValue = try $
434+ skipSpaces *> many1 orgArgWordChar <* skipSpaces
435+
436+orgArgWordChar :: OrgParser Char
437+orgArgWordChar = alphaNum <|> oneOf "-_"
438+
439+toRundocAttrib :: (String, String) -> (String, String)
440+toRundocAttrib = first ("rundoc-" ++)
441+
370442commaEscaped :: String -> String
371443commaEscaped (',':cs@('*':_)) = cs
372444commaEscaped (',':cs@('#':'+':_)) = cs
@@ -391,7 +463,7 @@ drawer = try $ do
391463
392464drawerStart :: OrgParser String
393465drawerStart = try $
394− skipSpaces *> drawerName <* skipSpaces <* newline
466+ skipSpaces *> drawerName <* skipSpaces <* P.newline
395467 where drawerName = try $ char ':' *> validDrawerName <* char ':'
396468 validDrawerName = stringAnyCase "PROPERTIES"
397469 <|> stringAnyCase "LOGBOOK"
@@ -401,7 +473,7 @@ drawerLine = try anyLine
401473
402474drawerEnd :: OrgParser String
403475drawerEnd = try $
404− skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
476+ skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* P.newline
405477
406478
407479--
@@ -412,7 +484,7 @@ drawerEnd = try $
412484figure :: OrgParser (F Blocks)
413485figure = try $ do
414486 (cap, nam) <- nameAndCaption
415− src <- skipSpaces *> selfTarget <* skipSpaces <* newline
487+ src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline
416488 guard (isImageFilename src)
417489 return $ do
418490 cap' <- cap
@@ -1002,30 +1074,6 @@ inlineCodeBlock = try $ do
10021074 returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
10031075 where enclosedByPair s e p = char s *> many1Till p (char e)
10041076
1005−-- | The class-name used to mark rundoc blocks.
1006−rundocBlockClass :: String
1007−rundocBlockClass = "rundoc-block"
1008−
1009−blockOption :: OrgParser (String, String)
1010−blockOption = try $ (,) <$> orgArgKey <*> orgArgValue
1011−
1012−orgArgKey :: OrgParser String
1013−orgArgKey = try $
1014− skipSpaces *> char ':'
1015− *> many1 orgArgWordChar
1016− <* many1 spaceChar
1017−
1018−orgArgValue :: OrgParser String
1019−orgArgValue = try $
1020− skipSpaces *> many1 orgArgWordChar
1021− <* skipSpaces
1022−
1023−orgArgWordChar :: OrgParser Char
1024−orgArgWordChar = alphaNum <|> oneOf "-_"
1025−
1026−toRundocAttrib :: (String, String) -> (String, String)
1027−toRundocAttrib = first ("rundoc-" ++)
1028−
10291077emph :: OrgParser (F Inlines)
10301078emph = fmap B.emph <$> emphasisBetween '/'
10311079