Hello community, here is the log from the commit of package ghc-yaml for openSUSE:Factory checked in at 2019-12-27 13:59:22 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-yaml (Old) and /work/SRC/openSUSE:Factory/.ghc-yaml.new.6675 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-yaml" Fri Dec 27 13:59:22 2019 rev:32 rq:759568 version:0.11.2.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-yaml/ghc-yaml.changes 2019-08-29 17:23:38.367306279 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-yaml.new.6675/ghc-yaml.changes 2019-12-27 13:59:22.856832617 +0100 @@ -1,0 +2,20 @@ +Fri Nov 8 16:15:17 UTC 2019 - Peter Simons <psim...@suse.com> + +- Drop obsolete group attributes. + +------------------------------------------------------------------- +Thu Nov 7 06:41:50 UTC 2019 - psim...@suse.com + +- Update yaml to version 0.11.2.0. + ## 0.11.2.0 + + * Reduces some of the code duplication between the `encode` and `encodePretty` functions + * The output of `encodePretty` has been improved: + - Multiline strings now use `Literal` style instead of `SingleQuoted` + - Special keys are now quoted in mappings [#179](https://github.com/snoyberg/yaml/issues/179) + * Support for complex keys in mappings: [#182](https://github.com/snoyberg/yaml/issues/182) + - Adds `complexMapping` function to `Data.Yaml.Builder` + - Decode functions now return a `NonStringKey` error when attempting to decode a mapping with a complex key as it is not possible to decode these to an Aeson `Value` + * Adds missing `ToYaml` instances + +------------------------------------------------------------------- Old: ---- yaml-0.11.1.2.tar.gz New: ---- yaml-0.11.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-yaml.spec ++++++ --- /var/tmp/diff_new_pack.qrGwMV/_old 2019-12-27 13:59:23.316832839 +0100 +++ /var/tmp/diff_new_pack.qrGwMV/_new 2019-12-27 13:59:23.320832841 +0100 @@ -19,11 +19,10 @@ %global pkg_name yaml %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.11.1.2 +Version: 0.11.2.0 Release: 0 Summary: Support for parsing and rendering YAML documents License: BSD-3-Clause -Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel @@ -59,7 +58,6 @@ %package devel Summary: Haskell %{pkg_name} library development files -Group: Development/Libraries/Haskell Requires: %{name} = %{version}-%{release} Requires: ghc-compiler = %{ghc_version} Requires(post): ghc-compiler = %{ghc_version} ++++++ yaml-0.11.1.2.tar.gz -> yaml-0.11.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/ChangeLog.md new/yaml-0.11.2.0/ChangeLog.md --- old/yaml-0.11.1.2/ChangeLog.md 2019-08-26 20:14:53.000000000 +0200 +++ new/yaml-0.11.2.0/ChangeLog.md 2019-11-06 07:13:43.000000000 +0100 @@ -1,5 +1,16 @@ # ChangeLog for yaml +## 0.11.2.0 + +* Reduces some of the code duplication between the `encode` and `encodePretty` functions +* The output of `encodePretty` has been improved: + - Multiline strings now use `Literal` style instead of `SingleQuoted` + - Special keys are now quoted in mappings [#179](https://github.com/snoyberg/yaml/issues/179) +* Support for complex keys in mappings: [#182](https://github.com/snoyberg/yaml/issues/182) + - Adds `complexMapping` function to `Data.Yaml.Builder` + - Decode functions now return a `NonStringKey` error when attempting to decode a mapping with a complex key as it is not possible to decode these to an Aeson `Value` +* Adds missing `ToYaml` instances + ## 0.11.1.2 * Compiles with GHC 8.8.1 (`MonadFail` split) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/src/Data/Yaml/Builder.hs new/yaml-0.11.2.0/src/Data/Yaml/Builder.hs --- old/yaml-0.11.1.2/src/Data/Yaml/Builder.hs 2019-08-23 05:30:58.000000000 +0200 +++ new/yaml-0.11.2.0/src/Data/Yaml/Builder.hs 2019-11-06 07:13:43.000000000 +0100 @@ -9,6 +9,9 @@ , mapping , namedMapping , maybeNamedMapping + , mappingComplex + , namedMappingComplex + , maybeNamedMappingComplex , array , namedArray , maybeNamedArray @@ -37,7 +40,6 @@ import Prelude hiding (null) -import Control.Arrow (second) #if MIN_VERSION_aeson(1,0,0) import Data.Aeson.Text (encodeToTextBuilder) #else @@ -47,10 +49,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import Data.Conduit -import qualified Data.HashSet as HashSet import Data.Scientific (Scientific) import Data.Text (Text, unpack) -import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (toLazyText) @@ -68,119 +69,148 @@ toYaml :: a -> YamlBuilder instance ToYaml YamlBuilder where toYaml = id -instance ToYaml a => ToYaml [(Text, a)] where - toYaml = mapping . map (second toYaml) +instance (ToYaml a, ToYaml b) => ToYaml [(a, b)] where + toYaml = mappingComplex . map (\(k, v) -> (toYaml k, toYaml v)) instance ToYaml a => ToYaml [a] where toYaml = array . map toYaml instance ToYaml Text where toYaml = string +instance ToYaml String where + toYaml = string . T.pack instance ToYaml Int where - toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) IntTag PlainNoTag Nothing:) + toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) NoTag PlainNoTag Nothing:) +instance ToYaml Double where + toYaml i = YamlBuilder (EventScalar (S8.pack $ show i) NoTag PlainNoTag Nothing:) +instance ToYaml Scientific where + toYaml = scientific +instance ToYaml Bool where + toYaml = bool +instance ToYaml a => ToYaml (Maybe a) where + toYaml = maybe null toYaml -- | --- @since 0.11.0 +-- @since 0.10.3.0 maybeNamedMapping :: Maybe Text -> [(Text, YamlBuilder)] -> YamlBuilder -maybeNamedMapping anchor pairs = YamlBuilder $ \rest -> - EventMappingStart NoTag AnyMapping (unpack <$> anchor) : foldr addPair (EventMappingEnd : rest) pairs +maybeNamedMapping anchor pairs = maybeNamedMappingComplex anchor complexPairs where - addPair (key, YamlBuilder value) after - = EventScalar (encodeUtf8 key) StrTag PlainNoTag Nothing - : value after + complexPairs = map (\(k, v) -> (string k, v)) pairs +-- | +-- @since 0.8.7 mapping :: [(Text, YamlBuilder)] -> YamlBuilder mapping = maybeNamedMapping Nothing -- | --- @since 0.11.0 +-- @since 0.10.3.0 namedMapping :: Text -> [(Text, YamlBuilder)] -> YamlBuilder namedMapping name = maybeNamedMapping $ Just name -- | --- @since 0.11.0 +-- @since 0.11.2.0 +maybeNamedMappingComplex :: Maybe Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder +maybeNamedMappingComplex anchor pairs = YamlBuilder $ \rest -> + EventMappingStart NoTag AnyMapping (unpack <$> anchor) : foldr addPair (EventMappingEnd : rest) pairs + where + addPair (YamlBuilder key, YamlBuilder value) after = key $ value after + +-- | +-- @since 0.11.2.0 +mappingComplex :: [(YamlBuilder, YamlBuilder)] -> YamlBuilder +mappingComplex = maybeNamedMappingComplex Nothing + +-- | +-- @since 0.11.2.0 +namedMappingComplex :: Text -> [(YamlBuilder, YamlBuilder)] -> YamlBuilder +namedMappingComplex name = maybeNamedMappingComplex $ Just name + +-- | +-- @since 0.10.3.0 maybeNamedArray :: Maybe Text -> [YamlBuilder] -> YamlBuilder maybeNamedArray anchor bs = YamlBuilder $ (EventSequenceStart NoTag AnySequence (unpack <$> anchor):) . flip (foldr go) bs . (EventSequenceEnd:) where go (YamlBuilder b) = b +-- | +-- @since 0.8.7 array :: [YamlBuilder] -> YamlBuilder array = maybeNamedArray Nothing -- | --- @since 0.11.0 +-- @since 0.10.3.0 namedArray :: Text -> [YamlBuilder] -> YamlBuilder namedArray name = maybeNamedArray $ Just name -- | --- @since 0.11.0 +-- @since 0.10.3.0 maybeNamedString :: Maybe Text -> Text -> YamlBuilder --- Empty strings need special handling to ensure they get quoted. This avoids: --- https://github.com/snoyberg/yaml/issues/24 -maybeNamedString anchor "" = YamlBuilder (EventScalar "" NoTag SingleQuoted (unpack <$> anchor) :) -maybeNamedString anchor s = - YamlBuilder (event :) - where - event - -- Make sure that special strings are encoded as strings properly. - -- See: https://github.com/snoyberg/yaml/issues/31 - | s `HashSet.member` specialStrings || isNumeric s = EventScalar (encodeUtf8 s) NoTag SingleQuoted $ unpack <$> anchor - | otherwise = EventScalar (encodeUtf8 s) StrTag PlainNoTag $ unpack <$> anchor +maybeNamedString anchor s = YamlBuilder (stringScalar defaultStringStyle anchor s :) +-- | +-- @since 0.8.7 string :: Text -> YamlBuilder string = maybeNamedString Nothing -- | --- @since 0.11.0 +-- @since 0.10.3.0 namedString :: Text -> Text -> YamlBuilder namedString name = maybeNamedString $ Just name -- Use aeson's implementation which gets rid of annoying decimal points -- | --- @since 0.11.0 +-- @since 0.10.3.0 maybeNamedScientific :: Maybe Text -> Scientific -> YamlBuilder -maybeNamedScientific anchor n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) IntTag PlainNoTag (unpack <$> anchor) :) +maybeNamedScientific anchor n = YamlBuilder (EventScalar (TE.encodeUtf8 $ TL.toStrict $ toLazyText $ encodeToTextBuilder (Number n)) NoTag PlainNoTag (unpack <$> anchor) :) +-- | +-- @since 0.8.13 scientific :: Scientific -> YamlBuilder scientific = maybeNamedScientific Nothing -- | --- @since 0.11.0 +-- @since 0.10.3.0 namedScientific :: Text -> Scientific -> YamlBuilder namedScientific name = maybeNamedScientific $ Just name +-- | +-- @since 0.8.13 {-# DEPRECATED number "Use scientific" #-} number :: Scientific -> YamlBuilder number = scientific -- | --- @since 0.11.0 +-- @since 0.10.3.0 maybeNamedBool :: Maybe Text -> Bool -> YamlBuilder -maybeNamedBool anchor True = YamlBuilder (EventScalar "true" BoolTag PlainNoTag (unpack <$> anchor) :) -maybeNamedBool anchor False = YamlBuilder (EventScalar "false" BoolTag PlainNoTag (unpack <$> anchor) :) +maybeNamedBool anchor True = YamlBuilder (EventScalar "true" NoTag PlainNoTag (unpack <$> anchor) :) +maybeNamedBool anchor False = YamlBuilder (EventScalar "false" NoTag PlainNoTag (unpack <$> anchor) :) +-- | +-- @since 0.8.13 bool :: Bool -> YamlBuilder bool = maybeNamedBool Nothing -- | --- @since 0.11.0 +-- @since 0.10.3.0 namedBool :: Text -> Bool -> YamlBuilder namedBool name = maybeNamedBool $ Just name -- | --- @since 0.11.0 +-- @since 0.10.3.0 maybeNamedNull :: Maybe Text -> YamlBuilder -maybeNamedNull anchor = YamlBuilder (EventScalar "null" NullTag PlainNoTag (unpack <$> anchor) :) +maybeNamedNull anchor = YamlBuilder (EventScalar "null" NoTag PlainNoTag (unpack <$> anchor) :) +-- | +-- @since 0.8.13 null :: YamlBuilder null = maybeNamedNull Nothing -- | --- @since 0.11.0 +-- @since 0.10.3.0 namedNull :: Text -> YamlBuilder namedNull name = maybeNamedNull $ Just name -- | --- @since 0.11.0 +-- @since 0.10.3.0 alias :: Text -> YamlBuilder alias anchor = YamlBuilder (EventAlias (unpack anchor) :) @@ -191,6 +221,8 @@ toSource :: (Monad m, ToYaml a) => a -> ConduitM i Event m () toSource = mapM_ yield . toEvents . toYaml +-- | +-- @since 0.8.7 toByteString :: ToYaml a => a -> ByteString toByteString = toByteStringWith defaultFormatOptions diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/src/Data/Yaml/Internal.hs new/yaml-0.11.2.0/src/Data/Yaml/Internal.hs --- old/yaml-0.11.1.2/src/Data/Yaml/Internal.hs 2019-08-23 05:30:58.000000000 +0200 +++ new/yaml-0.11.2.0/src/Data/Yaml/Internal.hs 2019-11-06 07:13:43.000000000 +0100 @@ -11,9 +11,14 @@ , parse , decodeHelper , decodeHelper_ + , textToScientific + , stringScalar + , defaultStringStyle + , isSpecialString , specialStrings , isNumeric - , textToScientific + , objToStream + , objToEvents ) where #if !MIN_VERSION_base(4,8,0) @@ -26,11 +31,14 @@ import Control.Monad.State.Strict import Control.Monad.Reader import Data.Aeson -import Data.Aeson.Internal (JSONPath, JSONPathElement(..)) +import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError) import Data.Aeson.Types hiding (parse) import qualified Data.Attoparsec.Text as Atto import Data.Bits (shiftL, (.|.)) import Data.ByteString (ByteString) +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as BL +import Data.ByteString.Builder.Scientific (scientificBuilder) import Data.Char (toUpper, ord) import Data.List import Data.Conduit ((.|), ConduitM, runConduit) @@ -41,10 +49,10 @@ import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set -import Data.Scientific (Scientific) +import Data.Scientific (Scientific, base10Exponent, coefficient) import Data.Text (Text, pack) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import Data.Typeable import qualified Data.Vector as V @@ -60,6 +68,7 @@ | InvalidYaml (Maybe YamlException) | AesonException String | OtherParseException SomeException + | NonStringKey JSONPath | NonStringKeyAlias Y.AnchorName Value | CyclicIncludes | LoadSettingsException FilePath ParseException @@ -108,6 +117,7 @@ ] AesonException s -> "Aeson exception:\n" ++ s OtherParseException exc -> "Generic parse exception:\n" ++ show exc + NonStringKey path -> formatError path "Non-string keys are not supported" NonStringKeyAlias anchor value -> unlines [ "Non-string key alias:" , " Anchor name: " ++ anchor @@ -250,7 +260,9 @@ Nothing -> liftIO $ throwIO $ UnknownAlias an Just (String t) -> return t Just v -> liftIO $ throwIO $ NonStringKeyAlias an v - _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing + _ -> do + path <- ask + liftIO $ throwIO $ NonStringKey path (mergedKeys', al') <- local (Key s :) $ do o <- parseO @@ -301,10 +313,88 @@ Right ((,) (parseStateWarnings st) <$> parseEither parseJSON y) +type StringStyle = Text -> ( Tag, Style ) + +-- | Encodes a string with the supplied style. This function handles the empty +-- string case properly to avoid https://github.com/snoyberg/yaml/issues/24 +-- +-- @since 0.11.2.0 +stringScalar :: StringStyle -> Maybe Text -> Text -> Event +stringScalar _ anchor "" = EventScalar "" NoTag SingleQuoted (T.unpack <$> anchor) +stringScalar stringStyle anchor s = EventScalar (encodeUtf8 s) tag style (T.unpack <$> anchor) + where + ( tag, style ) = stringStyle s + +-- | +-- @since 0.11.2.0 +defaultStringStyle :: StringStyle +defaultStringStyle = \s -> + case () of + () + | "\n" `T.isInfixOf` s -> ( NoTag, Literal ) + | isSpecialString s -> ( NoTag, SingleQuoted ) + | otherwise -> ( NoTag, PlainNoTag ) + +-- | Determine whether a string must be quoted in YAML and can't appear as plain text. +-- Useful if you want to use 'setStringStyle'. +-- +-- @since 0.10.2.0 +isSpecialString :: Text -> Bool +isSpecialString s = s `HashSet.member` specialStrings || isNumeric s + -- | Strings which must be escaped so as not to be treated as non-string scalars. +-- +-- @since 0.8.32 specialStrings :: HashSet.HashSet Text specialStrings = HashSet.fromList $ T.words "y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF null Null NULL ~ *" +-- | +-- @since 0.8.32 isNumeric :: Text -> Bool isNumeric = either (const False) (const True) . textToScientific + +-- | Encode a value as a YAML document stream. +-- +-- @since 0.11.2.0 +objToStream :: ToJSON a => StringStyle -> a -> [Y.Event] +objToStream stringStyle o = + (:) EventStreamStart + . (:) EventDocumentStart + $ objToEvents stringStyle o + [ EventDocumentEnd + , EventStreamEnd + ] + +-- | Encode a value as a list of 'Event's. +-- +-- @since 0.11.2.0 +objToEvents :: ToJSON a => StringStyle -> a -> [Y.Event] -> [Y.Event] +objToEvents stringStyle = objToEvents' . toJSON + where + objToEvents' (Array list) rest = + EventSequenceStart NoTag AnySequence Nothing + : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list) + + objToEvents' (Object o) rest = + EventMappingStart NoTag AnyMapping Nothing + : foldr pairToEvents (EventMappingEnd : rest) (M.toList o) + where + pairToEvents :: Pair -> [Y.Event] -> [Y.Event] + pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v + + objToEvents' (String s) rest = stringScalar stringStyle Nothing s : rest + + objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest + + objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest + objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest + + objToEvents' (Number s) rest = + let builder + -- Special case the 0 exponent to remove the trailing .0 + | base10Exponent s == 0 = BB.integerDec $ coefficient s + | otherwise = scientificBuilder s + lbs = BB.toLazyByteString builder + bs = BL.toStrict lbs + in EventScalar bs IntTag PlainNoTag Nothing : rest diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/src/Data/Yaml/Pretty.hs new/yaml-0.11.2.0/src/Data/Yaml/Pretty.hs --- old/yaml-0.11.1.2/src/Data/Yaml/Pretty.hs 2019-08-23 05:30:58.000000000 +0200 +++ new/yaml-0.11.2.0/src/Data/Yaml/Pretty.hs 2019-11-06 07:13:43.000000000 +0100 @@ -10,6 +10,7 @@ , getConfDropNull , setConfDropNull , defConfig + , pretty ) where import Prelude hiding (null) @@ -34,7 +35,7 @@ -- @since 0.8.13 data Config = Config { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects - , confDropNull :: Bool + , confDropNull :: Bool -- ^ Drop null values from objects } -- | The default configuration: do not sort objects or drop keys diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/src/Data/Yaml.hs new/yaml-0.11.2.0/src/Data/Yaml.hs --- old/yaml-0.11.1.2/src/Data/Yaml.hs 2019-08-26 19:52:52.000000000 +0200 +++ new/yaml-0.11.2.0/src/Data/Yaml.hs 2019-11-06 07:13:43.000000000 +0100 @@ -72,6 +72,7 @@ , isSpecialString , EncodeOptions , defaultEncodeOptions + , defaultStringStyle , setStringStyle , setFormat , FormatOptions @@ -94,18 +95,10 @@ , Object, Array , withObject, withText, withArray, withScientific, withBool ) -import qualified Data.Scientific as S -import qualified Data.ByteString.Builder.Scientific -import Data.Aeson.Types (Pair, parseMaybe, parseEither, Parser) +import Data.Aeson.Types (parseMaybe, parseEither, Parser) import Data.ByteString (ByteString) -import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Lazy as BL import Data.Conduit ((.|), runConduitRes) import qualified Data.Conduit.List as CL -import qualified Data.HashMap.Strict as M -import qualified Data.HashSet as HashSet -import Data.Text.Encoding (encodeUtf8) -import qualified Data.Text as T import qualified Data.Vector as V import System.IO.Unsafe (unsafePerformIO) import Data.Text (Text) @@ -114,13 +107,6 @@ import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile, encodeWith, encodeFileWith) import qualified Text.Libyaml as Y --- | --- @since 0.10.2.0 -data EncodeOptions = EncodeOptions - { encodeOptionsStringStyle :: Text -> ( Tag, Style ) - , encodeOptionsFormat :: FormatOptions - } - -- | Set the string style in the encoded YAML. This is a function that decides -- for each string the type of YAML string to output. -- @@ -145,25 +131,18 @@ setFormat :: FormatOptions -> EncodeOptions -> EncodeOptions setFormat f opts = opts { encodeOptionsFormat = f } --- | Determine whether a string must be quoted in YAML and can't appear as plain text. --- Useful if you want to use 'setStringStyle'. --- +-- | -- @since 0.10.2.0 -isSpecialString :: Text -> Bool -isSpecialString s = s `HashSet.member` specialStrings || isNumeric s +data EncodeOptions = EncodeOptions + { encodeOptionsStringStyle :: Text -> ( Tag, Style ) + , encodeOptionsFormat :: FormatOptions + } -- | -- @since 0.10.2.0 defaultEncodeOptions :: EncodeOptions defaultEncodeOptions = EncodeOptions - { encodeOptionsStringStyle = \s -> - -- Empty strings need special handling to ensure they get quoted. This avoids: - -- https://github.com/snoyberg/yaml/issues/24 - case () of - () - | "\n" `T.isInfixOf` s -> ( NoTag, Literal ) - | isSpecialString s -> ( NoTag, SingleQuoted ) - | otherwise -> ( StrTag, PlainNoTag ) + { encodeOptionsStringStyle = defaultStringStyle , encodeOptionsFormat = defaultFormatOptions } @@ -176,7 +155,7 @@ -- @since 0.10.2.0 encodeWith :: ToJSON a => EncodeOptions -> a -> ByteString encodeWith opts obj = unsafePerformIO $ runConduitRes - $ CL.sourceList (objToEvents opts $ toJSON obj) + $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj) .| Y.encodeWith (encodeOptionsFormat opts) -- | Encode a value into its YAML representation and save to the given file. @@ -188,53 +167,9 @@ -- @since 0.10.2.0 encodeFileWith :: ToJSON a => EncodeOptions -> FilePath -> a -> IO () encodeFileWith opts fp obj = runConduitRes - $ CL.sourceList (objToEvents opts $ toJSON obj) + $ CL.sourceList (objToStream (encodeOptionsStringStyle opts) $ toJSON obj) .| Y.encodeFileWith (encodeOptionsFormat opts) fp -objToEvents :: EncodeOptions -> Value -> [Y.Event] -objToEvents opts o = (:) EventStreamStart - . (:) EventDocumentStart - $ objToEvents' o - [ EventDocumentEnd - , EventStreamEnd - ] - where - objToEvents' :: Value -> [Y.Event] -> [Y.Event] - --objToEvents' (Scalar s) rest = scalarToEvent s : rest - objToEvents' (Array list) rest = - EventSequenceStart NoTag AnySequence Nothing - : foldr objToEvents' (EventSequenceEnd : rest) (V.toList list) - objToEvents' (Object pairs) rest = - EventMappingStart NoTag AnyMapping Nothing - : foldr pairToEvents (EventMappingEnd : rest) (M.toList pairs) - - objToEvents' (String "") rest = EventScalar "" NoTag SingleQuoted Nothing : rest - - objToEvents' (String s) rest = EventScalar (encodeUtf8 s) tag style Nothing : rest - where - ( tag, style ) = encodeOptionsStringStyle opts s - objToEvents' Null rest = EventScalar "null" NullTag PlainNoTag Nothing : rest - objToEvents' (Bool True) rest = EventScalar "true" BoolTag PlainNoTag Nothing : rest - objToEvents' (Bool False) rest = EventScalar "false" BoolTag PlainNoTag Nothing : rest - - objToEvents' (Number s) rest = - let builder - -- Special case the 0 exponent to remove the trailing .0 - | S.base10Exponent s == 0 = BB.integerDec $ S.coefficient s - | otherwise = Data.ByteString.Builder.Scientific.scientificBuilder s - lbs = BB.toLazyByteString builder - bs = BL.toStrict lbs - in EventScalar bs IntTag PlainNoTag Nothing : rest - - pairToEvents :: Pair -> [Y.Event] -> [Y.Event] - pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v - -{- FIXME -scalarToEvent :: YamlScalar -> Event -scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing --} - - decode :: FromJSON a => ByteString -> Maybe a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/test/Data/YamlSpec.hs new/yaml-0.11.2.0/test/Data/YamlSpec.hs --- old/yaml-0.11.1.2/test/Data/YamlSpec.hs 2019-08-23 06:18:43.000000000 +0200 +++ new/yaml-0.11.2.0/test/Data/YamlSpec.hs 2019-11-06 07:13:43.000000000 +0100 @@ -27,6 +27,8 @@ import Test.Mockery.Directory import qualified Data.Yaml as D +import qualified Data.Yaml.Builder as B +import qualified Data.Yaml.Internal as Internal import qualified Data.Yaml.Pretty as Pretty import Data.Yaml (object, array, (.=)) import Data.Maybe @@ -53,17 +55,39 @@ deriveJSON defaultOptions ''TestJSON +testJSON :: TestJSON +testJSON = TestJSON + { string = "str" + , number = 2 + , anArray = V.fromList ["a", "b"] + , hash = HM.fromList [("key1", "value1"), ("key2", "value2")] + , extrastring = "1234-foo" + } + shouldDecode :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> a -> IO () shouldDecode bs expected = do - actual <- D.decodeThrow bs - actual `shouldBe` expected + actual <- D.decodeThrow bs + actual `shouldBe` expected + +shouldDecodeEvents :: B8.ByteString -> [Y.Event] -> IO () +shouldDecodeEvents bs expected = do + actual <- runConduitRes $ Y.decode bs .| CL.consume + map anyStyle actual `shouldBe` map anyStyle expected + +anyStyle :: Y.Event -> Y.Event +anyStyle (Y.EventScalar bs tag _ anchor) = Y.EventScalar bs tag Y.Any anchor +anyStyle (Y.EventSequenceStart tag _ anchor) = Y.EventSequenceStart tag Y.AnySequence anchor +anyStyle (Y.EventMappingStart tag _ anchor) = Y.EventMappingStart tag Y.AnyMapping anchor +anyStyle event = event testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString -testEncodeWith opts es = runConduitRes (CL.sourceList events .| Y.encodeWith opts) - where - events = - [Y.EventStreamStart, Y.EventDocumentStart] ++ es ++ - [Y.EventDocumentEnd, Y.EventStreamEnd] +testEncodeWith opts es = runConduitRes $ CL.sourceList (eventStream es) .| Y.encodeWith opts + +eventStream :: [Y.Event] -> [Y.Event] +eventStream events = + [Y.EventStreamStart, Y.EventDocumentStart] + ++ events + ++ [Y.EventDocumentEnd, Y.EventStreamEnd] main :: IO () main = hspec spec @@ -86,6 +110,7 @@ it "count scalars" caseCountScalars it "largest string" caseLargestString it "encode/decode" caseEncodeDecode + it "encode/decode events" caseEncodeDecodeEvents it "encode/decode file" caseEncodeDecodeFile it "interleaved encode/decode" caseInterleave it "decode invalid document (without segfault)" caseDecodeInvalidDocument @@ -101,6 +126,9 @@ it "encode/decode" caseEncodeDecodeDataPretty it "encode/decode strings" caseEncodeDecodeStringsPretty it "processes datatypes" caseDataTypesPretty + describe "Data.Yaml.Builder" $ do + it "encode/decode" caseEncodeDecodeDataBuilder + it "encode/decode complex mapping" caseEncodeDecodeComplexMappingBuilder describe "Data.Yaml aliases" $ do it "simple scalar alias" caseSimpleScalarAlias it "simple sequence alias" caseSimpleSequenceAlias @@ -159,13 +187,7 @@ describe "decodeFileEither" $ do it "loads YAML through JSON into Haskell data" $ do tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml" - tj `shouldBe` TestJSON - { string = "str" - , number = 2 - , anArray = V.fromList ["a", "b"] - , hash = HM.fromList [("key1", "value1"), ("key2", "value2")] - , extrastring = "1234-foo" - } + tj `shouldBe` testJSON context "when file does not exist" $ do it "returns Left" $ do @@ -188,18 +210,9 @@ it "truncates files" caseTruncatesFiles - it "quoting keys #137" $ do - let keys = T.words "true false NO YES 1.2 1e5 null" - bs = D.encode $ M.fromList $ map (, ()) keys - text = decodeUtf8 bs - forM_ keys $ \key -> do - let quoted = T.concat ["'", key, "'"] - unless (quoted `T.isInfixOf` text) $ error $ concat - [ "Could not find quoted key: " - , T.unpack quoted - , "\n\n" - , T.unpack text - ] :: IO () + it "encode quotes special keys #137" $ caseSpecialKeys D.encode + + it "encodePretty quotes special keys #179" $ caseSpecialKeys (Pretty.encodePretty Pretty.defConfig) describe "non-decimal numbers #135" $ do let go str val = it str $ encodeUtf8 (T.pack str) `shouldDecode` val @@ -479,6 +492,13 @@ yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n" yamlBS = B8.pack yamlString +caseEncodeDecodeEvents :: Assertion +caseEncodeDecodeEvents = do + let events = Internal.objToEvents D.defaultStringStyle testJSON [] + result <- Internal.decodeHelper_ . CL.sourceList $ eventStream events + let (_, value) = either (error . show) id result + value @?= testJSON + caseEncodeDecodeFile :: Assertion caseEncodeDecodeFile = withFile "" $ \tmpPath -> do eList <- runConduitRes $ Y.decodeFile filePath .| CL.consume @@ -528,6 +548,24 @@ , ("bar3", D.String "") ] , D.String "" + , D.Number 1 + , D.Number 0.1 + , D.Bool True + , D.Null + ] + +sampleBuilder :: B.YamlBuilder +sampleBuilder = B.array + [ B.string "foo" + , B.mapping + [ ("bar1", B.string "bar2") + , ("bar3", B.string "") + ] + , B.string "" + , B.scientific 1 + , B.scientific 0.1 + , B.bool True + , B.null ] caseEncodeDecodeData :: Assertion @@ -537,6 +575,28 @@ caseEncodeDecodeDataPretty = Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample +caseEncodeDecodeDataBuilder :: Assertion +caseEncodeDecodeDataBuilder = do + let events = B.unYamlBuilder sampleBuilder [] + bs <- testEncodeWith Y.defaultFormatOptions events + bs `shouldDecodeEvents` eventStream events + +caseEncodeDecodeComplexMappingBuilder :: Assertion +caseEncodeDecodeComplexMappingBuilder = do + let events = B.unYamlBuilder builder [] + bs <- testEncodeWith Y.defaultFormatOptions events + bs `shouldDecodeEvents` eventStream events + where + builder :: B.YamlBuilder + builder = B.mappingComplex + [ ( B.mapping + [ ("foo", B.scientific 1) + , ("bar", B.scientific 2) + ] + , B.bool True + ) + ] + caseEncodeDecodeFileData :: Assertion caseEncodeDecodeFileData = withFile "" $ \fp -> do D.encodeFile fp sample @@ -737,6 +797,19 @@ res <- D.decodeFileEither fp either (Left . show) Right res `shouldBe` Right val +caseSpecialKeys :: (HashMap Text () -> B8.ByteString) -> Assertion +caseSpecialKeys encoder = do + let keys = T.words "true false NO YES 1.2 1e5 null" + bs = encoder $ M.fromList $ map (, ()) keys + text = decodeUtf8 bs + forM_ keys $ \key -> do + let quoted = T.concat ["'", key, "'"] + unless (quoted `T.isInfixOf` text) $ error $ concat + [ "Could not find quoted key: " + , T.unpack quoted + , "\n\n" + , T.unpack text + ] :: IO () taggedSequence :: [Y.Event] taggedSequence = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/yaml-0.11.1.2/yaml.cabal new/yaml-0.11.2.0/yaml.cabal --- old/yaml-0.11.1.2/yaml.cabal 2019-08-26 20:14:42.000000000 +0200 +++ new/yaml-0.11.2.0/yaml.cabal 2019-11-06 11:13:39.000000000 +0100 @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: fd80752d31072e9d0302c6aab5e524dff535a5e9d72ff7b14a2c1bd0e8cdc86a +-- hash: 1755dcdb4772fa7e743958ba68b120522981238fdcdac9fdc7494a36809ff6ae name: yaml -version: 0.11.1.2 +version: 0.11.2.0 synopsis: Support for parsing and rendering YAML documents. description: README and API documentation are available at <https://www.stackage.org/package/yaml> category: Data
