aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Markdown.hs
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2018-07-30 23:04:53 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2018-07-30 23:04:53 -0700
commitd3d932f42cd361a7b4d7e2b22a3238f53cb54f6b (patch)
treeb6259ba6401fd21206ff3d14edabb1b622c25205 /src/Text/Pandoc/Readers/Markdown.hs
parentcbb662ca07acf23ead5479ab4bd479883432c7d7 (diff)
downloadpandoc-d3d932f42cd361a7b4d7e2b22a3238f53cb54f6b.tar.gz
Markdown reader: allow unquoted numbers, booleans as YAML mapping keys.
Previously in 2.2.2 you could not do --- 0: bar ... but only --- '0': bar ... With this change, both forms work.
Diffstat (limited to 'src/Text/Pandoc/Readers/Markdown.hs')
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs54
1 files changed, 28 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index a12437299..8c70de4af 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -230,7 +230,6 @@ pandocTitleBlock = try $ do
$ nullMeta
updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }
-
yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)
yamlMetaBlock = try $ do
guardEnabled Ext_yaml_metadata_block
@@ -242,29 +241,31 @@ yamlMetaBlock = try $ do
-- by including --- and ..., we allow yaml blocks with just comments:
let rawYaml = unlines ("---" : (rawYamlLines ++ ["..."]))
optional blanklines
- case YAML.decode (UTF8.fromStringLazy rawYaml) of
- Right (YAML.Mapping _ hashmap : _) -> do
+ case YAML.decodeNode' YAML.failsafeSchemaResolver False False
+ (UTF8.fromStringLazy rawYaml) of
+ Right [YAML.Doc (YAML.Mapping _ hashmap)] -> do
let alist = M.toList hashmap
mapM_ (\(key, v) ->
- case YAML.parseEither (YAML.parseYAML key) of
- Left e -> fail e
- Right k -> do
- if ignorable k
- then return ()
- else do
- v' <- yamlToMeta v
- let k' = T.unpack k
- updateState $ \st -> st{ stateMeta' =
- do m <- stateMeta' st
- -- if there's already a value, leave it unchanged
- case lookupMeta k' m of
- Just _ -> return m
- Nothing -> do
- v'' <- v'
- return $ B.setMeta (T.unpack k) v'' m}
- ) alist
+ case key of
+ (YAML.Scalar (YAML.SStr t)) -> handleKey t v
+ (YAML.Scalar (YAML.SUnknown _ t)) -> handleKey t v
+ _ -> fail "Non-string key in YAML mapping") alist
+ where handleKey k v =
+ if ignorable k
+ then return ()
+ else do
+ v' <- yamlToMeta v
+ let k' = T.unpack k
+ updateState $ \st -> st{ stateMeta' =
+ do m <- stateMeta' st
+ -- if there's already a value, leave it unchanged
+ case lookupMeta k' m of
+ Just _ -> return m
+ Nothing -> do
+ v'' <- v'
+ return $ B.setMeta (T.unpack k) v'' m}
Right [] -> return ()
- Right (YAML.Scalar YAML.SNull:_) -> return ()
+ Right [YAML.Doc (YAML.Scalar YAML.SNull)] -> return ()
Right _ -> do
logMessage $
CouldNotParseYamlMetadata "not an object"
@@ -303,11 +304,12 @@ yamlToMeta :: PandocMonad m
=> YAML.Node -> MarkdownParser m (F MetaValue)
yamlToMeta (YAML.Scalar x) =
case x of
- YAML.SStr t -> toMetaValue t
- YAML.SBool b -> return $ return $ MetaBool b
- YAML.SFloat d -> return $ return $ MetaString (show d)
- YAML.SInt i -> return $ return $ MetaString (show i)
- _ -> return $ return $ MetaString ""
+ YAML.SStr t -> toMetaValue t
+ YAML.SBool b -> return $ return $ MetaBool b
+ YAML.SFloat d -> return $ return $ MetaString (show d)
+ YAML.SInt i -> return $ return $ MetaString (show i)
+ YAML.SUnknown _ t -> toMetaValue t
+ YAML.SNull -> return $ return $ MetaString ""
yamlToMeta (YAML.Sequence _ xs) = do
xs' <- mapM yamlToMeta xs
return $ do