@@ -49,10 +49,10 @@ import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
4949import Control.Arrow (first)
5050import Control.Monad (foldM, guard, mplus, mzero, when)
5151import Control.Monad.Reader ( Reader, runReader )
52−import Data.Char (isAlphaNum, isSpace, toLower)
53−import Data.List (intersperse, isPrefixOf, isSuffixOf)
52+import Data.Char (isAlphaNum, isSpace, toLower, toUpper)
53+import Data.List ( foldl', intersperse, isPrefixOf, isSuffixOf )
5454import qualified Data.Map as M
55−import Data.Maybe (fromMaybe, isJust)
55+import Data.Maybe ( fromMaybe, isNothing )
5656import Network.HTTP (urlEncode)
5757
5858
@@ -273,11 +273,9 @@ parseBlocks = mconcat <$> manyTill block eof
273273
274274block :: OrgParser (F Blocks)
275275block = choice [ mempty <$ blanklines
276− , optionalAttributes $ choice
277− [ orgBlock
278− , figure
279− , table
280− ]
276+ , table
277+ , orgBlock
278+ , figure
281279 , example
282280 , drawer
283281 , specialLine
@@ -289,50 +287,53 @@ block = choice [ mempty <$ blanklines
289287 , paraOrPlain
290288 ] <?> "block"
291289
290+
292291--
293292-- Block Attributes
294293--
295294
296−-- | Parse optional block attributes (like #+TITLE or #+NAME)
297−optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)
298−optionalAttributes parser = try $
299− resetBlockAttributes *> parseBlockAttributes *> parser
300− where
301− resetBlockAttributes :: OrgParser ()
302− resetBlockAttributes = updateState $ \s ->
303− s{ orgStateBlockAttributes = orgStateBlockAttributes def }
304−
305−parseBlockAttributes :: OrgParser ()
306−parseBlockAttributes = do
307− attrs <- many attribute
308− mapM_ (uncurry parseAndAddAttribute) attrs
295+-- | Attributes that may be added to figures (like a name or caption).
296+data BlockAttributes = BlockAttributes
297+ { blockAttrName :: Maybe String
298+ , blockAttrCaption :: Maybe (F Inlines)
299+ }
300+
301+stringyMetaAttribute :: (String -> Bool) -> OrgParser (String, String)
302+stringyMetaAttribute attrCheck = try $ do
303+ metaLineStart
304+ attrName <- map toUpper <$> many1Till nonspaceChar (char ':')
305+ guard $ attrCheck attrName
306+ skipSpaces
307+ attrValue <- manyTill anyChar newline
308+ return (attrName, attrValue)
309+
310+blockAttributes :: OrgParser BlockAttributes
311+blockAttributes = try $ do
312+ kv <- many (stringyMetaAttribute attrCheck)
313+ let caption = foldl' (appendValues "CAPTION") Nothing kv
314+ let name = lookup "NAME" kv
315+ caption' <- maybe (return Nothing)
316+ (fmap Just . parseFromString parseInlines)
317+ caption
318+ return $ BlockAttributes
319+ { blockAttrName = name
320+ , blockAttrCaption = caption'
321+ }
309322 where
310− attribute :: OrgParser (String, String)
311− attribute = try $ do
312− key <- metaLineStart *> many1Till nonspaceChar (char ':')
313− val <- skipSpaces *> anyLine
314− return (map toLower key, val)
315−
316−parseAndAddAttribute :: String -> String -> OrgParser ()
317−parseAndAddAttribute key value = do
318− let key' = map toLower key
319− () <$ addBlockAttribute key' value
320−
321−lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))
322−lookupInlinesAttr attr = try $ do
323− val <- lookupBlockAttribute attr
324− maybe (return Nothing)
325− (fmap Just . parseFromString parseInlines)
326− val
327−
328−addBlockAttribute :: String -> String -> OrgParser ()
329−addBlockAttribute key val = updateState $ \s ->
330− let attrs = orgStateBlockAttributes s
331− in s{ orgStateBlockAttributes = M.insert key val attrs }
332−
333−lookupBlockAttribute :: String -> OrgParser (Maybe String)
334−lookupBlockAttribute key =
335− M.lookup key . orgStateBlockAttributes <$> getState
323+ attrCheck :: String -> Bool
324+ attrCheck attr =
325+ case attr of
326+ "NAME" -> True
327+ "CAPTION" -> True
328+ _ -> False
329+
330+ appendValues :: String -> Maybe String -> (String, String) -> Maybe String
331+ appendValues attrName accValue (key, value) =
332+ if key /= attrName
333+ then accValue
334+ else case accValue of
335+ Just acc -> Just $ acc ++ ' ':value
336+ Nothing -> Just value
336337
337338
338339--
@@ -346,6 +347,7 @@ updateIndent (_, blkType) indent = (indent, blkType)
346347
347348orgBlock :: OrgParser (F Blocks)
348349orgBlock = try $ do
350+ blockAttrs <- blockAttributes
349351 blockProp@(_, blkType) <- blockHeaderStart
350352 ($ blockProp) $
351353 case blkType of
@@ -356,7 +358,7 @@ orgBlock = try $ do
356358 "example" -> withRaw' (return . exampleCode)
357359 "quote" -> withParsed (fmap B.blockQuote)
358360 "verse" -> verseBlock
359− "src" -> codeBlock
361+ "src" -> codeBlock blockAttrs
360362 _ -> withParsed (fmap $ divWithClass blkType)
361363
362364blockHeaderStart :: OrgParser (Int, String)
@@ -410,20 +412,20 @@ followingResultsBlock =
410412 *> blankline
411413 *> block)
412414
413−codeBlock :: BlockProperties -> OrgParser (F Blocks)
414−codeBlock blkProp = do
415+codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks)
416+codeBlock blockAttrs blkProp = do
415417 skipSpaces
416418 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)
417− id' <- fromMaybe "" <$> lookupBlockAttribute "name"
418419 leadingIndent <- lookAhead indentation
419420 content <- rawBlockContent (updateIndent blkProp leadingIndent)
420421 resultsContent <- followingResultsBlock
422+ let id' = fromMaybe mempty $ blockAttrName blockAttrs
421423 let includeCode = exportsCode kv
422424 let includeResults = exportsResults kv
423425 let codeBlck = B.codeBlockWith ( id', classes, kv ) content
424− labelledBlck <- maybe (pure codeBlck)
426+ let labelledBlck = maybe (pure codeBlck)
425427 (labelDiv codeBlck)
426− <$> lookupInlinesAttr "caption"
428+ (blockAttrCaption blockAttrs)
427429 let resultBlck = fromMaybe mempty resultsContent
428430 return $ (if includeCode then labelledBlck else mempty)
429431 <> (if includeResults then resultBlck else mempty)
@@ -579,47 +581,42 @@ drawerEnd = try $
579581-- Figures
580582--
581583
582−-- Figures (Image on a line by itself, preceded by name and/or caption)
584+
585+-- | Figures (Image on a line by itself, preceded by name and/or caption)
583586figure :: OrgParser (F Blocks)
584587figure = try $ do
585− (cap, nam) <- nameAndCaption
588+ figAttrs <- blockAttributes
586589 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline
590+ guard . not . isNothing . blockAttrCaption $ figAttrs
587591 guard (isImageFilename src)
588− return $ do
589− cap' <- cap
590− return $ B.para $ B.image src nam cap'
592+ let figName = fromMaybe mempty $ blockAttrName figAttrs
593+ let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs
594+ return $ (B.para . B.image src (withFigPrefix figName) <$> figCaption)
591595 where
592− nameAndCaption =
593− do
594− maybeCap <- lookupInlinesAttr "caption"
595− maybeNam <- lookupBlockAttribute "name"
596− guard $ isJust maybeCap || isJust maybeNam
597− return ( fromMaybe mempty maybeCap
598− , withFigPrefix $ fromMaybe mempty maybeNam )
599596 withFigPrefix cs =
600− if "fig:" `isPrefixOf` cs
601− then cs
602− else "fig:" ++ cs
597+ if "fig:" `isPrefixOf` cs
598+ then cs
599+ else "fig:" ++ cs
603600
604601--
605602-- Comments, Options and Metadata
603+--
606604specialLine :: OrgParser (F Blocks)
607605specialLine = fmap return . try $ metaLine <|> commentLine
608606
609607metaLine :: OrgParser Blocks
610−metaLine = try $ mempty
611− <$ (metaLineStart *> (optionLine <|> declarationLine))
612−
613−commentLine :: OrgParser Blocks
614−commentLine = try $ commentLineStart *> anyLine *> pure mempty
608+metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)
615609
616610-- The order, in which blocks are tried, makes sure that we're not looking at
617611-- the beginning of a block, so we don't need to check for it
618−metaLineStart :: OrgParser String
619−metaLineStart = try $ mappend <$> many spaceChar <*> string "#+"
612+metaLineStart :: OrgParser ()
613+metaLineStart = try $ skipSpaces <* string "#+"
614+
615+commentLine :: OrgParser Blocks
616+commentLine = commentLineStart *> anyLine *> pure mempty
620617
621−commentLineStart :: OrgParser String
622−commentLineStart = try $ mappend <$> many spaceChar <*> string "# "
618+commentLineStart :: OrgParser ()
619+commentLineStart = try $ skipSpaces <* string "# "
623620
624621declarationLine :: OrgParser ()
625622declarationLine = try $ do
@@ -738,11 +735,12 @@ data OrgTable = OrgTable
738735
739736table :: OrgParser (F Blocks)
740737table = try $ do
738+ blockAttrs <- blockAttributes
741739 lookAhead tableStart
742740 do
743741 rows <- tableRows
744− cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"
745− return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows
742+ let caption = fromMaybe (return mempty) $ blockAttrCaption blockAttrs
743+ return $ (<$> caption) . orgToPandocTable . normalizeTable =<< rowsToTable rows
746744
747745orgToPandocTable :: OrgTable
748746 -> Inlines