diff --git a/aeson.cabal b/aeson.cabal --- a/aeson.cabal +++ b/aeson.cabal @@ -1,5 +1,5 @@ name: aeson -version: 2.0.0.0 +version: 2.0.1.0 license: BSD3 license-file: LICENSE category: Text, Web, JSON @@ -63,7 +63,7 @@ description: Use ordered @Data.Map.Strict@ for KeyMap implementation. - default: False + default: True manual: True library diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md). +### 2.0.1.0 + +* Add FromJSON KeyMap instances +* Make `ordered-keymap` on by default. + ### 2.0.0.0 * Remove forced `-O2` and then unneeded `fast` flag. @@ -11,6 +16,8 @@ * Make map type used by Object abstract so the underlying implementation can be modified, thanks to Callan McGill +* Add `ordered-keymap` flag allowing to change the underlying implementation of object `KeyMap`. + * Drop GHC-7 support * Remove Data.Aeson.Encode module @@ -19,6 +26,7 @@ Change `To/FromJSONKey` instances to use `"+inf"` and `"-inf"` too. * `FromJSON ()` and `FromJSON (Proxy tag)` accept any JSON value. + ### 1.5.6.0 * Make `Show Value` instance print object keys in lexicographic order. diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs --- a/src/Data/Aeson/Types/FromJSON.hs +++ b/src/Data/Aeson/Types/FromJSON.hs @@ -160,6 +160,10 @@ import Data.Coerce (Coercible, coerce) +#if __GLASGOW_HASKELL__ < 804 +import qualified Data.Type.Coercion +#endif + parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a parseIndexedJSON p idx value = p value Index idx @@ -1970,8 +1974,25 @@ parseJSON = withText "Key" (pure . Key.fromText) instance FromJSONKey Key where - -- TODO: make me more efficient. - fromJSONKey = FromJSONKeyText Key.fromText + fromJSONKey = case oldGHC Key.coercionToText of + Just Coercion -> FromJSONKeyCoerce + Nothing -> FromJSONKeyText Key.fromText + where +#if __GLASGOW_HASKELL__ < 804 + -- for some reason GHC-8.0 and 8.2 cannot apply the sym without help + oldGHC = fmap Data.Type.Coercion.sym +#else + oldGHC = id +#endif + +-- | @since 2.0.1.0 +instance FromJSON1 KM.KeyMap where + liftParseJSON p _ = withObject "KeyMap" $ \obj -> + traverse p obj + +-- | @since 2.0.1.0 +instance FromJSON v => FromJSON (KM.KeyMap v) where + parseJSON = parseJSON1 instance FromJSON Value where parseJSON = pure diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs --- a/src/Data/Aeson/Types/ToJSON.hs +++ b/src/Data/Aeson/Types/ToJSON.hs @@ -65,7 +65,7 @@ import Data.Aeson.Types.Generic (AllNullary, False, IsRecord, One, ProductSize, Tagged2(..), True, Zero, productSize) import Data.Aeson.Types.Internal import qualified Data.Aeson.Key as Key -import qualified Data.Aeson.KeyMap as TM +import qualified Data.Aeson.KeyMap as KM import Data.Attoparsec.Number (Number(..)) import Data.Bits (unsafeShiftR) import Data.DList (DList) @@ -336,11 +336,11 @@ name .= value = (name, toJSON value) {-# INLINE (.=) #-} --- | Constructs a singleton 'TM.KeyMap'. For calling functions that +-- | Constructs a singleton 'KM.KeyMap'. For calling functions that -- demand an 'Object' for constructing objects. To be used in -- conjunction with 'mconcat'. Prefer to use 'object' where possible. instance KeyValue Object where - name .= value = TM.singleton name (toJSON value) + name .= value = KM.singleton name (toJSON value) {-# INLINE (.=) #-} ------------------------------------------------------------------------------- @@ -1262,8 +1262,8 @@ instance ToJSON2 Either where - liftToJSON2 toA _ _toB _ (Left a) = Object $ TM.singleton "Left" (toA a) - liftToJSON2 _toA _ toB _ (Right b) = Object $ TM.singleton "Right" (toB b) + liftToJSON2 toA _ _toB _ (Left a) = Object $ KM.singleton "Left" (toA a) + liftToJSON2 _toA _ toB _ (Right b) = Object $ KM.singleton "Right" (toB b) liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a liftToEncoding2 _toA _ toB _ (Right b) = E.pairs $ E.pair "Right" $ toB b @@ -1591,8 +1591,8 @@ toEncoding = toEncoding1 instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where - liftToJSON tv tvl (InL x) = Object $ TM.singleton "InL" (liftToJSON tv tvl x) - liftToJSON tv tvl (InR y) = Object $ TM.singleton "InR" (liftToJSON tv tvl y) + liftToJSON tv tvl (InL x) = Object $ KM.singleton "InL" (liftToJSON tv tvl x) + liftToJSON tv tvl (InR y) = Object $ KM.singleton "InR" (liftToJSON tv tvl y) liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y @@ -1645,7 +1645,7 @@ instance ToJSONKey k => ToJSON1 (M.Map k) where liftToJSON g _ = case toJSONKey of - ToJSONKeyText f _ -> Object . TM.fromMap . mapKeyValO f g + ToJSONKeyText f _ -> Object . KM.fromMap . mapKeyValO f g ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . M.toList liftToEncoding g _ = case toJSONKey of @@ -1744,11 +1744,11 @@ instance ToJSONKey k => ToJSON1 (H.HashMap k) where liftToJSON g _ = case toJSONKey of - ToJSONKeyText f _ -> Object . TM.fromHashMap . mapKeyVal f g + ToJSONKeyText f _ -> Object . KM.fromHashMap . mapKeyVal f g ToJSONKeyValue f _ -> Array . V.fromList . map (toJSONPair f g) . H.toList - -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> TM.HashMap k a -> Encoding + -- liftToEncoding :: forall a. (a -> Encoding) -> ([a] -> Encoding) -> KM.HashMap k a -> Encoding liftToEncoding g _ = case toJSONKey of ToJSONKeyText _ f -> dict f g H.foldrWithKey ToJSONKeyValue _ f -> listEncoding (pairEncoding f) . H.toList @@ -1763,11 +1763,11 @@ -- Data.Aeson.KeyMap ------------------------------------------------------------------------------- -instance ToJSON1 TM.KeyMap where +instance ToJSON1 KM.KeyMap where liftToJSON g _ = Object . fmap g - liftToEncoding g _ = dict E.key g TM.foldrWithKey + liftToEncoding g _ = dict E.key g KM.foldrWithKey -instance (ToJSON v) => ToJSON (TM.KeyMap v) where +instance (ToJSON v) => ToJSON (KM.KeyMap v) where {-# SPECIALIZE instance ToJSON Object #-} toJSON = toJSON1