diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | pandoc.cabal | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 23 | ||||
| -rw-r--r-- | src/Text/Pandoc/Translations.hs | 14 | ||||
| -rw-r--r-- | stack.yaml | 3 |
5 files changed, 24 insertions, 19 deletions
diff --git a/.gitignore b/.gitignore index e8690c4eb..5248eb2b3 100644 --- a/.gitignore +++ b/.gitignore @@ -24,3 +24,4 @@ data/reference.docx data/reference.odt .stack-work cabal.project.local +/dist-newstyle/ diff --git a/pandoc.cabal b/pandoc.cabal index b550fa1b0..7734f7233 100644 --- a/pandoc.cabal +++ b/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 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" diff --git a/stack.yaml b/stack.yaml index 2c585cf4f..7c29856d4 100644 --- a/stack.yaml +++ b/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 |