diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,69 @@ +1.2.3 [2023.06.27] +------------------ +* Use `aeson`'s `decode` function in the `AsJSON` instance for `ByteString`s. + This allows removing a direct dependency on `attoparsec`. +* Allow building with `aeson-2.2`. + +1.2.2 [2022.08.11] +------------------ +* Add `atKey :: AsValue t => Key -> Traversal' t (Maybe Value)`, a variant of + `key` that uses `at` instead of `ix`. + +1.2.1 [2022.05.07] +------------------ +* Change the `IsKey` instances for `ByteString`s to use + `decodeUtf8With lenientDecode` instead of `decodeUtf8`. While these `IsKey` + instances are meant to used for interoperability with `aeson` values that + are UTF-8–encoded, using `decodeUtf8With lenientDecode` at least ensures + that converting a non–UTF-8–encoded `ByteString` will not crash. + +1.2 [2022.03.19] +---------------- +* Require `aeson-2.0.2.*` and `lens-5.0.*` or greater. +* Change the types of `_Object`, `key`, and `members`: + + ```diff + -_Object :: Prism' t (HashMap Text Value) + +_Object :: Prism' t (KeyMap Value) + + -key :: AsValue t => Text -> Traversal' t Value + +key :: AsValue t => Key -> Traversal' t Value + + -members :: AsValue t => IndexedTraversal' Text t Value + +members :: AsValue t => IndexedTraversal' Key t Value + ``` + + This mirrors similar changes made in `aeson-2.0.*`, where the type of + `Object`'s field was changed from `HashMap Text Value` to `KeyMap Value`. + + The `Ixed Value` instance changes similarly: + + ```diff + -type instance Index Value = Text + +type instance Index Value = Key + ``` +* Remove `Primitive` and `AsPrimitive`, since https://tools.ietf.org/html/rfc7159 + de-emphasized the notion of primitive versus composite JSON values. + * The `AsPrimitive` methods (`_Value`, `_String`, and `_Bool`) are now + `AsValue` methods. + * `_Number`'s default signature, `Bool_`, `String_`, and `Null_` now have an + `AsValue` constraint. +* Add `Wrapped` and `Rewrapped` instances for `KeyMap`. These treat `KeyMap v` + as a wrapper around `[(Key, v)]`. The order in which the key-value pairs + appear in this list is not stable. +* Add an `IsKey` class, whose method `_Key` is an `Iso` for converting values + to and from a `Key`. + +1.1.3 [2021.11.16] +------------------ +* Drop support for pre-8.0 versions of GHC. + +1.1.2 [2021.10.09] +------------------ +* Allow building with `aeson-2.0.0.0`. +* Add `Index`, `IxValue`, `Ixed`, `At`, and `Each` instances for `KeyMap` if + building with `aeson-2.0.0.0` or later. + 1.1.1 [2021.02.17] ------------------ * Allow building with `lens-5.*`. @@ -50,4 +116,3 @@ 0.1 --- * Repository initialized - diff --git a/lens-aeson.cabal b/lens-aeson.cabal --- a/lens-aeson.cabal +++ b/lens-aeson.cabal @@ -1,6 +1,6 @@ name: lens-aeson -category: Numeric -version: 1.1.1 +category: Data, JSON, Lenses +version: 1.2.3 license: MIT cabal-version: >= 1.10 license-file: LICENSE @@ -13,16 +13,16 @@ Copyright (C) 2012 Paul Wilson Copyright (C) 2013 Edward A. Kmett build-type: Simple -tested-with: GHC == 7.4.2 - , GHC == 7.6.3 - , GHC == 7.8.4 - , GHC == 7.10.3 - , GHC == 8.0.2 +tested-with: GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 - , GHC == 8.8.3 - , GHC == 8.10.1 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.2 + , GHC == 9.2.7 + , GHC == 9.4.5 + , GHC == 9.6.2 synopsis: Law-abiding lenses for aeson description: Law-abiding lenses for aeson. @@ -40,19 +40,19 @@ library build-depends: - base >= 4.5 && < 5, - lens >= 4.4 && < 6, - text >= 0.11.1.10 && < 1.3, - vector >= 0.9 && < 0.13, + base >= 4.9 && < 5, + lens >= 5.0 && < 6, + text >= 0.11.1.10 && < 2.1, + text-short >= 0.1.4 && < 0.2, + vector >= 0.9 && < 0.14, unordered-containers >= 0.2.3 && < 0.3, - attoparsec >= 0.10 && < 0.14, bytestring >= 0.9 && < 0.12, - aeson >= 0.7.0.5 && < 1.6, + aeson >= 2.0.2 && < 2.3, scientific >= 0.3.2 && < 0.4 exposed-modules: Data.Aeson.Lens - ghc-options: -Wall -fwarn-tabs -O2 + ghc-options: -Wall -Wtabs -O2 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Data/Aeson/Lens.hs b/src/Data/Aeson/Lens.hs --- a/src/Data/Aeson/Lens.hs +++ b/src/Data/Aeson/Lens.hs @@ -1,17 +1,14 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE DefaultSignatures #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} -#endif +{-# OPTIONS_GHC -Wno-orphans #-} -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2019, (c) Paul Wilson 2012 @@ -29,44 +26,41 @@ AsNumber(..) , _Integral , nonNull - -- * Primitive - , Primitive(..) - , AsPrimitive(..) -- * Objects and Arrays , AsValue(..) - , key, members + , key, atKey, members , nth, values + , IsKey(..) -- * Decoding , AsJSON(..) , _JSON' -- * Pattern Synonyms -#if __GLASGOW_HASKELL__ >= 800 , pattern JSON , pattern Value_ , pattern Number_ , pattern Double , pattern Integer , pattern Integral - , pattern Primitive , pattern Bool_ , pattern String_ , pattern Null_ -#endif + , pattern Key_ ) where import Control.Applicative import Control.Lens import Data.Aeson -import Data.Aeson.Parser (value) -import Data.Attoparsec.ByteString.Lazy (maybeResult, parse) +import qualified Data.Aeson.Key as Key +import qualified Data.Aeson.KeyMap as KM +import Data.Aeson.KeyMap (KeyMap) import Data.Scientific (Scientific) import qualified Data.Scientific as Scientific import qualified Data.ByteString as Strict import Data.ByteString.Lazy.Char8 as Lazy hiding (putStrLn) -import Data.Data -import Data.HashMap.Strict (HashMap) import Data.Text as Text +import qualified Data.Text.Encoding.Error as Encoding import qualified Data.Text.Lazy as LazyText +import Data.Text.Short (ShortText) import Data.Text.Lens (packed) import qualified Data.Text.Encoding as StrictText import qualified Data.Text.Lazy.Encoding as LazyText @@ -77,7 +71,9 @@ -- >>> import Control.Lens -- >>> import Data.Aeson -- >>> import Data.Text (Text) +-- >>> import qualified Data.ByteString as Strict (ByteString) -- >>> import Data.ByteString.Char8 as Strict.Char8 +-- >>> import qualified Data.ByteString.Lazy as Lazy (ByteString) -- >>> import qualified Data.Vector as Vector -- >>> :set -XOverloadedStrings @@ -93,12 +89,12 @@ -- >>> "[1, \"x\"]" ^? nth 1 . _Number -- Nothing _Number :: Prism' t Scientific - default _Number :: AsPrimitive t => Prism' t Scientific - _Number = _Primitive._Number + default _Number :: AsValue t => Prism' t Scientific + _Number = _Value._Number {-# INLINE _Number #-} -- | - -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Scientific' + -- Prism into an 'Double' over a 'Value' or 'Scientific' -- -- >>> "[10.2]" ^? nth 0 . _Double -- Just 10.2 @@ -107,7 +103,7 @@ {-# INLINE _Double #-} -- | - -- Prism into an 'Integer' over a 'Value', 'Primitive' or 'Scientific' + -- Prism into an 'Integer' over a 'Value' or 'Scientific' -- -- >>> "[10]" ^? nth 0 . _Integer -- Just 10 @@ -151,41 +147,32 @@ {-# INLINE _Integral #-} ------------------------------------------------------------------------------ --- Null values and primitives +-- Null values ------------------------------------------------------------------------------ --- | Primitives of 'Value' -data Primitive - = StringPrim !Text - | NumberPrim !Scientific - | BoolPrim !Bool - | NullPrim - deriving (Eq,Ord,Show,Data,Typeable) +-- | Prism 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 :: Prism' Value Value +nonNull = prism id (\v -> if isn't _Null v then Right v else Left v) +{-# INLINE nonNull #-} -instance AsNumber Primitive where - _Number = prism NumberPrim $ \v -> case v of NumberPrim s -> Right s; _ -> Left v - {-# INLINE _Number #-} +------------------------------------------------------------------------------ +-- Non-number traversals +------------------------------------------------------------------------------ -class AsNumber t => AsPrimitive t where +class AsNumber t => AsValue 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 :: Prism' t Primitive - default _Primitive :: AsValue t => Prism' t Primitive - _Primitive = _Value._Primitive - {-# INLINE _Primitive #-} + -- >>> preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])) + -- True + _Value :: Prism' t Value -- | -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String @@ -194,10 +181,10 @@ -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String -- Nothing -- - -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] :: String + -- >>> _Object._Wrapped # [("key" :: Key, _String # "value")] :: String -- "{\"key\":\"value\"}" _String :: Prism' t Text - _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v) + _String = _Value.prism String (\v -> case v of String s -> Right s; _ -> Left v) {-# INLINE _String #-} -- | @@ -213,7 +200,7 @@ -- >>> _Bool # False :: String -- "false" _Bool :: Prism' t Bool - _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v) + _Bool = _Value.prism Bool (\v -> case v of Bool b -> Right b; _ -> Left v) {-# INLINE _Bool #-} -- | @@ -226,76 +213,19 @@ -- >>> _Null # () :: String -- "null" _Null :: Prism' t () - _Null = _Primitive.prism (const NullPrim) (\v -> case v of NullPrim -> Right (); _ -> Left v) - {-# INLINE _Null #-} - - -instance AsPrimitive Value where - _Primitive = prism fromPrim toPrim - where - toPrim (String s) = Right $ StringPrim s - toPrim (Number n) = Right $ NumberPrim n - toPrim (Bool b) = Right $ BoolPrim b - toPrim Null = Right NullPrim - toPrim v = Left v - {-# INLINE toPrim #-} - fromPrim (StringPrim s) = String s - fromPrim (NumberPrim n) = Number n - fromPrim (BoolPrim b) = Bool b - fromPrim NullPrim = Null - {-# INLINE fromPrim #-} - {-# INLINE _Primitive #-} - _String = prism String $ \v -> case v of String s -> Right s; _ -> Left v - {-# INLINE _String #-} - _Bool = prism Bool (\v -> case v of Bool b -> Right b; _ -> Left v) - {-# INLINE _Bool #-} - _Null = prism (const Null) (\v -> case v of Null -> Right (); _ -> Left v) + _Null = _Value.prism (const Null) (\v -> case v of Null -> Right (); _ -> Left 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 #-} - --- | Prism 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 :: Prism' Value Value -nonNull = prism id (\v -> if isn't _Null v then Right v else Left v) -{-# INLINE nonNull #-} - ------------------------------------------------------------------------------- --- Non-primitive traversals ------------------------------------------------------------------------------- - -class AsPrimitive t => AsValue t where -- | - -- >>> preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])) - -- True - _Value :: Prism' t Value - - -- | -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object -- Just (fromList []) -- -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object -- Nothing -- - -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] :: String + -- >>> _Object._Wrapped # [("key" :: Key, _String # "value")] :: String -- "{\"key\":\"value\"}" - _Object :: Prism' t (HashMap Text Value) + _Object :: Prism' t (KeyMap Value) _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v) {-# INLINE _Object #-} @@ -331,7 +261,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" @@ -339,10 +269,23 @@ -- -- >>> "[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 #-} +-- | +-- Like 'key', but uses 'at' instead of 'ix'. This is handy when +-- adding and removing object keys: +-- +-- >>> "{\"a\": 100, \"b\": 200}" & atKey "a" .~ Nothing +-- "{\"b\":200}" +-- +-- >>> "{\"a\": 100, \"b\": 200}" & atKey "c" ?~ String "300" +-- "{\"a\":100,\"b\":200,\"c\":\"300\"}" +atKey :: AsValue t => Key -> Traversal' t (Maybe Value) +atKey i = _Object . at i +{-# INLINE atKey #-} + -- | An indexed Traversal into Object properties -- -- >>> Data.List.sort ("{\"a\": 4, \"b\": 7}" ^@.. members . _Number) @@ -350,7 +293,7 @@ -- -- >>> "{\"a\": 4}" & members . _Number *~ 10 -- "{\"a\":40}" -members :: AsValue t => IndexedTraversal' Text t Value +members :: AsValue t => IndexedTraversal' Key t Value members = _Object . itraversed {-# INLINE members #-} @@ -383,14 +326,77 @@ strictUtf8 = packed . strictTextUtf8 strictTextUtf8 :: Iso' Text.Text Strict.ByteString -strictTextUtf8 = iso StrictText.encodeUtf8 StrictText.decodeUtf8 +strictTextUtf8 = iso StrictText.encodeUtf8 (StrictText.decodeUtf8With Encoding.lenientDecode) lazyTextUtf8 :: Iso' LazyText.Text Lazy.ByteString -lazyTextUtf8 = iso LazyText.encodeUtf8 LazyText.decodeUtf8 +lazyTextUtf8 = iso LazyText.encodeUtf8 (LazyText.decodeUtf8With Encoding.lenientDecode) _JSON' :: (AsJSON t, FromJSON a, ToJSON a) => Prism' t a _JSON' = _JSON + +class IsKey t where + -- | '_Key' is an 'Iso' from something to a 'Key'. This is primarily intended + -- for situations where one wishes to use object keys that are not string + -- literals and therefore must be converted: + -- + -- >>> let k = "a" :: Text + -- >>> "{\"a\": 100, \"b\": 200}" ^? key (k ^. _Key) + -- Just (Number 100.0) + -- + -- Note that applying '_Key' directly to a string literal + -- (e.g., @\"a\" ^. '_Key'@) will likely not typecheck when + -- @OverloadedStrings@ is enabled. + _Key :: Iso' t Key + +instance IsKey Key where + _Key = id + {-# INLINE _Key #-} + +instance IsKey String where + _Key = iso Key.fromString Key.toString + {-# INLINE _Key #-} + +instance IsKey Text.Text where + _Key = iso Key.fromText Key.toText + {-# INLINE _Key #-} + +instance IsKey LazyText.Text where + _Key = strict._Key + {-# INLINE _Key #-} + +instance IsKey ShortText where + _Key = iso Key.fromShortText Key.toShortText + {-# INLINE _Key #-} + +-- | This instance assumes that you are dealing with UTF-8–encoded +-- 'Strict.ByteString's, as this is the encoding that RFC 8259 requires JSON +-- values to use. As such, this is not a full 'Iso', since non–UTF-8–encoded +-- 'Strict.ByteString's will not roundtrip: +-- +-- >>> let str = view _Key ("\255" :: Strict.ByteString) +-- >>> str +-- "\65533" +-- >>> view (from _Key) str :: Strict.ByteString +-- "\239\191\189" +instance IsKey Strict.ByteString where + _Key = from strictTextUtf8._Key + {-# INLINE _Key #-} + +-- | This instance assumes that you are dealing with UTF-8–encoded +-- 'Lazy.ByteString's, as this is the encoding that RFC 8259 requires JSON +-- values to use. As such, this is not a full 'Iso', since non–UTF-8–encoded +-- 'Lazy.ByteString's will not roundtrip: +-- +-- >>> let str = view _Key ("\255" :: Lazy.ByteString) +-- >>> str +-- "\65533" +-- >>> view (from _Key) str :: Lazy.ByteString +-- "\239\191\189" +instance IsKey Lazy.ByteString where + _Key = from lazyTextUtf8._Key + {-# INLINE _Key #-} + class AsJSON t where -- | '_JSON' is a 'Prism' from something containing JSON to something encoded in that structure _JSON :: (FromJSON a, ToJSON b) => Prism t t a b @@ -400,12 +406,7 @@ {-# INLINE _JSON #-} instance AsJSON Lazy.ByteString where - _JSON = prism' encode decodeValue - where - decodeValue :: (FromJSON a) => Lazy.ByteString -> Maybe a - decodeValue s = maybeResult (parse value s) >>= \x -> case fromJSON x of - Success v -> Just v - _ -> Nothing + _JSON = prism' encode decode {-# INLINE _JSON #-} instance AsJSON String where @@ -468,7 +469,7 @@ -- Orphan instances for lens library interop ------------------------------------------------------------------------------ -type instance Index Value = Text +type instance Index Value = Key type instance IxValue Value = Value instance Ixed Value where @@ -482,11 +483,31 @@ plate _ xs = pure xs {-# INLINE plate #-} +type instance Index (KM.KeyMap v) = Key.Key +type instance IxValue (KM.KeyMap v) = v + +instance Ixed (KM.KeyMap v) + +instance At (KM.KeyMap v) where + at k f = KM.alterF f k + {-# INLINE at #-} + +instance Each (KM.KeyMap a) (KM.KeyMap b) a b where + each = traversed + {-# INLINE each #-} + +-- | Use @'iso' 'KM.toList' 'KM.fromList'@. +-- Unwrapping returns some permutation of the list. +instance (t ~ KeyMap v') => Rewrapped (KeyMap v) t +instance Wrapped (KeyMap v) where + type Unwrapped (KeyMap v) = [(Key, v)] + _Wrapped' = iso KM.toList KM.fromList + {-# INLINE _Wrapped' #-} + ------------------------------------------------------------------------------ -- Pattern Synonyms ------------------------------------------------------------------------------ -#if __GLASGOW_HASKELL__ >= 800 pattern JSON :: (FromJSON a, ToJSON a, AsJSON t) => () => a -> t pattern JSON a <- (preview _JSON -> Just a) where JSON a = _JSON # a @@ -511,19 +532,18 @@ pattern Integral d <- (preview _Integral -> Just d) where Integral d = _Integral # d -pattern Primitive :: AsPrimitive t => Primitive -> t -pattern Primitive p <- (preview _Primitive -> Just p) where - Primitive p = _Primitive # p - -pattern Bool_ :: AsPrimitive t => Bool -> t +pattern Bool_ :: AsValue t => Bool -> t pattern Bool_ b <- (preview _Bool -> Just b) where Bool_ b = _Bool # b -pattern String_ :: AsPrimitive t => Text -> t +pattern String_ :: AsValue t => Text -> t pattern String_ p <- (preview _String -> Just p) where String_ p = _String # p -pattern Null_ :: AsPrimitive t => t +pattern Null_ :: AsValue t => t pattern Null_ <- (preview _Null -> Just ()) where Null_ = _Null # () -#endif + +pattern Key_ :: IsKey t => Key -> t +pattern Key_ k <- (preview _Key -> Just k) where + Key_ k = _Key # k