yaml 0.11.6.0 → 0.11.11.2
raw patch · 9 files changed
Files
- ChangeLog.md +28/−0
- exe/json2yaml.hs +3/−3
- exe/yaml2json.hs +2/−2
- src/Data/Yaml/Config.hs +24/−8
- src/Data/Yaml/Internal.hs +45/−12
- src/Data/Yaml/Pretty.hs +18/−2
- test/Data/Yaml/IncludeSpec.hs +5/−0
- test/Data/YamlSpec.hs +32/−5
- yaml.cabal +10/−10
ChangeLog.md view
@@ -1,5 +1,33 @@ # ChangeLog for yaml +## 0.11.11.2++* Compat with aeson 2.2++## 0.11.11.1++* For optparse-applicative-0.18: use `pretty` instead of `text` [#216](https://github.com/snoyberg/yaml/pull/216)++## 0.11.11.0++* Fix ambiguous occurrence `AesonException`++## 0.11.10.0++* Undo previous change (breakage with aeson 2)++## 0.11.9.0++* Data.Yaml.Pretty: provide key-sorting function with path to parent object [#206](https://github.com/snoyberg/yaml/pull/206)++## 0.11.8.0++* Export `Parse` and `StringStyle` [#204](https://github.com/snoyberg/yaml/pull/204)++## 0.11.7.0++* Support `aeson` 2 [#202](https://github.com/snoyberg/yaml/pull/202)+ ## 0.11.6.0 * `yaml2json`: add `--help` and `--version` options [#197](https://github.com/snoyberg/yaml/pull/197)
exe/json2yaml.hs view
@@ -15,7 +15,7 @@ , long, metavar, short, strArgument, strOption, value ) import Options.Applicative.Help.Pretty- ( vcat, text )+ ( vcat, pretty ) import System.Exit ( die ) @@ -43,11 +43,11 @@ <> footerDoc fdoc where- hdoc = Just $ vcat $ map text+ hdoc = Just $ vcat $ map pretty [ versionText self , "Convert JSON to YAML." ]- fdoc = Just $ text $ concat+ fdoc = Just $ pretty $ concat [ "The old call pattern '" , self , " IN OUT' is also accepted, but deprecated."
exe/yaml2json.hs view
@@ -17,7 +17,7 @@ , long, metavar, short, strArgument, strOption, value ) import Options.Applicative.Help.Pretty- ( vcat, text )+ ( vcat, pretty ) import Common ( versionText, versionOption, numericVersionOption, dashToNothing )@@ -43,7 +43,7 @@ (headerDoc hdoc) where- hdoc = Just $ vcat $ map text+ hdoc = Just $ vcat $ map pretty [ versionText self , "Convert YAML to JSON." ]
src/Data/Yaml/Config.hs view
@@ -33,7 +33,13 @@ import Data.Semigroup import Data.List.NonEmpty (nonEmpty) import Data.Aeson+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as H+import Data.Aeson.KeyMap (KeyMap)+#else import qualified Data.HashMap.Strict as H+#endif import Data.Text (Text, pack) import System.Environment (getArgs, getEnvironment) import Control.Arrow ((***))@@ -45,6 +51,16 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T +#if MIN_VERSION_aeson(2,0,0)+fromText :: T.Text -> Key+fromText = K.fromText+#else+fromText :: T.Text -> T.Text+fromText = id++type KeyMap a = H.HashMap T.Text a+#endif+ newtype MergedValue = MergedValue { getMergedValue :: Value } instance Semigroup MergedValue where@@ -64,7 +80,7 @@ -- -- @since 0.8.16 applyEnvValue :: Bool -- ^ require an environment variable to be present?- -> H.HashMap Text Text -> Value -> Value+ -> KeyMap Text -> Value -> Value applyEnvValue requireEnv' env = goV where@@ -74,7 +90,7 @@ t2 <- T.stripPrefix "_env:" t1 let (name, t3) = T.break (== ':') t2 mdef = fmap parseValue $ T.stripPrefix ":" t3- Just $ case H.lookup name env of+ Just $ case H.lookup (fromText name) env of Just val -> -- If the default value parses as a String, we treat the -- environment variable as a raw value and do not parse it.@@ -101,8 +117,8 @@ -- | Get the actual environment as a @HashMap@ from @Text@ to @Text@. -- -- @since 0.8.16-getCurrentEnv :: IO (H.HashMap Text Text)-getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment+getCurrentEnv :: IO (KeyMap Text)+getCurrentEnv = fmap (H.fromList . map (fromText . pack *** pack)) getEnvironment -- | A convenience wrapper around 'applyEnvValue' and 'getCurrentEnv' --@@ -118,8 +134,8 @@ data EnvUsage = IgnoreEnv | UseEnv | RequireEnv- | UseCustomEnv (H.HashMap Text Text)- | RequireCustomEnv (H.HashMap Text Text)+ | UseCustomEnv (KeyMap Text)+ | RequireCustomEnv (KeyMap Text) -- | Do not use any environment variables, instead relying on defaults values -- in the config file.@@ -146,14 +162,14 @@ -- @HashMap@ as the environment. -- -- @since 0.8.16-useCustomEnv :: H.HashMap Text Text -> EnvUsage+useCustomEnv :: KeyMap Text -> EnvUsage useCustomEnv = UseCustomEnv -- | Same as 'requireEnv', but instead of the actual environment, use the -- provided @HashMap@ as the environment. -- -- @since 0.8.16-requireCustomEnv :: H.HashMap Text Text -> EnvUsage+requireCustomEnv :: KeyMap Text -> EnvUsage requireCustomEnv = RequireCustomEnv -- | Load the settings from the following three sources:
src/Data/Yaml/Internal.hs view
@@ -9,12 +9,14 @@ , prettyPrintParseException , Warning(..) , parse+ , Parse , decodeHelper , decodeHelper_ , decodeAllHelper , decodeAllHelper_ , textToScientific , stringScalar+ , StringStyle , defaultStringStyle , isSpecialString , specialStrings@@ -32,9 +34,24 @@ import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.State.Strict import Control.Monad.Reader+#if MIN_VERSION_aeson(2,1,2)+import Data.Aeson hiding (AesonException)+#else import Data.Aeson-import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError)+#endif+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as M+import Data.Aeson.KeyMap (KeyMap)+#else+import qualified Data.HashMap.Strict as M+#endif+#if MIN_VERSION_aeson(2,2,0)+import Data.Aeson.Types hiding (AesonException, parse)+#else import Data.Aeson.Types hiding (parse)+import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError)+#endif import qualified Data.Attoparsec.Text as Atto import Data.Bits (shiftL, (.|.)) import Data.ByteString (ByteString)@@ -42,17 +59,16 @@ import qualified Data.ByteString.Lazy as BL import Data.ByteString.Builder.Scientific (scientificBuilder) import Data.Char (toUpper, ord)-import Data.List+import qualified Data.List as List import Data.Conduit ((.|), ConduitM, runConduit) import qualified Data.Conduit.List as CL-import qualified Data.HashMap.Strict as M import qualified Data.HashSet as HashSet import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Data.Scientific (Scientific, base10Exponent, coefficient)-import Data.Text (Text, pack)+import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode)@@ -63,6 +79,23 @@ import qualified Text.Libyaml as Y import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile) +#if MIN_VERSION_aeson(2,0,0)+fromText :: T.Text -> K.Key+fromText = K.fromText++toText :: K.Key -> T.Text+toText = K.toText+#else+fromText :: T.Text -> T.Text+fromText = id++toText :: Key -> T.Text+toText = id++type KeyMap a = M.HashMap Text a+type Key = Text+#endif+ data ParseException = NonScalarKey | UnknownAlias { _anchorName :: Y.AnchorName } | UnexpectedEvent { _received :: Maybe Event@@ -255,9 +288,9 @@ o <- local (Index n :) parseO parseS (succ n) a $ front . (:) o -parseM :: Set Text+parseM :: Set Key -> Y.Anchor- -> M.HashMap Text Value+ -> KeyMap Value -> ReaderT JSONPath (ConduitM Event o Parse) Value parseM mergedKeys a front = do me <- lift CL.head@@ -268,12 +301,12 @@ return res _ -> do s <- case me of- Just (EventScalar v tag style a') -> parseScalar v a' style tag+ Just (EventScalar v tag style a') -> fromText <$> parseScalar v a' style tag Just (EventAlias an) -> do m <- lookupAnchor an case m of Nothing -> liftIO $ throwIO $ UnknownAlias an- Just (String t) -> return t+ Just (String t) -> return $ fromText t Just v -> liftIO $ throwIO $ NonStringKeyAlias an v _ -> do path <- ask@@ -286,17 +319,17 @@ path <- reverse <$> ask addWarning (DuplicateKey path) return (Set.delete s mergedKeys, M.insert s o front)- if s == pack "<<"+ if s == "<<" then case o of Object l -> return (merge l)- Array l -> return $ merge $ foldl' mergeObjects M.empty $ V.toList l+ Array l -> return $ merge $ List.foldl' mergeObjects M.empty $ V.toList l _ -> al else al parseM mergedKeys' a al' where mergeObjects al (Object om) = M.union al om mergeObjects al _ = al - merge xs = (Set.fromList (M.keys xs \\ M.keys front), M.union front xs)+ merge xs = (Set.fromList (M.keys xs List.\\ M.keys front), M.union front xs) parseSrc :: ReaderT JSONPath (ConduitM Event Void Parse) val -> ConduitM () Event Parse ()@@ -417,7 +450,7 @@ : foldr pairToEvents (EventMappingEnd : rest) (M.toList o) where pairToEvents :: Pair -> [Y.Event] -> [Y.Event]- pairToEvents (k, v) = objToEvents' (String k) . objToEvents' v+ pairToEvents (k, v) = objToEvents' (String $ toText k) . objToEvents' v objToEvents' (String s) rest = stringScalar stringStyle Nothing s : rest
src/Data/Yaml/Pretty.hs view
@@ -18,10 +18,16 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif+import Data.Bifunctor (first)+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.Key as K+import qualified Data.Aeson.KeyMap as HM+#else+import qualified Data.HashMap.Strict as HM+#endif import Data.Aeson.Types import Data.ByteString (ByteString) import Data.Function (on)-import qualified Data.HashMap.Strict as HM import Data.List (sortBy) #if !MIN_VERSION_base(4,8,0) import Data.Monoid@@ -31,6 +37,16 @@ import Data.Yaml.Builder +#if MIN_VERSION_aeson(2,0,0)+toText :: Key -> Text+toText = K.toText+#else+toText :: Key -> Text+toText = id++type Key = Text+#endif+ -- | -- @since 0.8.13 data Config = Config@@ -72,7 +88,7 @@ select | confDropNull cfg = HM.filter (/= Null) | otherwise = id- in mapping (sort $ HM.toList $ HM.map go $ select o)+ in mapping (sort $ fmap (first toText) $ HM.toList $ HM.map go $ select o) go (Array a) = array (go <$> V.toList a) go Null = null go (String s) = string s
test/Data/Yaml/IncludeSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} module Data.Yaml.IncludeSpec (main, spec) where@@ -6,7 +7,11 @@ import Data.List (isPrefixOf) import qualified Data.ByteString.Lazy as LB import Data.Aeson+#if MIN_VERSION_aeson(2,2,0)+import Data.Aeson.Types (JSONPathElement(..))+#else import Data.Aeson.Internal (JSONPathElement(..))+#endif import Data.Yaml (ParseException(InvalidYaml)) import Data.Yaml.Include import Data.Yaml.Internal
test/Data/YamlSpec.hs view
@@ -32,10 +32,18 @@ import qualified Data.Yaml.Pretty as Pretty import Data.Yaml (object, array, (.=)) import Data.Maybe+import qualified Data.HashMap.Strict as HM+#if MIN_VERSION_aeson(2,0,0)+import qualified Data.Aeson.KeyMap as M+import qualified Data.Aeson.Key as K+import Data.Aeson.KeyMap (KeyMap)+#else import qualified Data.HashMap.Strict as M+#endif import qualified Data.Text as T import Data.Aeson.TH import Data.Scientific (Scientific)+import Data.String (fromString) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Vector (Vector)@@ -45,6 +53,23 @@ import System.IO (hClose) import System.IO.Temp (withSystemTempFile) +#if MIN_VERSION_aeson(2,0,0)+fromText :: T.Text -> K.Key+fromText = K.fromText++toText :: K.Key -> T.Text+toText = K.toText+#else+fromText :: T.Text -> T.Text+fromText = id++toText :: Key -> T.Text+toText = id++type KeyMap a = M.HashMap Text a+type Key = Text+#endif+ data TestJSON = TestJSON { string :: Text , number :: Int@@ -179,7 +204,7 @@ describe "special keys" $ do let tester key = it (T.unpack key) $- let value = object [key .= True]+ let value = object [fromText key .= True] in D.encode value `shouldDecode` value mapM_ tester specialStrings @@ -551,7 +576,7 @@ mkStrScalar = D.String . T.pack mappingKey :: D.Value-> String -> D.Value-mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)+mappingKey (D.Object m) k = (fromJust . M.lookup (fromText $ T.pack k) $ m) mappingKey _ _ = error "expected Object" sample :: D.Value@@ -658,7 +683,9 @@ caseSimpleMappingAlias :: Assertion caseSimpleMappingAlias = "map: &anch\n key1: foo\n key2: baz\nmap2: *anch" `shouldDecode`- object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]+ object [(packStr "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (packStr "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]+ where+ packStr = fromText . T.pack caseMappingAliasBeforeAnchor :: Assertion caseMappingAliasBeforeAnchor =@@ -811,10 +838,10 @@ res <- D.decodeFileEither fp either (Left . show) Right res `shouldBe` Right val -caseSpecialKeys :: (HashMap Text () -> B8.ByteString) -> Assertion+caseSpecialKeys :: (KeyMap () -> B8.ByteString) -> Assertion caseSpecialKeys encoder = do let keys = T.words "true false NO YES 1.2 1e5 null"- bs = encoder $ M.fromList $ map (, ()) keys+ bs = encoder $ M.fromList $ map (, ()) $ fmap fromText keys text = decodeUtf8 bs forM_ keys $ \key -> do let quoted = T.concat ["'", key, "'"]
yaml.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: yaml-version: 0.11.6.0+version: 0.11.11.2 synopsis: Support for parsing and rendering YAML documents. description: README and API documentation are available at <https://www.stackage.org/package/yaml> category: Data@@ -74,7 +74,7 @@ , filepath , libyaml ==0.1.* , mtl- , resourcet >=0.3 && <1.3+ , resourcet >=0.3 && <1.4 , scientific >=0.3 , template-haskell , text@@ -103,20 +103,20 @@ , filepath , libyaml ==0.1.* , mtl- , resourcet >=0.3 && <1.3+ , resourcet >=0.3 && <1.4 , scientific >=0.3 , template-haskell , text , transformers >=0.1 , unordered-containers , vector+ default-language: Haskell2010 if flag(no-examples) buildable: False else build-depends: raw-strings-qq , yaml- default-language: Haskell2010 executable json2yaml main-is: json2yaml.hs@@ -138,7 +138,7 @@ , libyaml ==0.1.* , mtl , optparse-applicative- , resourcet >=0.3 && <1.3+ , resourcet >=0.3 && <1.4 , scientific >=0.3 , template-haskell , text@@ -146,9 +146,9 @@ , unordered-containers , vector , yaml+ default-language: Haskell2010 if flag(no-exe) buildable: False- default-language: Haskell2010 executable yaml2json main-is: yaml2json.hs@@ -174,7 +174,7 @@ , libyaml ==0.1.* , mtl , optparse-applicative- , resourcet >=0.3 && <1.3+ , resourcet >=0.3 && <1.4 , scientific >=0.3 , template-haskell , text@@ -182,9 +182,9 @@ , unordered-containers , vector , yaml+ default-language: Haskell2010 if flag(no-exe) buildable: False- default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0@@ -214,7 +214,7 @@ , mockery , mtl , raw-strings-qq- , resourcet >=0.3 && <1.3+ , resourcet >=0.3 && <1.4 , scientific >=0.3 , template-haskell , temporary