diff options
Diffstat (limited to 'src/Text/Pandoc/Readers')
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 27 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Metadata.hs | 45 |
2 files changed, 69 insertions, 3 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 257788081..65925ee95 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -13,7 +13,10 @@ Conversion of markdown-formatted plain text to 'Pandoc' document. -} -module Text.Pandoc.Readers.Markdown ( readMarkdown, yamlToMeta ) where +module Text.Pandoc.Readers.Markdown ( + readMarkdown, + yamlToMeta, + yamlToRefs ) where import Control.Monad import Control.Monad.Except (throwError) @@ -44,7 +47,7 @@ import Text.Pandoc.Readers.LaTeX (applyMacros, rawLaTeXBlock, rawLaTeXInline) import Text.Pandoc.Shared import qualified Text.Pandoc.UTF8 as UTF8 import Text.Pandoc.XML (fromEntities) -import Text.Pandoc.Readers.Metadata (yamlBsToMeta) +import Text.Pandoc.Readers.Metadata (yamlBsToMeta, yamlBsToRefs) type MarkdownParser m = ParserT Text ParserState m @@ -75,6 +78,26 @@ yamlToMeta opts bstr = do Right result -> return result Left e -> throwError e +-- | Read a YAML string and extract references from the +-- 'references' field, filter using an id predicate and +-- parsing fields as Markdown. +yamlToRefs :: PandocMonad m + => (Text -> Bool) + -> ReaderOptions + -> BL.ByteString + -> m [M.Map Text MetaValue] +yamlToRefs idpred opts bstr = do + let parser = do + refs <- yamlBsToRefs (fmap B.toMetaValue <$> parseBlocks) idpred bstr + return $ runF refs defaultParserState + parsed <- readWithM parser def{ stateOptions = opts } "" + case parsed of + Right result -> return result + Left e -> throwError e + + + + -- -- Constants and data structure definitions -- diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs index 826111756..b802c752b 100644 --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {- | Module : Text.Pandoc.Readers.Metadata Copyright : Copyright (C) 2006-2020 John MacFarlane @@ -10,7 +11,10 @@ Parse YAML/JSON metadata to 'Pandoc' 'Meta'. -} -module Text.Pandoc.Readers.Metadata ( yamlBsToMeta, yamlMap ) where +module Text.Pandoc.Readers.Metadata ( + yamlBsToMeta, + yamlBsToRefs, + yamlMap ) where import Control.Monad import Control.Monad.Except (throwError) @@ -47,6 +51,45 @@ yamlBsToMeta pMetaValue bstr = do (T.pack err') pos return . return $ mempty +-- Returns filtered list of references. +yamlBsToRefs :: PandocMonad m + => ParserT Text ParserState m (F MetaValue) + -> (Text -> Bool) -- ^ Filter for id + -> BL.ByteString + -> ParserT Text ParserState m (F [M.Map Text MetaValue]) +yamlBsToRefs pMetaValue idpred bstr = do + pos <- getPosition + case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of + Right (YAML.Doc (YAML.Mapping _ _ o):_) + -> case YAML.parseEither (o YAML..: "references") of + Right ns -> do + let g n = case YAML.parseEither (n YAML..: "id") of + Right t -> idpred t || + case YAML.parseEither (n YAML..: + "other-ids") of + Right (oids :: [Text]) -> + any idpred oids + _ -> False + _ -> False + sequence <$> mapM (yamlMap pMetaValue) (filter g ns) + Left _ -> do + logMessage $ CouldNotParseYamlMetadata + ("expecting 'references' field") pos + return . return $ mempty + + Right [] -> return . return $ mempty + Right [YAML.Doc (YAML.Scalar _ YAML.SNull)] + -> return . return $ mempty + Right _ -> do logMessage $ CouldNotParseYamlMetadata "not an object" + pos + return . return $ mempty + Left (_pos, err') + -> do logMessage $ CouldNotParseYamlMetadata + (T.pack err') pos + return . return $ mempty + + + nodeToKey :: PandocMonad m => YAML.Node YE.Pos -> m Text |