diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # ChangeLog for yaml +## 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) diff --git a/src/Data/Yaml/Config.hs b/src/Data/Yaml/Config.hs --- a/src/Data/Yaml/Config.hs +++ b/src/Data/Yaml/Config.hs @@ -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: diff --git a/src/Data/Yaml/Internal.hs b/src/Data/Yaml/Internal.hs --- a/src/Data/Yaml/Internal.hs +++ b/src/Data/Yaml/Internal.hs @@ -33,6 +33,13 @@ import Control.Monad.State.Strict import Control.Monad.Reader import Data.Aeson +#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 import Data.Aeson.Internal (JSONPath, JSONPathElement(..), formatError) import Data.Aeson.Types hiding (parse) import qualified Data.Attoparsec.Text as Atto @@ -45,14 +52,13 @@ import Data.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 +69,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 +278,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 +291,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,7 +309,7 @@ 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 @@ -417,7 +440,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 diff --git a/src/Data/Yaml/Pretty.hs b/src/Data/Yaml/Pretty.hs --- a/src/Data/Yaml/Pretty.hs +++ b/src/Data/Yaml/Pretty.hs @@ -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 diff --git a/test/Data/YamlSpec.hs b/test/Data/YamlSpec.hs --- a/test/Data/YamlSpec.hs +++ b/test/Data/YamlSpec.hs @@ -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, "'"] diff --git a/yaml.cabal b/yaml.cabal --- a/yaml.cabal +++ b/yaml.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: yaml -version: 0.11.6.0 +version: 0.11.7.0 synopsis: Support for parsing and rendering YAML documents. description: README and API documentation are available at category: Data