{-# 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
-- License   :  BSD3
-- Maintainer:  Colin Woodbury <colingw@gmail.com>
--
-- Traversals for Data.Aeson, based on microlens for minimal dependencies.
--
-- For basic manipulation of Aeson values, full `Prism` functionality isn't
-- necessary. Since all Prisms are inherently Traversals, we provide Traversals
-- that mimic the behaviour of the Prisms found in the original Data.Aeson.Lens.

module Lens.Micro.Aeson
  (
  -- * Numbers
    AsNumber(..)
  , _Integral
  , nonNull
  -- * Primitive
  , Primitive(..)
  , AsPrimitive(..)
  -- * Objects and Arrays
  , AsValue(..)
  , key, members
  , nth, values
  -- * Decoding
  , 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
import qualified Data.Text.Encoding as StrictText
import qualified Data.Text.Lazy as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText
import           Data.Vector (Vector)
import           GHC.Generics
import           Lens.Micro
import           Lens.Micro.Aeson.Internal ()
import           Prelude

#if MIN_VERSION_base(4,8,0)
import           Data.Hashable
#endif

------------------------------------------------------------------------------
-- Scientific Traversals
------------------------------------------------------------------------------

-- | Traverse into various number types.
class AsNumber t where
  -- |
  -- >>> "[1, \"x\"]" ^? nth 0 . _Number
  -- Just 1.0
  --
  -- >>> "[1, \"x\"]" ^? nth 1 . _Number
  -- Nothing
  _Number :: Traversal' t Scientific
  default _Number :: AsPrimitive t => Traversal' t Scientific
  _Number = (Primitive -> f Primitive) -> t -> f t
forall t. AsPrimitive t => Traversal' t Primitive
_Primitive ((Primitive -> f Primitive) -> t -> f t)
-> ((Scientific -> f Scientific) -> Primitive -> f Primitive)
-> (Scientific -> f Scientific)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> f Scientific) -> Primitive -> f Primitive
forall t. AsNumber t => Traversal' t Scientific
_Number
  {-# INLINE _Number #-}

  -- |
  -- Traversal into an 'Double' over a 'Value', 'Primitive' or 'Scientific'
  --
  -- >>> "[10.2]" ^? nth 0 . _Double
  -- Just 10.2
  _Double :: Traversal' t Double
  _Double = (Scientific -> f Scientific) -> t -> f t
forall t. AsNumber t => Traversal' t Scientific
_Number ((Scientific -> f Scientific) -> t -> f t)
-> ((Double -> f Double) -> Scientific -> f Scientific)
-> (Double -> f Double)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> Double)
-> (Scientific -> Double -> Scientific)
-> Lens Scientific Scientific Double Double
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat ((Double -> Scientific) -> Scientific -> Double -> Scientific
forall a b. a -> b -> a
const Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac)
  {-# INLINE _Double #-}

  -- |
  -- Traversal 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 :: Traversal' t Integer
  _Integer = (Scientific -> f Scientific) -> t -> f t
forall t. AsNumber t => Traversal' t Scientific
_Number ((Scientific -> f Scientific) -> t -> f t)
-> ((Integer -> f Integer) -> Scientific -> f Scientific)
-> (Integer -> f Integer)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> Integer)
-> (Scientific -> Integer -> Scientific)
-> Lens Scientific Scientific Integer Integer
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Integer -> Scientific) -> Scientific -> Integer -> Scientific
forall a b. a -> b -> a
const Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
  {-# INLINE _Integer #-}

instance AsNumber Value where
  _Number :: (Scientific -> f Scientific) -> Value -> f Value
_Number Scientific -> f Scientific
f (Number Scientific
n) = Scientific -> Value
Number (Scientific -> Value) -> f Scientific -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> f Scientific
f Scientific
n
  _Number Scientific -> f Scientific
_ Value
v          = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _Number #-}

instance AsNumber Scientific where
  _Number :: (Scientific -> f Scientific) -> Scientific -> f Scientific
_Number = (Scientific -> f Scientific) -> Scientific -> f Scientific
forall a. a -> a
id
  {-# INLINE _Number #-}

instance AsNumber Strict.ByteString
instance AsNumber Lazy.ByteString
instance AsNumber Text
instance AsNumber LazyText.Text
instance AsNumber String

------------------------------------------------------------------------------
-- Conversion Traversals
------------------------------------------------------------------------------

-- | Access Integer 'Value's as Integrals.
--
-- >>> "[10]" ^? nth 0 . _Integral
-- Just 10
--
-- >>> "[10.5]" ^? nth 0 . _Integral
-- Just 10
_Integral :: (AsNumber t, Integral a) => Traversal' t a
_Integral :: Traversal' t a
_Integral = (Scientific -> f Scientific) -> t -> f t
forall t. AsNumber t => Traversal' t Scientific
_Number ((Scientific -> f Scientific) -> t -> f t)
-> ((a -> f a) -> Scientific -> f Scientific)
-> (a -> f a)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> a)
-> (Scientific -> a -> Scientific)
-> Lens Scientific Scientific a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Scientific -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor ((a -> Scientific) -> Scientific -> a -> Scientific
forall a b. a -> b -> a
const a -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
{-# INLINE _Integral #-}

------------------------------------------------------------------------------
-- Null values and primitives
------------------------------------------------------------------------------

-- | 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 (Primitive -> Primitive -> Bool
(Primitive -> Primitive -> Bool)
-> (Primitive -> Primitive -> Bool) -> Eq Primitive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Primitive -> Primitive -> Bool
$c/= :: Primitive -> Primitive -> Bool
== :: Primitive -> Primitive -> Bool
$c== :: Primitive -> Primitive -> Bool
Eq, Eq Primitive
Eq Primitive
-> (Primitive -> Primitive -> Ordering)
-> (Primitive -> Primitive -> Bool)
-> (Primitive -> Primitive -> Bool)
-> (Primitive -> Primitive -> Bool)
-> (Primitive -> Primitive -> Bool)
-> (Primitive -> Primitive -> Primitive)
-> (Primitive -> Primitive -> Primitive)
-> Ord Primitive
Primitive -> Primitive -> Bool
Primitive -> Primitive -> Ordering
Primitive -> Primitive -> Primitive
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Primitive -> Primitive -> Primitive
$cmin :: Primitive -> Primitive -> Primitive
max :: Primitive -> Primitive -> Primitive
$cmax :: Primitive -> Primitive -> Primitive
>= :: Primitive -> Primitive -> Bool
$c>= :: Primitive -> Primitive -> Bool
> :: Primitive -> Primitive -> Bool
$c> :: Primitive -> Primitive -> Bool
<= :: Primitive -> Primitive -> Bool
$c<= :: Primitive -> Primitive -> Bool
< :: Primitive -> Primitive -> Bool
$c< :: Primitive -> Primitive -> Bool
compare :: Primitive -> Primitive -> Ordering
$ccompare :: Primitive -> Primitive -> Ordering
$cp1Ord :: Eq Primitive
Ord, Int -> Primitive -> ShowS
[Primitive] -> ShowS
Primitive -> String
(Int -> Primitive -> ShowS)
-> (Primitive -> String)
-> ([Primitive] -> ShowS)
-> Show Primitive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Primitive] -> ShowS
$cshowList :: [Primitive] -> ShowS
show :: Primitive -> String
$cshow :: Primitive -> String
showsPrec :: Int -> Primitive -> ShowS
$cshowsPrec :: Int -> Primitive -> ShowS
Show, (forall x. Primitive -> Rep Primitive x)
-> (forall x. Rep Primitive x -> Primitive) -> Generic Primitive
forall x. Rep Primitive x -> Primitive
forall x. Primitive -> Rep Primitive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Primitive x -> Primitive
$cfrom :: forall x. Primitive -> Rep Primitive x
Generic, Eq Primitive
Eq Primitive
-> (Int -> Primitive -> Int)
-> (Primitive -> Int)
-> Hashable Primitive
Int -> Primitive -> Int
Primitive -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Primitive -> Int
$chash :: Primitive -> Int
hashWithSalt :: Int -> Primitive -> Int
$chashWithSalt :: Int -> Primitive -> Int
$cp1Hashable :: Eq Primitive
Hashable)
#endif

instance AsNumber Primitive where
  _Number :: (Scientific -> f Scientific) -> Primitive -> f Primitive
_Number Scientific -> f Scientific
f (NumberPrim Scientific
n) = Scientific -> Primitive
NumberPrim (Scientific -> Primitive) -> f Scientific -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scientific -> f Scientific
f Scientific
n
  _Number Scientific -> f Scientific
_ Primitive
p              = Primitive -> f Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure Primitive
p
  {-# INLINE _Number #-}

-- | 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 -> f Value) -> t -> f t
forall t. AsValue t => Traversal' t Value
_Value ((Value -> f Value) -> t -> f t)
-> ((Primitive -> f Primitive) -> Value -> f Value)
-> (Primitive -> f Primitive)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Primitive -> f Primitive) -> Value -> f Value
forall t. AsPrimitive t => Traversal' t Primitive
_Primitive
  {-# INLINE _Primitive #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String
  -- Just "xyz"
  --
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String
  -- Nothing
  _String :: Traversal' t Text
  _String = (Primitive -> f Primitive) -> t -> f t
forall t. AsPrimitive t => Traversal' t Primitive
_Primitive ((Primitive -> f Primitive) -> t -> f t)
-> ((Text -> f Text) -> Primitive -> f Primitive)
-> (Text -> f Text)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Primitive -> f Primitive
forall (f :: * -> *).
Applicative f =>
(Text -> f Text) -> Primitive -> f Primitive
trav
    where trav :: (Text -> f Text) -> Primitive -> f Primitive
trav Text -> f Text
f (StringPrim Text
s) = Text -> Primitive
StringPrim (Text -> Primitive) -> f Text -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
s
          trav Text -> f Text
_ Primitive
x              = Primitive -> f Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure Primitive
x
  {-# INLINE _String #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _Bool
  -- Just True
  --
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _Bool
  -- Nothing
  _Bool :: Traversal' t Bool
  _Bool = (Primitive -> f Primitive) -> t -> f t
forall t. AsPrimitive t => Traversal' t Primitive
_Primitive ((Primitive -> f Primitive) -> t -> f t)
-> ((Bool -> f Bool) -> Primitive -> f Primitive)
-> (Bool -> f Bool)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> Primitive -> f Primitive
forall (f :: * -> *).
Applicative f =>
(Bool -> f Bool) -> Primitive -> f Primitive
trav
    where trav :: (Bool -> f Bool) -> Primitive -> f Primitive
trav Bool -> f Bool
f (BoolPrim Bool
b) = Bool -> Primitive
BoolPrim (Bool -> Primitive) -> f Bool -> f Primitive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
b
          trav Bool -> f Bool
_ Primitive
x            = Primitive -> f Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure Primitive
x
  {-# INLINE _Bool #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null
  -- Just ()
  --
  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null
  -- Nothing
  _Null :: Traversal' t ()
  _Null = (Primitive -> f Primitive) -> t -> f t
forall t. AsPrimitive t => Traversal' t Primitive
_Primitive ((Primitive -> f Primitive) -> t -> f t)
-> ((() -> f ()) -> Primitive -> f Primitive)
-> (() -> f ())
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> f ()) -> Primitive -> f Primitive
forall (f :: * -> *) b.
Applicative f =>
(() -> f b) -> Primitive -> f Primitive
trav
    where trav :: (() -> f b) -> Primitive -> f Primitive
trav () -> f b
f Primitive
NullPrim = Primitive
NullPrim Primitive -> f b -> f Primitive
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> f b
f ()
          trav () -> f b
_ Primitive
x        = Primitive -> f Primitive
forall (f :: * -> *) a. Applicative f => a -> f a
pure Primitive
x
  {-# INLINE _Null #-}

-- Helper for the function below.
fromPrim :: Primitive -> Value
fromPrim :: Primitive -> Value
fromPrim (StringPrim Text
s) = Text -> Value
String Text
s
fromPrim (NumberPrim Scientific
n) = Scientific -> Value
Number Scientific
n
fromPrim (BoolPrim Bool
b)   = Bool -> Value
Bool Bool
b
fromPrim Primitive
NullPrim       = Value
Null
{-# INLINE fromPrim #-}

instance AsPrimitive Value where
  _Primitive :: (Primitive -> f Primitive) -> Value -> f Value
_Primitive Primitive -> f Primitive
f (String Text
s) = Primitive -> Value
fromPrim (Primitive -> Value) -> f Primitive -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Primitive -> f Primitive
f (Text -> Primitive
StringPrim Text
s)
  _Primitive Primitive -> f Primitive
f (Number Scientific
n) = Primitive -> Value
fromPrim (Primitive -> Value) -> f Primitive -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Primitive -> f Primitive
f (Scientific -> Primitive
NumberPrim Scientific
n)
  _Primitive Primitive -> f Primitive
f (Bool Bool
b)   = Primitive -> Value
fromPrim (Primitive -> Value) -> f Primitive -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Primitive -> f Primitive
f (Bool -> Primitive
BoolPrim Bool
b)
  _Primitive Primitive -> f Primitive
f Value
Null       = Primitive -> Value
fromPrim (Primitive -> Value) -> f Primitive -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Primitive -> f Primitive
f Primitive
NullPrim
  _Primitive Primitive -> f Primitive
_ Value
v          = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _Primitive #-}

  _String :: (Text -> f Text) -> Value -> f Value
_String Text -> f Text
f (String Text
s) = Text -> Value
String (Text -> Value) -> f Text -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
s
  _String Text -> f Text
_ Value
v          = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _String #-}

  _Bool :: (Bool -> f Bool) -> Value -> f Value
_Bool Bool -> f Bool
f (Bool Bool
b) = Bool -> Value
Bool (Bool -> Value) -> f Bool -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
b
  _Bool Bool -> f Bool
_ Value
v        = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _Bool #-}

  _Null :: (() -> f ()) -> Value -> f Value
_Null () -> f ()
f Value
Null = Value
Null Value -> f () -> f Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ () -> f ()
f ()
  _Null () -> f ()
_ Value
v    = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
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 :: (Primitive -> f Primitive) -> Primitive -> f Primitive
_Primitive = (Primitive -> f Primitive) -> Primitive -> f Primitive
forall a. a -> a
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 :: (Value -> f Value) -> Value -> f Value
nonNull Value -> f Value
_ Value
Null = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
nonNull Value -> f Value
f Value
v    = (Value -> f Value) -> Value -> f Value
forall t. AsValue t => Traversal' t Value
_Value Value -> f Value
f Value
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 -> f Value) -> t -> f t
forall t. AsValue t => Traversal' t Value
_Value ((Value -> f Value) -> t -> f t)
-> ((HashMap Text Value -> f (HashMap Text Value))
    -> Value -> f Value)
-> (HashMap Text Value -> f (HashMap Text Value))
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Text Value -> f (HashMap Text Value)) -> Value -> f Value
forall (f :: * -> *).
Applicative f =>
(HashMap Text Value -> f (HashMap Text Value)) -> Value -> f Value
trav
    where
      trav :: (HashMap Text Value -> f (HashMap Text Value)) -> Value -> f Value
trav HashMap Text Value -> f (HashMap Text Value)
f (Object Object
o) = Object -> Value
Object (Object -> Value)
-> (HashMap Text Value -> Object) -> HashMap Text Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> Object
forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText (HashMap Text Value -> Value) -> f (HashMap Text Value) -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value -> f (HashMap Text Value)
f (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o)
      trav HashMap Text Value -> f (HashMap Text Value)
_ Value
v          = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _Object #-}

  _Array :: Traversal' t (Vector Value)
  _Array = (Value -> f Value) -> t -> f t
forall t. AsValue t => Traversal' t Value
_Value ((Value -> f Value) -> t -> f t)
-> ((Vector Value -> f (Vector Value)) -> Value -> f Value)
-> (Vector Value -> f (Vector Value))
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> f (Vector Value)) -> Value -> f Value
forall (f :: * -> *).
Applicative f =>
(Vector Value -> f (Vector Value)) -> Value -> f Value
trav
    where trav :: (Vector Value -> f (Vector Value)) -> Value -> f Value
trav Vector Value -> f (Vector Value)
f (Array Vector Value
a) = Vector Value -> Value
Array (Vector Value -> Value) -> f (Vector Value) -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Value -> f (Vector Value)
f Vector Value
a
          trav Vector Value -> f (Vector Value)
_ Value
v         = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _Array #-}

instance AsValue Value where
  _Value :: (Value -> f Value) -> Value -> f Value
_Value = (Value -> f Value) -> Value -> f Value
forall a. a -> a
id
  {-# INLINE _Value #-}

instance AsValue Strict.ByteString where
  _Value :: (Value -> f Value) -> ByteString -> f ByteString
_Value = (Value -> f Value) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _Value #-}

instance AsValue Lazy.ByteString where
  _Value :: (Value -> f Value) -> ByteString -> f ByteString
_Value = (Value -> f Value) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _Value #-}

instance AsValue String where
  _Value :: (Value -> f Value) -> String -> f String
_Value = (ByteString -> f ByteString) -> String -> f String
Lens' String ByteString
strictUtf8 ((ByteString -> f ByteString) -> String -> f String)
-> ((Value -> f Value) -> ByteString -> f ByteString)
-> (Value -> f Value)
-> String
-> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> f Value) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _Value #-}

instance AsValue Text where
  _Value :: (Value -> f Value) -> Text -> f Text
_Value = (ByteString -> f ByteString) -> Text -> f Text
Lens' Text ByteString
strictTextUtf8 ((ByteString -> f ByteString) -> Text -> f Text)
-> ((Value -> f Value) -> ByteString -> f ByteString)
-> (Value -> f Value)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> f Value) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _Value #-}

instance AsValue LazyText.Text where
  _Value :: (Value -> f Value) -> Text -> f Text
_Value = (ByteString -> f ByteString) -> Text -> f Text
Lens' Text ByteString
lazyTextUtf8 ((ByteString -> f ByteString) -> Text -> f Text)
-> ((Value -> f Value) -> ByteString -> f ByteString)
-> (Value -> f Value)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> f Value) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_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 :: Text -> Traversal' t Value
key Text
i = (HashMap Text Value -> f (HashMap Text Value)) -> t -> f t
forall t. AsValue t => Traversal' t (HashMap Text Value)
_Object ((HashMap Text Value -> f (HashMap Text Value)) -> t -> f t)
-> ((Value -> f Value)
    -> HashMap Text Value -> f (HashMap Text Value))
