aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Metadata.hs
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2021-05-01 13:17:45 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2021-05-09 19:11:34 -0600
commit6e45607f9948f45b2e94f54b4825b667ca0d5441 (patch)
treec4cbc0f6d398c4c4cf28fda23665fe19d26602b3 /src/Text/Pandoc/Readers/Metadata.hs
parent295d93e96b1853c2ff4658aa7206ea1329024fab (diff)
downloadpandoc-6e45607f9948f45b2e94f54b4825b667ca0d5441.tar.gz
Change reader types, allowing better tracking of source positions.
Previously, when multiple file arguments were provided, pandoc simply concatenated them and passed the contents to the readers, which took a Text argument. As a result, the readers had no way of knowing which file was the source of any particular bit of text. This meant that we couldn't report accurate source positions on errors or include accurate source positions as attributes in the AST. More seriously, it meant that we couldn't resolve resource paths relative to the files containing them (see e.g. #5501, #6632, #6384, #3752). Add Text.Pandoc.Sources (exported module), with a `Sources` type and a `ToSources` class. A `Sources` wraps a list of `(SourcePos, Text)` pairs. [API change] A parsec `Stream` instance is provided for `Sources`. The module also exports versions of parsec's `satisfy` and other Char parsers that track source positions accurately from a `Sources` stream (or any instance of the new `UpdateSourcePos` class). Text.Pandoc.Parsing now exports these modified Char parsers instead of the ones parsec provides. Modified parsers to use a `Sources` as stream [API change]. The readers that previously took a `Text` argument have been modified to take any instance of `ToSources`. So, they may still be used with a `Text`, but they can also be used with a `Sources` object. In Text.Pandoc.Error, modified the constructor PandocParsecError to take a `Sources` rather than a `Text` as first argument, so parse error locations can be accurately reported. T.P.Error: showPos, do not print "-" as source name.
Diffstat (limited to 'src/Text/Pandoc/Readers/Metadata.hs')
-rw-r--r--src/Text/Pandoc/Readers/Metadata.hs26
1 files changed, 13 insertions, 13 deletions
diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs
index cb141cba5..bbcfe62ea 100644
--- a/src/Text/Pandoc/Readers/Metadata.hs
+++ b/src/Text/Pandoc/Readers/Metadata.hs
@@ -35,9 +35,9 @@ import qualified Data.Text.Lazy as TL
import qualified Text.Pandoc.UTF8 as UTF8
yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st)
- => ParserT Text st m (Future st MetaValue)
+ => ParserT Sources st m (Future st MetaValue)
-> BL.ByteString
- -> ParserT Text st m (Future st Meta)
+ -> ParserT Sources st m (Future st Meta)
yamlBsToMeta pMetaValue bstr = do
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
Right (YAML.Doc (YAML.Mapping _ _ o):_)
@@ -67,10 +67,10 @@ lookupYAML _ _ = Nothing
-- Returns filtered list of references.
yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st)
- => ParserT Text st m (Future st MetaValue)
+ => ParserT Sources st m (Future st MetaValue)
-> (Text -> Bool) -- ^ Filter for id
-> BL.ByteString
- -> ParserT Text st m (Future st [MetaValue])
+ -> ParserT Sources st m (Future st [MetaValue])
yamlBsToRefs pMetaValue idpred bstr =
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
Right (YAML.Doc o@YAML.Mapping{}:_)
@@ -108,9 +108,9 @@ nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = Just t
nodeToKey _ = Nothing
normalizeMetaValue :: (PandocMonad m, HasLastStrPosition st)
- => ParserT Text st m (Future st MetaValue)
+ => ParserT Sources st m (Future st MetaValue)
-> Text
- -> ParserT Text st m (Future st MetaValue)
+ -> ParserT Sources st m (Future st MetaValue)
normalizeMetaValue pMetaValue x =
-- Note: a standard quoted or unquoted YAML value will
-- not end in a newline, but a "block" set off with
@@ -133,9 +133,9 @@ checkBoolean t
| otherwise = Nothing
yamlToMetaValue :: (PandocMonad m, HasLastStrPosition st)
- => ParserT Text st m (Future st MetaValue)
+ => ParserT Sources st m (Future st MetaValue)
-> YAML.Node YE.Pos
- -> ParserT Text st m (Future st MetaValue)
+ -> ParserT Sources st m (Future st MetaValue)
yamlToMetaValue pMetaValue (YAML.Scalar _ x) =
case x of
YAML.SStr t -> normalizeMetaValue pMetaValue t
@@ -156,9 +156,9 @@ yamlToMetaValue pMetaValue (YAML.Mapping _ _ o) =
yamlToMetaValue _ _ = return $ return $ MetaString ""
yamlMap :: (PandocMonad m, HasLastStrPosition st)
- => ParserT Text st m (Future st MetaValue)
+ => ParserT Sources st m (Future st MetaValue)
-> M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
- -> ParserT Text st m (Future st (M.Map Text MetaValue))
+ -> ParserT Sources st m (Future st (M.Map Text MetaValue))
yamlMap pMetaValue o = do
kvs <- forM (M.toList o) $ \(key, v) -> do
k <- maybe (throwError $ PandocParseError
@@ -177,8 +177,8 @@ yamlMap pMetaValue o = do
-- | Parse a YAML metadata block using the supplied 'MetaValue' parser.
yamlMetaBlock :: (HasLastStrPosition st, PandocMonad m)
- => ParserT Text st m (Future st MetaValue)
- -> ParserT Text st m (Future st Meta)
+ => ParserT Sources st m (Future st MetaValue)
+ -> ParserT Sources st m (Future st Meta)
yamlMetaBlock parser = try $ do
string "---"
blankline
@@ -189,5 +189,5 @@ yamlMetaBlock parser = try $ do
optional blanklines
yamlBsToMeta parser $ UTF8.fromTextLazy $ TL.fromStrict rawYaml
-stopLine :: Monad m => ParserT Text st m ()
+stopLine :: Monad m => ParserT Sources st m ()
stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()