{-# LANGUAGE CPP               #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes        #-}

-- |
-- Module    :  Lens.Micro.Aeson
-- Copyright :  (c) Colin Woodbury 2015-2022, (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
  -- * Objects and Arrays
  , AsValue(..)
  , key, members
  , nth, values
  -- * Decoding
  , AsJSON(..)
  ) where

import           Data.Aeson
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as Strict
import           Data.ByteString.Lazy.Char8 as Lazy
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 qualified Data.Vector as V
import           Lens.Micro
import           Lens.Micro.Aeson.Internal ()
import           Prelude

#if !MIN_VERSION_aeson(2,2,0)
import           Data.Aeson.Parser (value)
import           Data.Attoparsec.ByteString.Lazy (maybeResult, parse)
#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 :: AsValue t => Traversal' t Scientific
  _Number = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. AsNumber t => Traversal' t Scientific
_Number
  {-# INLINE _Number #-}

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

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

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

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

------------------------------------------------------------------------------
-- Null values
------------------------------------------------------------------------------

-- | 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 :: Traversal' Value Value
nonNull Value -> f Value
_ Value
Null = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
nonNull Value -> f Value
f Value
v    = forall t. AsValue t => Traversal' t Value
_Value Value -> f Value
f Value
v
{-# INLINE nonNull #-}

------------------------------------------------------------------------------
-- Non-number traversals
------------------------------------------------------------------------------

-- | 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
  -- Just "xyz"
  --
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String
  -- Nothing
  _String :: Traversal' t Text
  _String = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *}.
Applicative f =>
(Text -> f Text) -> Value -> f Value
trav
    where trav :: (Text -> f Text) -> Value -> f Value
trav Text -> f Text
f (String Text
s) = Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
s
          trav Text -> f Text
_ Value
v          = forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _String #-}

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

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

  -- |
  -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object
  -- Just (fromList [])
  --
  -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object
  -- Nothing
  _Object :: Traversal' t (KM.KeyMap Value)
  _Object = forall t. AsValue t => Traversal' t Value
_Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. \KeyMap Value -> f (KeyMap Value)
f Value
v -> case Value
v of Object KeyMap Value
o -> KeyMap Value -> Value
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap Value -> f (KeyMap Value)
f KeyMap Value
o; Value
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE _Object #-}

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

instance AsValue Value where
  _Value :: Traversal' Value Value
_Value = forall a. a -> a
id
  {-# INLINE _Value #-}

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

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

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

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

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

-- |
-- 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"
-- Just (Number 100.0)
--
-- >>> "[1,2,3]" ^? key "a"
-- Nothing
key :: AsValue t => Key -> Traversal' t Value
key :: forall t. AsValue t => Key -> Traversal' t Value
key Key
i = forall t. AsValue t => Traversal' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
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 :: forall t. AsValue t => Traversal' t Value
members = forall t. AsValue t => Traversal' t (KeyMap Value)
_Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall t. AsValue t => Int -> Traversal' t Value
nth Int
i = forall t. AsValue t => Traversal' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {a}.
Applicative f =>
(a -> f a) -> Vector a -> f (Vector a)
vectorIxI
  where
    vectorIxI :: (a -> f a) -> Vector a -> f (Vector a)
vectorIxI a -> f a
f Vector a
a
      | Int
0 forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
V.length Vector a
a = a -> f a
f (Vector a
a forall a. Vector a -> Int -> a
V.! Int
i) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v -> Vector a
a forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Int
i, a
v)]
      | Bool
otherwise                = forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector a
a
{-# 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 :: forall t. AsValue t => Traversal' t Value
values = forall t. AsValue t => Traversal' t (Vector Value)
_Array forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Lens' String ByteString
strictUtf8 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens String -> Text
Text.pack (forall a b. a -> b -> a
const Text -> String
Text.unpack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Text ByteString
strictTextUtf8

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

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

lazyTextUtf8 :: Lens' LazyText.Text Lazy.ByteString
lazyTextUtf8 :: Lens' Text ByteString
lazyTextUtf8 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Text -> ByteString
LazyText.encodeUtf8 (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 :: forall a. (FromJSON a, ToJSON a) => Traversal' ByteString a
_JSON = Lens' ByteString ByteString
lazyUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. (AsJSON t, FromJSON a, ToJSON a) => Traversal' t a
_JSON
  {-# INLINE _JSON #-}

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

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

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

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

instance AsJSON Value where
  _JSON :: forall a. (FromJSON a, ToJSON a) => Traversal' Value a
_JSON a -> f a
f Value
v = case forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
    Success a
v' -> forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
v'
    Result a
_          -> 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