-> (Value -> f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Text Value)
-> Traversal' (HashMap Text Value) (IxValue (HashMap Text Value))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
Index (HashMap Text Value)
i
{-# INLINE key #-}

-- | A Traversal into Object properties
--
-- >>> "{\"a\": 4, \"b\": 7}" ^.. members
-- [Number 4.0,Number 7.0]
--
-- >>> "{\"a\": 4, \"b\": 7}" & members . _Number %~ (* 10)
-- "{\"a\":40,\"b\":70}"
members :: AsValue t => Traversal' t Value
members :: Traversal' t Value
members = (HashMap Text Value -> f (HashMap Text Value)) -> t -> f t
forall t. AsValue t => Traversal' t (HashMap Text Value)
_Object ((HashMap Text Value -> f (HashMap Text Value)) -> t -> f t)
-> ((Value -> f Value)
    -> HashMap Text Value -> f (HashMap Text Value))
-> (Value -> f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> f Value) -> HashMap Text Value -> f (HashMap Text Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# 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 :: Int -> Traversal' t Value
nth Int
i = (Vector Value -> f (Vector Value)) -> t -> f t
forall t. AsValue t => Traversal' t (Vector Value)
_Array ((Vector Value -> f (Vector Value)) -> t -> f t)
-> ((Value -> f Value) -> Vector Value -> f (Vector Value))
-> (Value -> f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Vector Value)
-> Traversal' (Vector Value) (IxValue (Vector Value))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Vector Value)
i
{-# INLINE nth #-}

-- | A 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 => Traversal' t Value
values :: Traversal' t Value
values = (Vector Value -> f (Vector Value)) -> t -> f t
forall t. AsValue t => Traversal' t (Vector Value)
_Array ((Vector Value -> f (Vector Value)) -> t -> f t)
-> ((Value -> f Value) -> Vector Value -> f (Vector Value))
-> (Value -> f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> f Value) -> Vector Value -> f (Vector Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
{-# INLINE values #-}

strictUtf8 :: Lens' String Strict.ByteString
strictUtf8 :: (ByteString -> f ByteString) -> String -> f String
strictUtf8 = (String -> Text)
-> (String -> Text -> String) -> Lens String String Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens String -> Text
Text.pack ((Text -> String) -> String -> Text -> String
forall a b. a -> b -> a
const Text -> String
Text.unpack) ((Text -> f Text) -> String -> f String)
-> ((ByteString -> f ByteString) -> Text -> f Text)
-> (ByteString -> f ByteString)
-> String
-> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> f ByteString) -> Text -> f Text
Lens' Text ByteString
strictTextUtf8

lazyUtf8 :: Lens' Strict.ByteString Lazy.ByteString
lazyUtf8 :: (ByteString -> f ByteString) -> ByteString -> f ByteString
lazyUtf8 = (ByteString -> ByteString)
-> (ByteString -> ByteString -> ByteString)
-> Lens ByteString ByteString ByteString ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ByteString -> ByteString
Lazy.fromStrict ((ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a b. a -> b -> a
const ByteString -> ByteString
Lazy.toStrict)

strictTextUtf8 :: Lens' Text.Text Strict.ByteString
strictTextUtf8 :: (ByteString -> f ByteString) -> Text -> f Text
strictTextUtf8 = (Text -> ByteString)
-> (Text -> ByteString -> Text) -> Lens' Text ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Text -> ByteString
StrictText.encodeUtf8 ((ByteString -> Text) -> Text -> ByteString -> Text
forall a b. a -> b -> a
const ByteString -> Text
StrictText.decodeUtf8)

lazyTextUtf8 :: Lens' LazyText.Text Lazy.ByteString
lazyTextUtf8 :: (ByteString -> f ByteString) -> Text -> f Text
lazyTextUtf8 = (Text -> ByteString)
-> (Text -> ByteString -> Text) -> Lens' Text ByteString
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Text -> ByteString
LazyText.encodeUtf8 ((ByteString -> Text) -> Text -> ByteString -> Text
forall a b. a -> b -> a
const ByteString -> Text
LazyText.decodeUtf8)

-- | Traverse into actual encoded JSON.
class AsJSON t where
  -- | '_JSON' is a 'Traversal' from something containing JSON
  -- to something encoded in that structure.
  _JSON :: (FromJSON a, ToJSON a) => Traversal' t a

instance AsJSON Strict.ByteString where
  _JSON :: Traversal' ByteString a
_JSON = (ByteString -> f ByteString) -> ByteString -> f ByteString
Lens ByteString ByteString ByteString ByteString
lazyUtf8 ((ByteString -> f ByteString) -> ByteString -> f ByteString)
-> ((a -> f a) -> ByteString -> f ByteString)
-> (a -> f a)
-> ByteString
-> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _JSON #-}

instance AsJSON Lazy.ByteString where
  _JSON :: Traversal' ByteString a
_JSON a -> f a
f ByteString
b = f ByteString -> (a -> f ByteString) -> Maybe a -> f ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> f ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b) ((a -> ByteString) -> f a -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ByteString
forall a. ToJSON a => a -> ByteString
encode (f a -> f ByteString) -> (a -> f a) -> a -> f ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
f) Maybe a
v
    where v :: Maybe a
v = Result Value -> Maybe Value
forall r. Result r -> Maybe r
maybeResult (Parser Value -> ByteString -> Result Value
forall a. Parser a -> ByteString -> Result a
parse Parser Value
value ByteString
b) Maybe Value -> (Value -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Value
x -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
x of
            Success a
x' -> a -> Maybe a
forall a. a -> Maybe a
Just a
x'
            Result a
_          -> Maybe a
forall a. Maybe a
Nothing
  {-# INLINE _JSON #-}

instance AsJSON String where
  _JSON :: Traversal' String a
_JSON = (ByteString -> f ByteString) -> String -> f String
Lens' String ByteString
strictUtf8 ((ByteString -> f ByteString) -> String -> f String)
-> ((a -> f a) -> ByteString -> f ByteString)
-> (a -> f a)
-> String
-> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _JSON #-}

instance AsJSON Text where
  _JSON :: Traversal' Text a
_JSON = (ByteString -> f ByteString) -> Text -> f Text
Lens' Text ByteString
strictTextUtf8 ((ByteString -> f ByteString) -> Text -> f Text)
-> ((a -> f a) -> ByteString -> f ByteString)
-> (a -> f a)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _JSON #-}

instance AsJSON LazyText.Text where
  _JSON :: Traversal' Text a
_JSON = (ByteString -> f ByteString) -> Text -> f Text
Lens' Text ByteString
lazyTextUtf8 ((ByteString -> f ByteString) -> Text -> f Text)
-> ((a -> f a) -> ByteString -> f ByteString)
-> (a -> f a)
-> Text
-> f Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> ByteString -> f ByteString
forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _JSON #-}

instance AsJSON Value where
  _JSON :: Traversal' Value a
_JSON a -> f a
f Value
v = case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
    Success a
v' -> a -> Value
forall a. ToJSON a => a -> Value
toJSON (a -> Value) -> f a -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
v'
    Result a
_          -> Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _JSON #-}

-- $LazyByteStringTests
-- >>> ("42" :: Lazy.ByteString) ^? (_JSON :: Traversal' Lazy.ByteString Value)
-- Just (Number 42.0)
--
-- >>> ("42" :: Lazy.ByteString) ^? _Integer
-- Just 42

-- $StrictByteStringTests
-- >>> ("42" :: Strict.ByteString) ^? (_JSON :: Traversal' Strict.ByteString Value)
-- Just (Number 42.0)
--
-- >>> ("42" :: Lazy.ByteString) ^? _Integer
-- Just 42

-- $StringTests
-- >>> ("42" :: String) ^? (_JSON :: Traversal' String Value)
-- Just (Number 42.0)
--
-- >>> ("42" :: String) ^? _Integer
-- Just 42