diff options
Diffstat (limited to 'src/Text')
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 23 | ||||
| -rw-r--r-- | src/Text/Pandoc/Translations.hs | 14 |
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" |