Use HsYAML-0.2.0.0

Most of this is due to @vijayphoenix (#5704), but it
needed some revisions to integrate with current
master, and to use the released HsYAML.

Closes #5704.

.gitignore

@@ -24,3 +24,4 @@ data/reference.docx
 data/reference.odt
 .stack-work
 cabal.project.local
+/dist-newstyle/

pandoc.cabal

@@ -421,7 +421,7 @@ library
                  http-types >= 0.8 && < 0.13,
                  case-insensitive >= 1.2 && < 1.3,
                  unicode-transforms >= 0.3 && < 0.4,
-                 HsYAML >= 0.1.1.1 && < 0.2,
+                 HsYAML >= 0.2 && < 0.3,
                  doclayout >= 0.1 && < 0.2,
                  ipynb >= 0.1 && < 0.2,
                  attoparsec >= 0.12 && < 0.14

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 :: Monad m => YAML.Node YE.Pos -> m Text
-nodeToKey (YAML.Scalar (YAML.SStr t))       = return t
+nodeToKey (YAML.Scalar _ (YAML.SStr t))       = return t
-nodeToKey (YAML.Scalar (YAML.SUnknown _ 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)
+                => YAML.Node YE.Pos-> MarkdownParser m (F MetaValue)
-yamlToMetaValue (YAML.Scalar x) =
+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

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'
+       Left (pos,err') -> Left $ err' ++
-       Right (t:_) -> Right t
+           " (line " ++ show (YAML.posLine pos) ++ " column " ++
-       Right []    -> Left "empty YAML document"
+           show (YAML.posColumn pos) ++ ")"
+       Right (t:_)     -> Right t
+       Right []        -> Left "empty YAML document"

stack.yaml

@@ -25,7 +25,8 @@ extra-deps:
 - skylighting-core-0.8.2
 - skylighting-0.8.2
 - doclayout-0.1
-  #- doctemplates-0.6
+- HsYAML-0.2.0.0
+#- doctemplates-0.6
 ghc-options:
    "$locals": -fhide-source-paths -Wno-missing-home-modules
 resolver: lts-13.17