diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Org.hs | 156 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Org/ParserState.hs | 4 |
2 files changed, 77 insertions, 83 deletions
diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index ceab1e120..06af84494 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -49,10 +49,10 @@ import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap import Control.Arrow (first) import Control.Monad (foldM, guard, mplus, mzero, when) import Control.Monad.Reader ( Reader, runReader ) -import Data.Char (isAlphaNum, isSpace, toLower) -import Data.List (intersperse, isPrefixOf, isSuffixOf) +import Data.Char (isAlphaNum, isSpace, toLower, toUpper) +import Data.List ( foldl', intersperse, isPrefixOf, isSuffixOf ) import qualified Data.Map as M -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe ( fromMaybe, isNothing ) import Network.HTTP (urlEncode) @@ -273,11 +273,9 @@ parseBlocks = mconcat <$> manyTill block eof block :: OrgParser (F Blocks) block = choice [ mempty <$ blanklines - , optionalAttributes $ choice - [ orgBlock - , figure - , table - ] + , table + , orgBlock + , figure , example , drawer , specialLine @@ -289,50 +287,53 @@ block = choice [ mempty <$ blanklines , paraOrPlain ] <?> "block" + -- -- Block Attributes -- --- | Parse optional block attributes (like #+TITLE or #+NAME) -optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks) -optionalAttributes parser = try $ - resetBlockAttributes *> parseBlockAttributes *> parser - where - resetBlockAttributes :: OrgParser () - resetBlockAttributes = updateState $ \s -> - s{ orgStateBlockAttributes = orgStateBlockAttributes def } - -parseBlockAttributes :: OrgParser () -parseBlockAttributes = do - attrs <- many attribute - mapM_ (uncurry parseAndAddAttribute) attrs +-- | Attributes that may be added to figures (like a name or caption). +data BlockAttributes = BlockAttributes + { blockAttrName :: Maybe String + , blockAttrCaption :: Maybe (F Inlines) + } + +stringyMetaAttribute :: (String -> Bool) -> OrgParser (String, String) +stringyMetaAttribute attrCheck = try $ do + metaLineStart + attrName <- map toUpper <$> many1Till nonspaceChar (char ':') + guard $ attrCheck attrName + skipSpaces + attrValue <- manyTill anyChar newline + return (attrName, attrValue) + +blockAttributes :: OrgParser BlockAttributes +blockAttributes = try $ do + kv <- many (stringyMetaAttribute attrCheck) + let caption = foldl' (appendValues "CAPTION") Nothing kv + let name = lookup "NAME" kv + caption' <- maybe (return Nothing) + (fmap Just . parseFromString parseInlines) + caption + return $ BlockAttributes + { blockAttrName = name + , blockAttrCaption = caption' + } where - attribute :: OrgParser (String, String) - attribute = try $ do - key <- metaLineStart *> many1Till nonspaceChar (char ':') - val <- skipSpaces *> anyLine - return (map toLower key, val) - -parseAndAddAttribute :: String -> String -> OrgParser () -parseAndAddAttribute key value = do - let key' = map toLower key - () <$ addBlockAttribute key' value - -lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines)) -lookupInlinesAttr attr = try $ do - val <- lookupBlockAttribute attr - maybe (return Nothing) - (fmap Just . parseFromString parseInlines) - val - -addBlockAttribute :: String -> String -> OrgParser () -addBlockAttribute key val = updateState $ \s -> - let attrs = orgStateBlockAttributes s - in s{ orgStateBlockAttributes = M.insert key val attrs } - -lookupBlockAttribute :: String -> OrgParser (Maybe String) -lookupBlockAttribute key = - M.lookup key . orgStateBlockAttributes <$> getState + attrCheck :: String -> Bool + attrCheck attr = + case attr of + "NAME" -> True + "CAPTION" -> True + _ -> False + + appendValues :: String -> Maybe String -> (String, String) -> Maybe String + appendValues attrName accValue (key, value) = + if key /= attrName + then accValue + else case accValue of + Just acc -> Just $ acc ++ ' ':value + Nothing -> Just value -- @@ -346,6 +347,7 @@ updateIndent (_, blkType) indent = (indent, blkType) orgBlock :: OrgParser (F Blocks) orgBlock = try $ do + blockAttrs <- blockAttributes blockProp@(_, blkType) <- blockHeaderStart ($ blockProp) $ case blkType of @@ -356,7 +358,7 @@ orgBlock = try $ do "example" -> withRaw' (return . exampleCode) "quote" -> withParsed (fmap B.blockQuote) "verse" -> verseBlock - "src" -> codeBlock + "src" -> codeBlock blockAttrs _ -> withParsed (fmap $ divWithClass blkType) blockHeaderStart :: OrgParser (Int, String) @@ -410,20 +412,20 @@ followingResultsBlock = *> blankline *> block) -codeBlock :: BlockProperties -> OrgParser (F Blocks) -codeBlock blkProp = do +codeBlock :: BlockAttributes -> BlockProperties -> OrgParser (F Blocks) +codeBlock blockAttrs blkProp = do skipSpaces (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders) - id' <- fromMaybe "" <$> lookupBlockAttribute "name" leadingIndent <- lookAhead indentation content <- rawBlockContent (updateIndent blkProp leadingIndent) resultsContent <- followingResultsBlock + let id' = fromMaybe mempty $ blockAttrName blockAttrs let includeCode = exportsCode kv let includeResults = exportsResults kv let codeBlck = B.codeBlockWith ( id', classes, kv ) content - labelledBlck <- maybe (pure codeBlck) + let labelledBlck = maybe (pure codeBlck) (labelDiv codeBlck) - <$> lookupInlinesAttr "caption" + (blockAttrCaption blockAttrs) let resultBlck = fromMaybe mempty resultsContent return $ (if includeCode then labelledBlck else mempty) <> (if includeResults then resultBlck else mempty) @@ -579,47 +581,42 @@ drawerEnd = try $ -- Figures -- --- Figures (Image on a line by itself, preceded by name and/or caption) + +-- | Figures (Image on a line by itself, preceded by name and/or caption) figure :: OrgParser (F Blocks) figure = try $ do - (cap, nam) <- nameAndCaption + figAttrs <- blockAttributes src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline + guard . not . isNothing . blockAttrCaption $ figAttrs guard (isImageFilename src) - return $ do - cap' <- cap - return $ B.para $ B.image src nam cap' + let figName = fromMaybe mempty $ blockAttrName figAttrs + let figCaption = fromMaybe mempty $ blockAttrCaption figAttrs + return $ (B.para . B.image src (withFigPrefix figName) <$> figCaption) where - nameAndCaption = - do - maybeCap <- lookupInlinesAttr "caption" - maybeNam <- lookupBlockAttribute "name" - guard $ isJust maybeCap || isJust maybeNam - return ( fromMaybe mempty maybeCap - , withFigPrefix $ fromMaybe mempty maybeNam ) withFigPrefix cs = - if "fig:" `isPrefixOf` cs - then cs - else "fig:" ++ cs + if "fig:" `isPrefixOf` cs + then cs + else "fig:" ++ cs -- -- Comments, Options and Metadata +-- specialLine :: OrgParser (F Blocks) specialLine = fmap return . try $ metaLine <|> commentLine metaLine :: OrgParser Blocks -metaLine = try $ mempty - <$ (metaLineStart *> (optionLine <|> declarationLine)) - -commentLine :: OrgParser Blocks -commentLine = try $ commentLineStart *> anyLine *> pure mempty +metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine) -- The order, in which blocks are tried, makes sure that we're not looking at -- the beginning of a block, so we don't need to check for it -metaLineStart :: OrgParser String -metaLineStart = try $ mappend <$> many spaceChar <*> string "#+" +metaLineStart :: OrgParser () +metaLineStart = try $ skipSpaces <* string "#+" + +commentLine :: OrgParser Blocks +commentLine = commentLineStart *> anyLine *> pure mempty -commentLineStart :: OrgParser String -commentLineStart = try $ mappend <$> many spaceChar <*> string "# " +commentLineStart :: OrgParser () +commentLineStart = try $ skipSpaces <* string "# " declarationLine :: OrgParser () declarationLine = try $ do @@ -738,11 +735,12 @@ data OrgTable = OrgTable table :: OrgParser (F Blocks) table = try $ do + blockAttrs <- blockAttributes lookAhead tableStart do rows <- tableRows - cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption" - return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows + let caption = fromMaybe (return mempty) $ blockAttrCaption blockAttrs + return $ (<$> caption) . orgToPandocTable . normalizeTable =<< rowsToTable rows orgToPandocTable :: OrgTable -> Inlines diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 49cfa2be2..f84e5e51b 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -68,8 +68,6 @@ import Text.Pandoc.Parsing ( HasHeaderMap(..) type OrgNoteRecord = (String, F Blocks) -- | Table of footnotes type OrgNoteTable = [OrgNoteRecord] --- | Map of org block attributes (e.g. LABEL, CAPTION, NAME, etc) -type OrgBlockAttributes = M.Map String String -- | Map of functions for link transformations. The map key is refers to the -- link-type, the corresponding function transforms the given link string. type OrgLinkFormatters = M.Map String (String -> String) @@ -84,7 +82,6 @@ data ExportSettings = ExportSettings data OrgParserState = OrgParserState { orgStateOptions :: ReaderOptions , orgStateAnchorIds :: [String] - , orgStateBlockAttributes :: OrgBlockAttributes , orgStateEmphasisCharStack :: [Char] , orgStateEmphasisNewlines :: Maybe Int , orgStateExportSettings :: ExportSettings @@ -140,7 +137,6 @@ defaultOrgParserState :: OrgParserState defaultOrgParserState = OrgParserState { orgStateOptions = def , orgStateAnchorIds = [] - , orgStateBlockAttributes = M.empty , orgStateEmphasisCharStack = [] , orgStateEmphasisNewlines = Nothing , orgStateExportSettings = def |