aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs23
-rw-r--r--src/Text/Pandoc/Translations.hs14
2 files changed, 20 insertions, 17 deletions
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index e626321e6..316dfc9d0 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -28,6 +28,7 @@ import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.YAML as YAML
+import qualified Data.YAML.Event as YE
import System.FilePath (addExtension, takeExtension)
import Text.HTML.TagSoup
import Text.Pandoc.Builder (Blocks, Inlines)
@@ -244,22 +245,22 @@ yamlBsToMeta :: PandocMonad m => BS.ByteString -> MarkdownParser m (F Meta)
yamlBsToMeta bstr = do
pos <- getPosition
case YAML.decodeNode' YAML.failsafeSchemaResolver False False bstr of
- Right ((YAML.Doc (YAML.Mapping _ o)):_) -> (fmap Meta) <$> yamlMap o
+ Right ((YAML.Doc (YAML.Mapping _ _ o)):_) -> (fmap Meta) <$> yamlMap o
Right [] -> return . return $ mempty
- Right [YAML.Doc (YAML.Scalar YAML.SNull)] -> 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 err' -> do
+ Left (_pos, err') -> do
logMessage $ CouldNotParseYamlMetadata
err' pos
return . return $ mempty
-nodeToKey :: Monad m => YAML.Node -> m Text
-nodeToKey (YAML.Scalar (YAML.SStr t)) = return t
-nodeToKey (YAML.Scalar (YAML.SUnknown _ t)) = return t
+nodeToKey :: Monad m => YAML.Node YE.Pos -> m Text
+nodeToKey (YAML.Scalar _ (YAML.SStr t)) = return t
+nodeToKey (YAML.Scalar _ (YAML.SUnknown _ t)) = return t
nodeToKey _ = fail "Non-string key in YAML mapping"
toMetaValue :: PandocMonad m
@@ -291,8 +292,8 @@ checkBoolean t =
else Nothing
yamlToMetaValue :: PandocMonad m
- => YAML.Node -> MarkdownParser m (F MetaValue)
-yamlToMetaValue (YAML.Scalar x) =
+ => YAML.Node YE.Pos-> MarkdownParser m (F MetaValue)
+yamlToMetaValue (YAML.Scalar _ x) =
case x of
YAML.SStr t -> toMetaValue t
YAML.SBool b -> return $ return $ MetaBool b
@@ -303,16 +304,16 @@ yamlToMetaValue (YAML.Scalar x) =
Just b -> return $ return $ MetaBool b
Nothing -> toMetaValue t
YAML.SNull -> return $ return $ MetaString ""
-yamlToMetaValue (YAML.Sequence _ xs) = do
+yamlToMetaValue (YAML.Sequence _ _ xs) = do
xs' <- mapM yamlToMetaValue xs
return $ do
xs'' <- sequence xs'
return $ B.toMetaValue xs''
-yamlToMetaValue (YAML.Mapping _ o) = fmap B.toMetaValue <$> yamlMap o
+yamlToMetaValue (YAML.Mapping _ _ o) = fmap B.toMetaValue <$> yamlMap o
yamlToMetaValue _ = return $ return $ MetaString ""
yamlMap :: PandocMonad m
- => M.Map YAML.Node YAML.Node
+ => M.Map (YAML.Node YE.Pos) (YAML.Node YE.Pos)
-> MarkdownParser m (F (M.Map String MetaValue))
yamlMap o = do
kvs <- forM (M.toList o) $ \(key, v) -> do
diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs
index af504a5e4..6d091bf92 100644
--- a/src/Text/Pandoc/Translations.hs
+++ b/src/Text/Pandoc/Translations.hs
@@ -76,7 +76,7 @@ instance FromJSON Term where
parseJSON invalid = Aeson.typeMismatch "Term" invalid
instance YAML.FromYAML Term where
- parseYAML (YAML.Scalar (YAML.SStr t)) =
+ parseYAML (YAML.Scalar _ (YAML.SStr t)) =
case safeRead (T.unpack t) of
Just t' -> pure t'
Nothing -> fail $ "Invalid Term name " ++
@@ -99,12 +99,12 @@ instance FromJSON Translations where
instance YAML.FromYAML Translations where
parseYAML = YAML.withMap "Translations" $
\tr -> Translations .M.fromList <$> mapM addItem (M.toList tr)
- where addItem (n@(YAML.Scalar (YAML.SStr k)), v) =
+ where addItem (n@(YAML.Scalar _ (YAML.SStr k)), v) =
case safeRead (T.unpack k) of
Nothing -> YAML.typeMismatch "Term" n
Just t ->
case v of
- (YAML.Scalar (YAML.SStr s)) ->
+ (YAML.Scalar _ (YAML.SStr s)) ->
return (t, T.unpack (T.strip s))
n' -> YAML.typeMismatch "String" n'
addItem (n, _) = YAML.typeMismatch "String" n
@@ -115,6 +115,8 @@ lookupTerm t (Translations tm) = M.lookup t tm
readTranslations :: String -> Either String Translations
readTranslations s =
case YAML.decodeStrict $ UTF8.fromString s of
- Left err' -> Left err'
- Right (t:_) -> Right t
- Right [] -> Left "empty YAML document"
+ Left (pos,err') -> Left $ err' ++
+ " (line " ++ show (YAML.posLine pos) ++ " column " ++
+ show (YAML.posColumn pos) ++ ")"
+ Right (t:_) -> Right t
+ Right [] -> Left "empty YAML document"