@@ -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
@@ -296,41 +297,60 @@ 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
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+ language <- optionMaybe orgArgWord
346+ (classes, kv) <- codeHeaderArgs
347+ id' <- fromMaybe "" <$> lookupBlockAttribute "name"
348+ caption <- lookupInlinesAttr "caption"
349+ content <- rawBlockContent blkProp
350+ let attr = ( id'
351+ , maybe id (\l -> (l:)) language $ classes
352+ , kv )
353+ let codeBlck = B.codeBlockWith attr content
334354 return $ maybe (pure codeBlck) (labelDiv codeBlck) caption
335355 where
336356 labelDiv blk value =
@@ -338,14 +358,21 @@ codeBlockWithAttr classArgs content = do
338358 <*> pure blk)
339359 labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))
340360
341−rawBlockContent :: Int -> String -> OrgParser String
342−rawBlockContent indent blockType =
361+rawBlockContent :: BlockProperties -> OrgParser String
362+rawBlockContent (indent, blockType) = try $
343363 unlines . map commaEscaped <$> manyTill indentedLine blockEnder
344364 where
345− indentedLine = try $ choice [ blankline *> pure "\n"
346− , indentWith indent *> anyLine
347− ]
348− blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
365+ indentedLine = try $
366+ choice [ blankline *> pure "\n"
367+ , indentWith indent *> anyLine
368+ ]
369+ blockEnder = try $
370+ indentWith indent *> stringAnyCase ("#+end_" <> blockType)
371+
372+parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)
373+parsedBlockContent blkProps = try $ do
374+ raw <- rawBlockContent blkProps
375+ parseFromString parseBlocks (raw ++ "\n")
349376
350377-- indent by specified number of spaces (or equiv. tabs)
351378indentWith :: Int -> OrgParser String
@@ -356,6 +383,13 @@ indentWith num = do
356383 else choice [ try (count num (char ' '))
357384 , try (char '\t' >> count (num - tabStop) (char ' ')) ]
358385
386+orgArgWord :: OrgParser String
387+orgArgWord = many1 orgArgWordChar
388+
389+codeHeaderArgs :: OrgParser ([String], [(String, String)])
390+codeHeaderArgs =
391+ (\x -> (x, [])) <$> manyTill (many nonspaceChar <* skipSpaces) newline
392+
359393translateLang :: String -> String
360394translateLang "C" = "c"
361395translateLang "C++" = "cpp"
@@ -1002,9 +1036,13 @@ inlineCodeBlock = try $ do
10021036 returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode
10031037 where enclosedByPair s e p = char s *> many1Till p (char e)
10041038
1039+-- | Prefix used for Rundoc classes and arguments.
1040+rundocPrefix :: String
1041+rundocPrefix = "rundoc-"
1042+
10051043-- | The class-name used to mark rundoc blocks.
10061044rundocBlockClass :: String
1007−rundocBlockClass = "rundoc-block"
1045+rundocBlockClass = rundocPrefix ++ "block"
10081046
10091047blockOption :: OrgParser (String, String)
10101048blockOption = try $ (,) <$> orgArgKey <*> orgArgValue