From 317ba697c42cdbfc94cb3b0e5558f816cd756af6 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 12 Oct 2026 18:14:31 -0700 Subject: [PATCH] Use yamlet for YAML parsing. Pandoc parsed YAML with the yaml package, which depends on the C library libyaml. It now uses yamlet, a pure Haskell YAML 1.2 parser. Values still go through the existing aeson instances. Behavior changes: - YAML errors show the file, the line and the column, with the offending line. In metadata blocks the line is the line in the document. - `yes`, `no`, `on`, `off`, `y` and `n` are strings, not booleans, as in YAML 1.2. This restores the behavior before the switch from HsYAML. - Duplicate keys in a mapping are an error. They were a warning. - .5, .inf and .nan are numbers. Text.Pandoc.Translations: readTranslations takes the path of the file, for error messages [API change]. --- pandoc.cabal | 4 +- src/Text/Pandoc/App/Opt.hs | 17 +++++--- src/Text/Pandoc/Readers/Metadata.hs | 67 +++++++++++++---------------- src/Text/Pandoc/Translations.hs | 29 +++++++------ stack.yaml | 6 +++ test/command/4819.md | 4 +- 6 files changed, 65 insertions(+), 62 deletions(-) diff --git a/pandoc.cabal b/pandoc.cabal index 69c76db60..5a5054fdb 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -580,8 +580,8 @@ library unicode-collation >= 0.1.1 && < 0.2, unicode-data >= 0.6 && < 0.10, unicode-transforms >= 0.3 && < 0.5, - yaml >= 0.11 && < 0.12, - libyaml >= 0.1.4 && < 0.2, + yamlet >= 1.0.0.1 && < 1.1, + yamlet-aeson >= 1.0.0.1 && < 1.1, zip-archive >= 0.5 && < 0.6, zlib >= 0.6 && < 0.8, xml >= 1.3.12 && < 1.4, diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs index c7c644ce9..12915f823 100644 --- a/src/Text/Pandoc/App/Opt.hs +++ b/src/Text/Pandoc/App/Opt.hs @@ -67,11 +67,14 @@ import qualified Data.Text as T import qualified Data.Map as M import qualified Data.ByteString.Char8 as B8 import Text.Pandoc.Definition (Meta(..), MetaValue(..)) -import Data.Aeson (defaultOptions, Options(..), Result(..), - genericToJSON, fromJSON, camelTo2, eitherDecodeStrict) import Data.Aeson.TH (deriveJSON) import Control.Applicative ((<|>)) -import Data.Yaml +import Data.Aeson +import Data.Aeson.Types +import qualified Data.List as L +import qualified Data.List.NonEmpty as NE +import qualified Yamlet as Y +import Yamlet.Aeson -- | The type of line-endings to be used when writing plain-text. data LineEnding = LF | CRLF | Native deriving (Show, Generic) @@ -938,11 +941,11 @@ applyDefaults opt file = do Left err' -> throwError $ PandocParseError $ T.pack $ "Error parsing " <> file <> ":\n" <> err' else - case decodeEither' (B8.unlines . takeWhile (/= "...") . B8.lines $ inp) of - Right f -> f opt - Left err' -> throwError $ PandocParseError $ T.pack $ + case Y.decode (B8.unlines . takeWhile (/= "...") . B8.lines $ inp) of + Right (ViaAeson f) -> f opt + Left errs -> throwError $ PandocParseError $ T.pack $ "Error parsing " <> file <> ":\n" <> - Data.Yaml.prettyPrintParseException err' + L.intercalate "\n" (map (Y.prettyError file) (NE.toList errs)) fullDefaultsPath :: (PandocMonad m, MonadIO m) => Maybe FilePath diff --git a/src/Text/Pandoc/Readers/Metadata.hs b/src/Text/Pandoc/Readers/Metadata.hs index 59e915d50..fa53b3c51 100644 --- a/src/Text/Pandoc/Readers/Metadata.hs +++ b/src/Text/Pandoc/Readers/Metadata.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Readers.Metadata Copyright : Copyright (C) 2006-2024 John MacFarlane @@ -20,24 +21,22 @@ module Text.Pandoc.Readers.Metadata ( import Control.Monad.Except (throwError) import qualified Data.ByteString as B +import qualified Data.List as L import qualified Data.Map as M import qualified Data.Vector as V import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Yaml as Yaml -import qualified Data.Yaml.Internal as Yaml -import qualified Text.Libyaml as Y -import Data.Aeson (Value(..), Object, Result(..), fromJSON, (.:?), withObject, - FromJSON) -import Data.Aeson.Types (formatRelativePath, parse) +import qualified Data.List.NonEmpty as NE +import qualified Yamlet as Y +import Yamlet.Aeson () +import Data.Aeson (Value(..), Object, Result(..), fromJSON, (.:?), withObject) +import Data.Aeson.Types (parse) import Text.Pandoc.Shared (tshow, blocksToInlines) -import Text.Pandoc.Class (PandocMonad (..), report) +import Text.Pandoc.Class (PandocMonad (..)) import Text.Pandoc.Definition import Text.Pandoc.Error -import Text.Pandoc.Logging (LogMessage(YamlWarning)) import Text.Pandoc.Parsing hiding (tableWith, parse) import qualified Text.Pandoc.UTF8 as UTF8 -import System.IO.Unsafe (unsafePerformIO) yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st) => ParsecT Sources st m (Future st MetaValue) @@ -45,37 +44,28 @@ yamlBsToMeta :: (PandocMonad m, HasLastStrPosition st) -> ParsecT Sources st m (Future st Meta) yamlBsToMeta pMetaValue bstr = do pos <- getPosition - case decodeAllWithWarnings bstr of - Right (warnings, xs) -> do - mapM_ (\(Yaml.DuplicateKey jpath) -> - report (YamlWarning pos $ "Duplicate key: " <> - T.pack (formatRelativePath jpath))) - warnings + case Y.decodeAll @Value bstr of + Right xs -> case xs of (Object o : _) -> fmap Meta <$> yamlMap pMetaValue o [Null] -> return . return $ mempty [] -> return . return $ mempty _ -> Prelude.fail "expected YAML object" - Left err' -> do - let msg = T.pack $ "Error parsing YAML metadata at " <> - show pos <> ":\n" <> - Yaml.prettyPrintParseException err' - throwError $ PandocParseError $ - if "did not find expected key" `T.isInfixOf` msg - then msg <> - "\nConsider enclosing the entire field in 'single quotes'" - else msg + Left errs -> throwError $ PandocParseError $ T.pack $ + "Error parsing YAML metadata at " <> show pos <> ":\n" <> + renderYamlErrors pos errs -decodeAllWithWarnings :: FromJSON a - => B.ByteString - -> (Either Yaml.ParseException ([Yaml.Warning], [a])) -decodeAllWithWarnings = either Left (\(ws,res) - -> case res of - Left s -> Left (Yaml.AesonException s) - Right v -> Right (ws, v)) - . unsafePerformIO - . Yaml.decodeAllHelper - . Y.decode +-- | Render the errors with their lines in the source, given the position of +-- the first line of the YAML input. +renderYamlErrors :: SourcePos -> NE.NonEmpty Y.Error -> String +renderYamlErrors pos = + L.intercalate "\n" . map (Y.prettyError (sourceName pos) . shift) . NE.toList + where + shift :: Y.Error -> Y.Error + shift err@Y.Error{Y.location = loc@Y.Location{Y.line = l}} + -- Line 0 means that the error has no position. + | l == 0 = err + | otherwise = err{Y.location = loc{Y.line = l + sourceLine pos - 1}} -- Returns filtered list of references. yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st) @@ -83,8 +73,9 @@ yamlBsToRefs :: (PandocMonad m, HasLastStrPosition st) -> (Text -> Bool) -- ^ Filter for id -> B.ByteString -> ParsecT Sources st m (Future st [MetaValue]) -yamlBsToRefs pMetaValue idpred bstr = - case Yaml.decodeAllEither' bstr of +yamlBsToRefs pMetaValue idpred bstr = do + pos <- getPosition + case Y.decodeAll @Value bstr of Right (Object m : _) -> do case parse (withObject "metadata" (.:? "references")) (Object m) of Success (Just refs) -> sequence <$> @@ -94,8 +85,8 @@ yamlBsToRefs pMetaValue idpred bstr = let refs = filter hasSelectedId $ V.toList v sequence <$> mapM (yamlToMetaValue pMetaValue) (filter hasSelectedId refs) Right _ -> return . return $ [] - Left err' -> throwError $ PandocParseError - $ T.pack $ Yaml.prettyPrintParseException err' + Left errs -> throwError $ PandocParseError + $ T.pack $ renderYamlErrors pos errs where isSelected (String t) = idpred t isSelected _ = False diff --git a/src/Text/Pandoc/Translations.hs b/src/Text/Pandoc/Translations.hs index e48d2c7a3..9270a6bb1 100644 --- a/src/Text/Pandoc/Translations.hs +++ b/src/Text/Pandoc/Translations.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {- | Module : Text.Pandoc.Translations Copyright : Copyright (C) 2017-2024 John MacFarlane @@ -27,18 +28,19 @@ import Data.Containers.ListUtils (nubOrd) import Text.Pandoc.Logging (LogMessage(..)) import Control.Monad.Except (catchError) import qualified Data.Text as T -import qualified Data.Yaml as Yaml -import qualified Text.Pandoc.UTF8 as UTF8 -import Data.Yaml (prettyPrintParseException) +import qualified Data.List.NonEmpty as NE +import qualified Yamlet as Y +import Yamlet.Aeson import Text.Collate.Lang (Lang(..), renderLang) --- | Parse YAML translations. -readTranslations :: T.Text -> Either T.Text Translations -readTranslations s = - case Yaml.decodeAllEither' $ UTF8.fromText s of - Left err' -> Left $ T.pack $ prettyPrintParseException err' - Right (t:_) -> Right t - Right [] -> Left "empty YAML document" +-- | Parse YAML translations. The file path is used in error messages. +readTranslations :: FilePath -> T.Text -> Either T.Text Translations +readTranslations fp s = + case Y.decodeAllText @(ViaAeson Translations) s of + Left errs -> Left $ T.intercalate "\n" $ + map (T.pack . Y.prettyError fp) (NE.toList errs) + Right (ViaAeson t:_) -> Right t + Right [] -> Left $ T.pack fp <> ": empty YAML document" -- | Select the language to use with 'translateTerm'. -- Note that this does not read a translation file; @@ -68,12 +70,11 @@ getTranslations = do let getTrans [] = return mempty getTrans (fp:fps) = do result <- catchError (Right <$> (readDataFile fp >>= toTextM fp)) - (\_ -> pure (Left "")) - case result >>= readTranslations of + (\_ -> pure (Left (T.pack fp))) + case result >>= readTranslations fp of Left e | null fps -> do - report $ CouldNotLoadTranslations (renderLang lang) - (T.pack fp <> ": " <> e) + report $ CouldNotLoadTranslations (renderLang lang) e -- make sure we don't try again... modifyCommonState $ \st -> st{ stTranslations = Nothing } diff --git a/stack.yaml b/stack.yaml index cef42c1d1..d03e6dc81 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,6 +41,12 @@ extra-deps: - typst-0.12 - texmath-0.13.3.1 - citeproc-0.14.1 +- yamlet-1.0.0.1 +- yamlet-aeson-1.0.0.1 +# yamlet and yamlet-aeson need newer versions than the snapshot has: +- aeson-2.2.5.1 +- scientific-0.3.9.0 +- text-iso8601-0.1.1.2 # needed because not yet in nixpkgs: - pandoc-types-1.23.1.2 # needed because not yet in nixpkgs: diff --git a/test/command/4819.md b/test/command/4819.md index 5caa5c6de..c7cd9a90a 100644 --- a/test/command/4819.md +++ b/test/command/4819.md @@ -49,7 +49,9 @@ foo: no ... ^D Pandoc - Meta { unMeta = fromList [ ( "foo" , MetaBool False ) ] } + Meta + { unMeta = fromList [ ( "foo" , MetaInlines [ Str "no" ] ) ] + } [] ```