diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,27 @@ # microlens-aeson +## 2.5.0 (2022-03-19) + +This is a breaking update that matches upstream changes to `lens-aeson`. Luckily +the changes are mostly simplifications and improvements that better match the +`aeson-2` API. Thanks to `sjshuck` for his contributions to this release. + +#### Changed + +- Simplify class hierarchy to `AsNumber t => AsValue t`. Change the default + signature of `_Number` accordingly. +- Move `_String`, `_Bool`, and `_Null` to be methods of class `AsValue`. +- Convert `HashMap Text`-based interfaces to `KeyMap Key`. This changes the + types of `_Object` and `key`. +- Change `Index Value` to `Key`. +- Require `base >= 4.9`, the same as `aeson-2.*` does. +- Drop dependencies on `deepseq` and `unordered-containers`. + +#### Removed + +- `Primitive` and class `AsPrimitive`. +- Orphan `Ixed` instances for `HashMap` and `Vector`. + ## 2.4.1 (2022-01-21) #### Added diff --git a/microlens-aeson.cabal b/microlens-aeson.cabal --- a/microlens-aeson.cabal +++ b/microlens-aeson.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: microlens-aeson -version: 2.4.1 +version: 2.5.0 synopsis: Law-abiding lenses for Aeson, using microlens. description: Law-abiding lenses for Aeson, using microlens. category: Numeric @@ -25,13 +25,11 @@ ghc-options: -Wall -fwarn-incomplete-record-updates build-depends: , aeson >=2.0 - , base >=4.7 && <5 + , base >=4.9 && <5 , bytestring - , deepseq , hashable , microlens >=0.3 , text >=0.11 && < 1.3 || ^>= 2.0 - , unordered-containers >=0.2.3 , vector >=0.9 library diff --git a/src/Lens/Micro/Aeson.hs b/src/Lens/Micro/Aeson.hs --- a/src/Lens/Micro/Aeson.hs +++ b/src/Lens/Micro/Aeson.hs @@ -1,16 +1,10 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} -#if MIN_VERSION_base(4,8,0) -{-# LANGUAGE DeriveAnyClass #-} -#endif - -- | -- Module : Lens.Micro.Aeson --- Copyright : (c) Colin Woodbury 2015-2021, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 +-- Copyright : (c) Colin Woodbury 2015-2022, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 -- License : BSD3 -- Maintainer: Colin Woodbury -- @@ -26,9 +20,6 @@ AsNumber(..) , _Integral , nonNull - -- * Primitive - , Primitive(..) - , AsPrimitive(..) -- * Objects and Arrays , AsValue(..) , key, members @@ -37,17 +28,12 @@ , AsJSON(..) ) where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -import Data.Traversable (traverse) -#endif import Data.Aeson import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Parser (value) import Data.Attoparsec.ByteString.Lazy (maybeResult, parse) import qualified Data.ByteString as Strict import Data.ByteString.Lazy.Char8 as Lazy -import Data.HashMap.Strict (HashMap) import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import Data.Text as Text @@ -55,15 +41,11 @@ import qualified Data.Text.Lazy as LazyText import qualified Data.Text.Lazy.Encoding as LazyText import Data.Vector (Vector) -import GHC.Generics +import qualified Data.Vector as V import Lens.Micro import Lens.Micro.Aeson.Internal () import Prelude -#if MIN_VERSION_base(4,8,0) -import Data.Hashable -#endif - ------------------------------------------------------------------------------ -- Scientific Traversals ------------------------------------------------------------------------------ @@ -77,12 +59,12 @@ -- >>> "[1, \"x\"]" ^? nth 1 . _Number -- Nothing _Number :: Traversal' t Scientific - default _Number :: AsPrimitive t => Traversal' t Scientific - _Number = _Primitive . _Number + default _Number :: AsValue t => Traversal' t Scientific + _Number = _Value . _Number {-# INLINE _Number #-} -- | - -- Traversal into an 'Double' over a 'Value', 'Primitive' or 'Scientific' + -- Traversal into an 'Double' over a 'Value' or 'Scientific' -- -- >>> "[10.2]" ^? nth 0 . _Double -- Just 10.2 @@ -91,7 +73,7 @@ {-# INLINE _Double #-} -- | - -- Traversal into an 'Integer' over a 'Value', 'Primitive' or 'Scientific' + -- Traversal into an 'Integer' over a 'Value' or 'Scientific' -- -- >>> "[10]" ^? nth 0 . _Integer -- Just 10 @@ -136,48 +118,32 @@ {-# INLINE _Integral #-} ------------------------------------------------------------------------------ --- Null values and primitives +-- Null values ------------------------------------------------------------------------------ --- | Primitives of 'Value' -data Primitive - = StringPrim !Text - | NumberPrim !Scientific - | BoolPrim !Bool - | NullPrim -#if !MIN_VERSION_base(4,8,0) - deriving (Eq, Ord, Show, Generic) -#endif -#if MIN_VERSION_base(4,8,0) - deriving (Eq, Ord, Show, Generic, Hashable) -#endif +-- | Traversal into non-'Null' values +-- +-- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . nonNull +-- Just (String "xyz") +-- +-- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . nonNull +-- Just (Object (fromList [])) +-- +-- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . nonNull +-- Nothing +nonNull :: Traversal' Value Value +nonNull _ Null = pure Null +nonNull f v = _Value f v +{-# INLINE nonNull #-} -instance AsNumber Primitive where - _Number f (NumberPrim n) = NumberPrim <$> f n - _Number _ p = pure p - {-# INLINE _Number #-} +------------------------------------------------------------------------------ +-- Non-number traversals +------------------------------------------------------------------------------ --- | Traverse into various JSON primitives. -class AsNumber t => AsPrimitive t where - -- | - -- >>> "[1, \"x\", null, true, false]" ^? nth 0 . _Primitive - -- Just (NumberPrim 1.0) - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 1 . _Primitive - -- Just (StringPrim "x") - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 2 . _Primitive - -- Just NullPrim - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 3 . _Primitive - -- Just (BoolPrim True) - -- - -- >>> "[1, \"x\", null, true, false]" ^? nth 4 . _Primitive - -- Just (BoolPrim False) - _Primitive :: Traversal' t Primitive - default _Primitive :: AsValue t => Traversal' t Primitive - _Primitive = _Value . _Primitive - {-# INLINE _Primitive #-} +-- | Traverse into JSON Objects and Arrays. +class AsNumber t => AsValue t where + -- | Traverse into data that encodes a `Value` + _Value :: Traversal' t Value -- | -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String @@ -186,9 +152,9 @@ -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String -- Nothing _String :: Traversal' t Text - _String = _Primitive . trav - where trav f (StringPrim s) = StringPrim <$> f s - trav _ x = pure x + _String = _Value . trav + where trav f (String s) = String <$> f s + trav _ v = pure v {-# INLINE _String #-} -- | @@ -198,9 +164,9 @@ -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool -- Nothing _Bool :: Traversal' t Bool - _Bool = _Primitive . trav - where trav f (BoolPrim b) = BoolPrim <$> f b - trav _ x = pure x + _Bool = _Value . trav + where trav f (Bool b) = Bool <$> f b + trav _ v = pure v {-# INLINE _Bool #-} -- | @@ -210,90 +176,23 @@ -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null -- Nothing _Null :: Traversal' t () - _Null = _Primitive . trav - where trav f NullPrim = NullPrim <$ f () - trav _ x = pure x - {-# INLINE _Null #-} - --- Helper for the function below. -fromPrim :: Primitive -> Value -fromPrim (StringPrim s) = String s -fromPrim (NumberPrim n) = Number n -fromPrim (BoolPrim b) = Bool b -fromPrim NullPrim = Null -{-# INLINE fromPrim #-} - -instance AsPrimitive Value where - _Primitive f (String s) = fromPrim <$> f (StringPrim s) - _Primitive f (Number n) = fromPrim <$> f (NumberPrim n) - _Primitive f (Bool b) = fromPrim <$> f (BoolPrim b) - _Primitive f Null = fromPrim <$> f NullPrim - _Primitive _ v = pure v - {-# INLINE _Primitive #-} - - _String f (String s) = String <$> f s - _String _ v = pure v - {-# INLINE _String #-} - - _Bool f (Bool b) = Bool <$> f b - _Bool _ v = pure v - {-# INLINE _Bool #-} - - _Null f Null = Null <$ f () - _Null _ v = pure v + _Null = _Value . trav + where trav f Null = Null <$ f () + trav _ v = pure v {-# INLINE _Null #-} -instance AsPrimitive Strict.ByteString -instance AsPrimitive Lazy.ByteString -instance AsPrimitive Text.Text -instance AsPrimitive LazyText.Text -instance AsPrimitive String - -instance AsPrimitive Primitive where - _Primitive = id - {-# INLINE _Primitive #-} - --- | Traversal into non-'Null' values --- --- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . nonNull --- Just (String "xyz") --- --- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . nonNull --- Just (Object (fromList [])) --- --- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . nonNull --- Nothing -nonNull :: Traversal' Value Value -nonNull _ Null = pure Null -nonNull f v = _Value f v -{-# INLINE nonNull #-} - ------------------------------------------------------------------------------- --- Non-primitive traversals ------------------------------------------------------------------------------- - --- | Traverse into JSON Objects and Arrays. -class AsPrimitive t => AsValue t where - -- | Traverse into data that encodes a `Value` - _Value :: Traversal' t Value - -- | -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object -- Just (fromList []) -- -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object -- Nothing - _Object :: Traversal' t (HashMap Text Value) - _Object = _Value . trav - where - trav f (Object o) = Object . KM.fromHashMapText <$> f (KM.toHashMapText o) - trav _ v = pure v + _Object :: Traversal' t (KM.KeyMap Value) + _Object = _Value . \f v -> case v of Object o -> Object <$> f o; _ -> pure v {-# INLINE _Object #-} _Array :: Traversal' t (Vector Value) - _Array = _Value . trav - where trav f (Array a) = Array <$> f a - trav _ v = pure v + _Array = _Value . \f v -> case v of Array a -> Array <$> f a; _ -> pure v {-# INLINE _Array #-} instance AsValue Value where @@ -321,7 +220,7 @@ {-# INLINE _Value #-} -- | --- Like 'ix', but for 'Object' with Text indices. This often has better +-- Like 'ix', but for 'Object' with 'Key' indices. This often has better -- inference than 'ix' when used with OverloadedStrings. -- -- >>> "{\"a\": 100, \"b\": 200}" ^? key "a" @@ -329,7 +228,7 @@ -- -- >>> "[1,2,3]" ^? key "a" -- Nothing -key :: AsValue t => Text -> Traversal' t Value +key :: AsValue t => Key -> Traversal' t Value key i = _Object . ix i {-# INLINE key #-} @@ -355,7 +254,11 @@ -- >>> "[1,2,3]" & nth 1 .~ Number 20 -- "[1,20,3]" nth :: AsValue t => Int -> Traversal' t Value -nth i = _Array . ix i +nth i = _Array . vectorIxI + where + vectorIxI f a + | 0 <= i && i < V.length a = f (a V.! i) <&> \v -> a V.// [(i, v)] + | otherwise = pure a {-# INLINE nth #-} -- | A Traversal into Array elements diff --git a/src/Lens/Micro/Aeson/Internal.hs b/src/Lens/Micro/Aeson/Internal.hs --- a/src/Lens/Micro/Aeson/Internal.hs +++ b/src/Lens/Micro/Aeson/Internal.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} @@ -7,7 +6,7 @@ -- | -- Module : Lens.Micro.Aeson.Internal --- Copyright : (c) Colin Woodbury 2015-2021, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 +-- Copyright : (c) Colin Woodbury 2015-2022, (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 -- License : BSD3 -- Maintainer: Colin Woodbury -- @@ -18,52 +17,24 @@ module Lens.Micro.Aeson.Internal where -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative -#endif import Data.Aeson (Value(..)) import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM -import Data.HashMap.Lazy as HashMap -import Data.Text (Text) -import Data.Vector as V import Lens.Micro.Internal --- -type instance Index Value = Text +type instance Index Value = Key.Key type instance IxValue Value = Value -- | Can only index into the contents of an `Object`, --- which is a `HashMap`. +-- which is a `KM.KeyMap` `Value`. instance Ixed Value where - ix i f (Object o) = Object <$> ix (Key.fromText i) f o + ix i f (Object o) = Object <$> ix i f o ix _ _ v = pure v {-# INLINE ix #-} -type instance Index (HashMap Text Value) = Text - -type instance IxValue (HashMap Text Value) = Value - --- | Straight-forward implementation. -instance Ixed (HashMap Text Value) where - ix k f m = case HashMap.lookup k m of - Just v -> (\v' -> HashMap.insert k v' m) <$> f v - Nothing -> pure m - {-# INLINE ix #-} - -type instance Index (V.Vector a) = Int - -type instance IxValue (V.Vector a) = a - --- | Also straight-forward. Only applicable for non-zero length `Vector`s. -instance Ixed (V.Vector a) where - ix i f v - | 0 <= i && i < V.length v = (\a -> v V.// [(i, a)]) <$> f (v V.! i) - | otherwise = pure v - {-# INLINE ix #-} - -- Thu Oct 21 11:49:16 2021 -- Adapted from lens-aeson to account for the aeson-2 update. @@ -72,9 +43,7 @@ type instance IxValue (KM.KeyMap v) = v instance Ixed (KM.KeyMap v) where - ix i f m = case KM.lookup i m of - Nothing -> pure m - Just v -> (\v' -> KM.insert i v' m) <$> f v + ix = ixAt instance At (KM.KeyMap v) where at k f = KM.alterF f k diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,8 +1,8 @@ module Main where import Data.Aeson +import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM -import qualified Data.HashMap.Strict as HMS import qualified Data.Text as T import Lens.Micro import Lens.Micro.Aeson @@ -29,30 +29,28 @@ [ testCase "" $ ("[10]" ^? nth 0 . _Integral) @?= Just (10 :: Int) , testCase "" $ ("[10.5]" ^? nth 0 . _Integral) @?= Just (10 :: Int) ] - , testGroup "Nulls and Primitives" - [ testCase "" $ ("[1, \"x\", null, true, false]" ^? nth 0 . _Primitive) @?= Just (NumberPrim 1.0) - , testCase "" $ ("[1, \"x\", null, true, false]" ^? nth 1 . _Primitive) @?= Just (StringPrim $ T.pack "x") - , testCase "" $ ("[1, \"x\", null, true, false]" ^? nth 2 . _Primitive) @?= Just NullPrim - , testCase "" $ ("[1, \"x\", null, true, false]" ^? nth 3 . _Primitive) @?= Just (BoolPrim True) - , testCase "" $ ("[1, \"x\", null, true, false]" ^? nth 4 . _Primitive) @?= Just (BoolPrim False) - , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (T.pack "a") . _String) @?= Just (T.pack "xyz") - , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (T.pack "b") . _String) @?= Nothing - , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (T.pack "b") . _Bool) @?= Just True - , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (T.pack "a") . _Bool) @?= Nothing - , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (T.pack "b") . _Null) @?= Just () - , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (T.pack "a") . _Null) @?= Nothing - , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (T.pack "a") . nonNull) @?= Just (String $ T.pack "xyz") - , testCase "" $ ("{\"a\": {}, \"b\": null}" ^? key (T.pack "a") . nonNull) @?= Just (Object . KM.fromHashMapText $ HMS.fromList []) - , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (T.pack "b") . nonNull) @?= Nothing + , testGroup "Strings, Bools, and Nulls" + [ testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (Key.fromString "a") . _String) @?= Just (T.pack "xyz") + , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (Key.fromString "b") . _String) @?= Nothing + , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (Key.fromString "b") . _Bool) @?= Just True + , testCase "" $ ("{\"a\": \"xyz\", \"b\": true}" ^? key (Key.fromString "a") . _Bool) @?= Nothing + , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (Key.fromString "b") . _Null) @?= Just () + , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (Key.fromString "a") . _Null) @?= Nothing + , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (Key.fromString "a") . nonNull) @?= Just (String $ T.pack "xyz") + , testCase "" $ ("{\"a\": {}, \"b\": null}" ^? key (Key.fromString "a") . nonNull) @?= Just (Object $ KM.fromList []) + , testCase "" $ ("{\"a\": \"xyz\", \"b\": null}" ^? key (Key.fromString "b") . nonNull) @?= Nothing ] - , testGroup "Non-primitive Traversals" - [ testCase "" $ ("{\"a\": {}, \"b\": null}" ^? key (T.pack "a") . _Object) @?= Just (HMS.fromList []) - , testCase "" $ ("{\"a\": {}, \"b\": null}" ^? key (T.pack "b") . _Object) @?= Nothing - , testCase "" $ ("{\"a\": 100, \"b\": 200}" ^? key (T.pack "a")) @?= Just (Number 100.0) - , testCase "" $ ("[1,2,3]" ^? key (T.pack "a")) @?= Nothing + , testGroup "Object and Array Traversals" + [ testCase "" $ ("{\"a\": {}, \"b\": null}" ^? key (Key.fromString "a") . _Object) @?= Just (KM.fromList []) + , testCase "" $ ("{\"a\": {}, \"b\": null}" ^? key (Key.fromString "b") . _Object) @?= Nothing + , testCase "" $ ("{\"a\": 100, \"b\": 200}" ^? key (Key.fromString "a")) @?= Just (Number 100.0) + , testCase "" $ ("{\"a\": 100, \"b\": 200}" ^? _Value . ix (Key.fromString "a")) @?= Just (Number 100.0) + , testCase "" $ ("[1,2,3]" ^? key (Key.fromString "a")) @?= Nothing , testCase "" $ (sort ("{\"a\": 4, \"b\": 7}" ^.. members . _Number)) @?= [4.0, 7.0] , testCase "" $ ("{\"a\": 4}" & members . _Number %~ (* 10)) @?= "{\"a\":40}" + , testCase "" $ ("[1,2,3]" ^? nth (-1)) @?= Nothing , testCase "" $ ("[1,2,3]" ^? nth 1) @?= Just (Number 2.0) + , testCase "" $ ("[1,2,3]" ^? nth 3) @?= Nothing , testCase "" $ ("{\"a\": 100, \"b\": 200}" ^? nth 1) @?= Nothing , testCase "" $ ("[1,2,3]" & nth 1 .~ Number 20) @?= "[1,20,3]" , testCase "" $ ("[1,2,3]" ^.. values) @?= [Number 1.0,Number 2.0,Number 3.0]