diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,7 @@ +1 +---- +* Module migrated from lens package to Data.Aeson.Lens + 0.1.2 ----- * Added `members` and `values` diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,6 +1,11 @@ lens-aeson ========== +DEPRECATED +========== + +This project has been deprecated and moved into Lens 4! + [![Build Status](https://secure.travis-ci.org/lens/lens-aeson.png)](http://travis-ci.org/lens/lens-aeson) The goal of `lens-aeson` is to provide traversals and prisms for 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: 0.1.2 +version: 1 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE @@ -43,18 +43,18 @@ library build-depends: - base >= 4.3 && < 5, - lens >= 3.9 && < 3.11, - text >= 0.11.1.10 && < 0.12, + base >= 4.5 && < 5, + lens >= 4.4 && < 4.5, + text >= 0.11.1.10 && < 1.2, vector >= 0.9 && < 0.11, unordered-containers >= 0.2.3 && < 0.3, - utf8-string >= 0.3.7 && < 0.4, - attoparsec >= 0.10 && < 0.11, + attoparsec >= 0.10 && < 0.13, bytestring >= 0.9 && < 0.11, - aeson >= 0.6 && < 0.7 + aeson >= 0.7.0.5 && < 0.9, + scientific >= 0.3.2 && < 0.4 exposed-modules: - Control.Lens.Aeson + Data.Aeson.Lens if flag(lib-Werror) ghc-options: -Werror diff --git a/src/Control/Lens/Aeson.hs b/src/Control/Lens/Aeson.hs deleted file mode 100644 --- a/src/Control/Lens/Aeson.hs +++ /dev/null @@ -1,305 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE Trustworthy #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE DefaultSignatures #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} --------------------------------------------------------------------- --- | --- Copyright : (c) Edward Kmett 2013, (c) Paul Wilson 2012 --- License : BSD3 --- Maintainer: Edward Kmett --- Stability : experimental --- Portability: non-portable --- --------------------------------------------------------------------- -module Control.Lens.Aeson - ( - -- * Numbers - AsNumber(..) - , integralValue - , nonNull - -- * Primitive - , Primitive(..) - , AsPrimitive(..) - -- * Objects and Arrays - , AsValue(..) - , key, members - , nth, values - -- * Decoding - , AsJSON(..) - ) where - -import Control.Applicative -import Control.Lens -import Data.Aeson -import Data.Attoparsec.Number -import Data.ByteString.Lazy.Char8 as Lazy hiding (putStrLn) -import Data.ByteString.Lazy.UTF8 as UTF8 hiding (decode) -import Data.Data -import Data.HashMap.Strict (HashMap) -import Data.Text -import Data.Vector (Vector) -import Numeric.Lens -import Prelude hiding(null) - --- $setup --- >>> :set -XOverloadedStrings - - ------------------------------------------------------------------------------- --- Number prisms ------------------------------------------------------------------------------- - -class AsNumber t where - -- | - -- >>> "[1, \"x\"]" ^? nth 0 . _Number - -- Just 1 - -- - -- >>> "[1, \"x\"]" ^? nth 1 . _Number - -- Nothing - _Number :: Prism' t Number -#ifndef HLINT - default _Number :: AsPrimitive t => Prism' t Number - _Number = _Primitive._Number -#endif - - -- | - -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Number' - -- - -- >>> "[10.2]" ^? nth 0 . _Double - -- Just 10.2 - _Double :: Prism' t Double - _Double = _Number.prism D (\v -> case v of D d -> Right d; _ -> Left v) - - -- | - -- Prism into an 'Integer' over a 'Value', 'Primitive' or 'Number' - -- - -- >>> "[10]" ^? nth 0 . _Integer - -- Just 10 - -- - -- >>> "[10.5]" ^? nth 0 . _Integer - -- Nothing - _Integer :: Prism' t Integer - _Integer = _Number.prism I (\v -> case v of I i -> Right i; _ -> Left v) - -instance AsNumber Value where - _Number = prism Number $ \v -> case v of Number n -> Right n; _ -> Left v - -instance AsNumber Number where - _Number = id - -instance AsNumber ByteString -instance AsNumber String - ------------------------------------------------------------------------------- --- Conversion Prisms ------------------------------------------------------------------------------- - --- | Access Integer 'Value's as Integrals. --- --- defined as `integer . 'Numeric.Lens.integral'` --- --- >>> "[10]" ^? nth 0 . integralValue --- Just 10 --- --- >>> "[10.5]" ^? nth 0 . integralValue --- Nothing -integralValue :: (AsNumber t, Integral a) => Prism' t a -integralValue = _Integer . integral - ------------------------------------------------------------------------------- --- Null values and primitives ------------------------------------------------------------------------------- - --- | Primitives of 'Value' -data Primitive - = StringPrim !Text - | NumberPrim !Number - | BoolPrim !Bool - | NullPrim - deriving (Eq,Ord,Show,Data,Typeable) - -instance AsNumber Primitive where - _Number = prism NumberPrim $ \v -> case v of NumberPrim s -> Right s; _ -> Left v - -class AsNumber t => AsPrimitive t where - -- | - -- >>> "[1, \"x\", null, true, false]" ^? nth 0 . _Primitive - -- Just (NumberPrim 1) - -- - -- >>> "[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 -#ifndef HLINT - default _Primitive :: AsValue t => Prism' t Primitive - _Primitive = _Value._Primitive -#endif - - -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String - -- Just "xyz" - -- - -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String - -- Nothing - _String :: Prism' t Text - _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v) - - -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool - -- Just True - -- - -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool - -- Nothing - _Bool :: Prism' t Bool - _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v) - - -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null - -- Just () - -- - -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null - -- Nothing - _Null :: Prism' t () - _Null = _Primitive.prism (const NullPrim) (\v -> case v of NullPrim -> Right (); _ -> Left v) - -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 - fromPrim (StringPrim s) = String s - fromPrim (NumberPrim n) = Number n - fromPrim (BoolPrim b) = Bool b - fromPrim NullPrim = Null - - _String = prism String $ \v -> case v of String s -> Right s; _ -> Left v - _Bool = prism Bool (\v -> case v of Bool b -> Right b; _ -> Left v) - _Null = prism (const Null) (\v -> case v of Null -> Right (); _ -> Left v) - -instance AsPrimitive ByteString -instance AsPrimitive String - -instance AsPrimitive Primitive where - _Primitive = id - --- | 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) - ------------------------------------------------------------------------------- --- Non-primitive traversals ------------------------------------------------------------------------------- - -class AsPrimitive t => AsValue t where - -- | - -- >>>"[1,2,3]" ^? _Value - -- Just (Array (fromList [Number 1,Number 2,Number 3])) - _Value :: Prism' t Value - - -- | - -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object - -- Just fromList [] - -- - -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object - -- Nothing - _Object :: Prism' t (HashMap Text Value) - _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v) - - -- | - -- >>> "[1,2,3]" ^? _Array - -- Just (fromList [Number 1,Number 2,Number 3]) - _Array :: Prism' t (Vector Value) - _Array = _Value.prism Array (\v -> case v of Array a -> Right a; _ -> Left v) - -instance AsValue Value where - _Value = id - -instance AsValue ByteString where - _Value = _JSON - -instance AsValue String where - _Value = iso UTF8.fromString UTF8.toString._Value - --- | --- Like 'ix', but for 'Object' with Text indices. This often has better --- inference than 'ix' when used with OverloadedStrings. --- --- >>> "{\"a\": 100, \"b\": 200}" ^? key "a" --- Just (Number 100) --- --- >>> "[1,2,3]" ^? key "a" --- Nothing -key :: AsValue t => Text -> Traversal' t Value -key i = _Object . ix i - -members :: AsValue t => IndexedTraversal' Text t Value -members = _Object . each - --- | Like 'ix', but for Arrays with Int indexes --- --- >>> "[1,2,3]" ^? nth 1 --- Just (Number 2) --- --- >>> "\"a\": 100, \"b\": 200}" ^? nth 1 --- Nothing --- --- >>> "[1,2,3]" & nth 1 .~ (Number 20) --- "[1,20,3]" -nth :: AsValue t => Int -> Traversal' t Value -nth i = _Array . ix i - -values :: AsValue t => IndexedTraversal' Int t Value -values = _Array . traversed - -class AsJSON t where - -- | A Prism into 'Value' on lazy 'ByteString's. - _JSON :: (FromJSON a, ToJSON a) => Prism' t a - -instance AsJSON Lazy.ByteString where - _JSON = prism' encode decode - -instance AsJSON String where - _JSON = iso UTF8.fromString UTF8.toString._JSON - ------------------------------------------------------------------------------- --- Orphan instances ------------------------------------------------------------------------------- - -type instance Index Value = Text -type instance IxValue Value = Value - -instance Applicative f => Ixed f Value where - ix i = _Object.ix i - -instance (Applicative f, Gettable f) => Contains f Value where - contains i f (Object o) = coerce (contains i f o) - contains i f _ = coerce (indexed f i False) - -instance Plated Value where - plate f (Object o) = Object <$> traverse f o - plate f (Array a) = Array <$> traverse f a - plate _ xs = pure xs diff --git a/src/Data/Aeson/Lens.hs b/src/Data/Aeson/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aeson/Lens.hs @@ -0,0 +1,454 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DefaultSignatures #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +-------------------------------------------------------------------- +-- | +-- Copyright : (c) Edward Kmett 2013-2014, (c) Paul Wilson 2012 +-- License : BSD3 +-- Maintainer: Edward Kmett +-- Stability : experimental +-- Portability: non-portable +-- +-------------------------------------------------------------------- +module Data.Aeson.Lens + ( + -- * Numbers + AsNumber(..) + , _Integral + , nonNull + -- * Primitive + , Primitive(..) + , AsPrimitive(..) + -- * Objects and Arrays + , AsValue(..) + , key, members + , nth, values + -- * Decoding + , AsJSON(..) + ) where + +import Control.Applicative +import Control.Lens +import Data.Aeson +import Data.Aeson.Parser (value) +import Data.Attoparsec.ByteString.Lazy (maybeResult, parse) +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.Lazy as LazyText +import Data.Text.Lens (packed) +import qualified Data.Text.Encoding as StrictText +import qualified Data.Text.Lazy.Encoding as LazyText +import Data.Vector (Vector) +import Prelude hiding (null) + +-- $setup +-- >>> import Data.ByteString.Char8 as Strict.Char8 +-- >>> :set -XOverloadedStrings + +------------------------------------------------------------------------------ +-- Scientific prisms +------------------------------------------------------------------------------ + +class AsNumber t where + -- | + -- >>> "[1, \"x\"]" ^? nth 0 . _Number + -- Just 1.0 + -- + -- >>> "[1, \"x\"]" ^? nth 1 . _Number + -- Nothing + _Number :: Prism' t Scientific +#ifndef HLINT + default _Number :: AsPrimitive t => Prism' t Scientific + _Number = _Primitive._Number + {-# INLINE _Number #-} +#endif + + -- | + -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Scientific' + -- + -- >>> "[10.2]" ^? nth 0 . _Double + -- Just 10.2 + _Double :: Prism' t Double + _Double = _Number.iso Scientific.toRealFloat realToFrac + {-# INLINE _Double #-} + + -- | + -- Prism into an 'Integer' over a 'Value', 'Primitive' or 'Scientific' + -- + -- >>> "[10]" ^? nth 0 . _Integer + -- Just 10 + -- + -- >>> "[10.5]" ^? nth 0 . _Integer + -- Just 10 + -- + -- >>> "42" ^? _Integer + -- Just 42 + _Integer :: Prism' t Integer + _Integer = _Number.iso floor fromIntegral + {-# INLINE _Integer #-} + +instance AsNumber Value where + _Number = prism Number $ \v -> case v of Number n -> Right n; _ -> Left v + {-# INLINE _Number #-} + +instance AsNumber Scientific where + _Number = id + {-# INLINE _Number #-} + +instance AsNumber Strict.ByteString +instance AsNumber Lazy.ByteString +instance AsNumber Text +instance AsNumber LazyText.Text +instance AsNumber String + +------------------------------------------------------------------------------ +-- Conversion Prisms +------------------------------------------------------------------------------ + +-- | Access Integer 'Value's as Integrals. +-- +-- >>> "[10]" ^? nth 0 . _Integral +-- Just 10 +-- +-- >>> "[10.5]" ^? nth 0 . _Integral +-- Just 10 +_Integral :: (AsNumber t, Integral a) => Prism' t a +_Integral = _Number . iso floor fromIntegral +{-# INLINE _Integral #-} + +------------------------------------------------------------------------------ +-- Null values and primitives +------------------------------------------------------------------------------ + +-- | Primitives of 'Value' +data Primitive + = StringPrim !Text + | NumberPrim !Scientific + | BoolPrim !Bool + | NullPrim + deriving (Eq,Ord,Show,Data,Typeable) + +instance AsNumber Primitive where + _Number = prism NumberPrim $ \v -> case v of NumberPrim s -> Right s; _ -> Left v + {-# INLINE _Number #-} + +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 :: Prism' t Primitive +#ifndef HLINT + default _Primitive :: AsValue t => Prism' t Primitive + _Primitive = _Value._Primitive + {-# INLINE _Primitive #-} +#endif + + -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String + -- Just "xyz" + -- + -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String + -- Nothing + -- + -- >>> _Object._Wrapped # [("key" :: Text, _String # "value")] + -- "{\"key\":\"value\"}" + _String :: Prism' t Text + _String = _Primitive.prism StringPrim (\v -> case v of StringPrim s -> Right s; _ -> Left v) + {-# INLINE _String #-} + + -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool + -- Just True + -- + -- "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool + -- Nothing + -- + -- >>> _Bool # True + -- "true" + -- + -- >>> _Bool # False + -- "false" + _Bool :: Prism' t Bool + _Bool = _Primitive.prism BoolPrim (\v -> case v of BoolPrim b -> Right b; _ -> Left v) + {-# INLINE _Bool #-} + + -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null + -- Just () + -- + -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null + -- Nothing + -- + -- >>> _Null # () + -- "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) + {-# 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 + -- | + -- >>> "[1,2,3]" ^? _Value + -- Just (Array (fromList [Number 1.0,Number 2.0,Number 3.0])) + _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 + -- "{\"key\":\"value\"}" + _Object :: Prism' t (HashMap Text Value) + _Object = _Value.prism Object (\v -> case v of Object o -> Right o; _ -> Left v) + {-# INLINE _Object #-} + + -- | + -- >>> "[1,2,3]" ^? _Array + -- Just (fromList [Number 1.0,Number 2.0,Number 3.0]) + _Array :: Prism' t (Vector Value) + _Array = _Value.prism Array (\v -> case v of Array a -> Right a; _ -> Left v) + {-# INLINE _Array #-} + +instance AsValue Value where + _Value = id + {-# INLINE _Value #-} + +instance AsValue Strict.ByteString where + _Value = _JSON + {-# INLINE _Value #-} + +instance AsValue Lazy.ByteString where + _Value = _JSON + {-# INLINE _Value #-} + +instance AsValue String where + _Value = strictUtf8._JSON + {-# INLINE _Value #-} + +instance AsValue Text where + _Value = strictTextUtf8._JSON + {-# INLINE _Value #-} + +instance AsValue LazyText.Text where + _Value = lazyTextUtf8._JSON + {-# INLINE _Value #-} + +-- | +-- Like 'ix', but for 'Object' with Text indices. This often has better +-- inference than 'ix' when used with OverloadedStrings. +-- +-- >>> "{\"a\": 100, \"b\": 200}" ^? key "a" +-- Just (Number 100.0) +-- +-- >>> "[1,2,3]" ^? key "a" +-- Nothing +key :: AsValue t => Text -> Traversal' t Value +key i = _Object . ix i +{-# INLINE key #-} + +-- | An indexed Traversal into Object properties +-- +-- > "{\"a\": 4, \"b\": 7}" ^@.. members +-- [("a",Number 4.0),("b",Number 7.0)] +-- +-- > "{\"a\": 4, \"b\": 7}" & members . _Number *~ 10 +-- "{\"a\":40,\"b\":70}" +members :: AsValue t => IndexedTraversal' Text t Value +members = _Object . itraversed +{-# INLINE members #-} + +-- | Like 'ix', but for Arrays with Int indexes +-- +-- >>> "[1,2,3]" ^? nth 1 +-- Just (Number 2.0) +-- +-- >>> "\"a\": 100, \"b\": 200}" ^? nth 1 +-- Nothing +-- +-- >>> "[1,2,3]" & nth 1 .~ Number 20 +-- "[1,20,3]" +nth :: AsValue t => Int -> Traversal' t Value +nth i = _Array . ix i +{-# INLINE nth #-} + +-- | An indexed Traversal into Array elements +-- +-- >>> "[1,2,3]" ^.. values +-- [Number 1.0,Number 2.0,Number 3.0] +-- +-- >>> "[1,2,3]" & values . _Number *~ 10 +-- "[10,20,30]" +values :: AsValue t => IndexedTraversal' Int t Value +values = _Array . traversed +{-# INLINE values #-} + +strictUtf8 :: Iso' String Strict.ByteString +strictUtf8 = packed . strictTextUtf8 + +strictTextUtf8 :: Iso' Text.Text Strict.ByteString +strictTextUtf8 = iso StrictText.encodeUtf8 StrictText.decodeUtf8 + +lazyTextUtf8 :: Iso' LazyText.Text Lazy.ByteString +lazyTextUtf8 = iso LazyText.encodeUtf8 LazyText.decodeUtf8 + +class AsJSON t where + -- | '_JSON' is a 'Prism' from something containing JSON to something encoded in that structure + _JSON :: (FromJSON a, ToJSON a) => Prism' t a + +instance AsJSON Strict.ByteString where + _JSON = lazy._JSON + {-# 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 + {-# INLINE _JSON #-} + +instance AsJSON String where + _JSON = strictUtf8._JSON + {-# INLINE _JSON #-} + +instance AsJSON Text where + _JSON = strictTextUtf8._JSON + {-# INLINE _JSON #-} + +instance AsJSON LazyText.Text where + _JSON = lazyTextUtf8._JSON + {-# INLINE _JSON #-} + +instance AsJSON Value where + _JSON = prism toJSON $ \x -> case fromJSON x of + Success y -> Right y; + _ -> Left x + {-# INLINE _JSON #-} + +------------------------------------------------------------------------------ +-- Some additional tests for prismhood; see https://github.com/ekmett/lens/issues/439. +------------------------------------------------------------------------------ + +-- $LazyByteStringTests +-- >>> "42" ^? (_JSON :: Prism' Lazy.ByteString Value) +-- Just (Number 42.0) +-- +-- >>> preview (_Integer :: Prism' Lazy.ByteString Integer) "42" +-- Just 42 +-- +-- >>> Lazy.unpack (review (_Integer :: Prism' Lazy.ByteString Integer) 42) +-- "42" + +-- $StrictByteStringTests +-- >>> "42" ^? (_JSON :: Prism' Strict.ByteString Value) +-- Just (Number 42.0) +-- +-- >>> preview (_Integer :: Prism' Strict.ByteString Integer) "42" +-- Just 42 +-- +-- >>> Strict.Char8.unpack (review (_Integer :: Prism' Strict.ByteString Integer) 42) +-- "42" + +-- $StringTests +-- >>> "42" ^? (_JSON :: Prism' String Value) +-- Just (Number 42.0) +-- +-- >>> preview (_Integer :: Prism' String Integer) "42" +-- Just 42 +-- +-- >>> review (_Integer :: Prism' String Integer) 42 +-- "42" + +------------------------------------------------------------------------------ +-- Orphan instances for lens library interop +------------------------------------------------------------------------------ + +type instance Index Value = Text + +type instance IxValue Value = Value +instance Ixed Value where + ix i f (Object o) = Object <$> ix i f o + ix _ _ v = pure v + {-# INLINE ix #-} + +instance Plated Value where + plate f (Object o) = Object <$> traverse f o + plate f (Array a) = Array <$> traverse f a + plate _ xs = pure xs + {-# INLINE plate #-} +