{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DefaultSignatures     #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE Trustworthy           #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Oleg Grenrus 2019, (c) Edward Kmett 2013-2019, (c) Paul Wilson 2012
-- License   :  MIT
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
-- This module also exports orphan @'Ixed' 'Value'@ and
-- @'Plated' 'Value'@ instances.
--------------------------------------------------------------------
module Data.Aeson.Optics
  (
  -- * Numbers
    AsNumber(..)
  , _Integral
  , nonNull
  -- * Primitive
  , Primitive(..)
  , AsPrimitive(..)
  -- * Objects and Arrays
  , AsValue(..)
  , key, members
  , nth, values
  -- * Decoding
  , AsJSON(..)
  , _JSON'
  -- * Pattern Synonyms
  , pattern JSON
  , pattern Value_
  , pattern Number_
  , pattern Double
  , pattern Integer
  , pattern Integral
  , pattern Primitive
  , pattern Bool_
  , pattern String_
  , pattern Null_
  ) where

import Prelude ()
import Prelude.Compat hiding (null)

import Data.Aeson
       (FromJSON, Result (..), ToJSON, Value (..), encode, fromJSON, toJSON)
import Data.Aeson.Parser               (value)
import Data.Attoparsec.ByteString.Lazy (maybeResult, parse)
import Data.ByteString.Lazy.Char8      as Lazy hiding (putStrLn)
import Data.Data
import Data.HashMap.Strict             (HashMap)
import Data.Scientific                 (Scientific)
import Data.Text                       (Text)
import Data.Text.Optics                (packed)
import Data.Vector                     (Vector)

import Optics.At ()
import Optics.Core
import Optics.Indexed ()

import qualified Data.ByteString         as Strict
import qualified Data.ByteString.Lazy    as LBS
import qualified Data.Scientific         as Scientific
import qualified Data.Text               as StrictText
import qualified Data.Text.Encoding      as StrictText
import qualified Data.Text.Lazy          as LazyText
import qualified Data.Text.Lazy.Encoding as LazyText

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key    as Key
import qualified Data.Aeson.KeyMap as KM
#endif

-- $setup
-- >>> import Data.ByteString.Char8 as Strict.Char8
-- >>> import qualified Data.Vector as Vector
-- >>> import qualified Data.HashMap.Strict as HashMap
-- >>> :set -XOverloadedStrings
-- >>> import Optics.Operators

------------------------------------------------------------------------------
-- Scientific prisms
------------------------------------------------------------------------------

class AsNumber t where
  -- |
  -- >>> "[1, \"x\"]" ^? nth 0 % _Number
  -- Just 1.0
  --
  -- >>> "[1, \"x\"]" ^? nth 1 % _Number
  -- Nothing
  _Number :: Prism' t Scientific
  default _Number :: AsPrimitive t => Prism' t Scientific
  _Number = Prism' t Primitive
forall t. AsPrimitive t => Prism' t Primitive
_PrimitivePrism' t Primitive
-> Optic A_Prism NoIx Primitive Primitive Scientific Scientific
-> Prism' t Scientific
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%Optic A_Prism NoIx Primitive Primitive Scientific Scientific
forall t. AsNumber t => Prism' t Scientific
_Number
  {-# INLINE _Number #-}

  -- |
  -- Prism into an 'Double' over a 'Value', 'Primitive' or 'Scientific'
  --
  -- >>> "[10.2]" ^? nth 0 % _Double
  -- Just 10.2
  _Double :: Prism' t Double
  _Double = Prism' t Scientific
forall t. AsNumber t => Prism' t Scientific
_NumberPrism' t Scientific
-> Optic An_Iso NoIx Scientific Scientific Double Double
-> Prism' t Double
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%(Scientific -> Double)
-> (Double -> Scientific)
-> Optic An_Iso NoIx Scientific Scientific Double Double
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
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 = Prism' t Scientific
forall t. AsNumber t => Prism' t Scientific
_NumberPrism' t Scientific
-> Optic An_Iso NoIx Scientific Scientific Integer Integer
-> Prism' t Integer
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%(Scientific -> Integer)
-> (Integer -> Scientific)
-> Optic An_Iso NoIx Scientific Scientific Integer Integer
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Scientific -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE _Integer #-}

instance AsNumber Value where
  _Number :: Prism' Value Scientific
_Number = (Scientific -> Value)
-> (Value -> Either Value Scientific) -> Prism' Value Scientific
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Scientific -> Value
Number ((Value -> Either Value Scientific) -> Prism' Value Scientific)
-> (Value -> Either Value Scientific) -> Prism' Value Scientific
forall a b. (a -> b) -> a -> b
$ \Value
v -> case Value
v of Number Scientific
n -> Scientific -> Either Value Scientific
forall a b. b -> Either a b
Right Scientific
n; Value
_ -> Value -> Either Value Scientific
forall a b. a -> Either a b
Left Value
v
  {-# INLINE _Number #-}

instance AsNumber Scientific where
  _Number :: Prism' Scientific Scientific
_Number = Optic An_Iso NoIx Scientific Scientific Scientific Scientific
-> Prism' Scientific Scientific
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic An_Iso NoIx Scientific Scientific Scientific Scientific
forall a. Iso' a a
simple
  {-# 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 :: Prism' t a
_Integral = Prism' t Scientific
forall t. AsNumber t => Prism' t Scientific
_Number Prism' t Scientific
-> Optic An_Iso NoIx Scientific Scientific a a -> Prism' t a
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Scientific -> a)
-> (a -> Scientific) -> Optic An_Iso NoIx Scientific Scientific a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Scientific -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor 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
  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,Typeable Primitive
DataType
Constr
Typeable Primitive
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Primitive -> c Primitive)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Primitive)
-> (Primitive -> Constr)
-> (Primitive -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Primitive))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive))
-> ((forall b. Data b => b -> b) -> Primitive -> Primitive)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Primitive -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Primitive -> r)
-> (forall u. (forall d. Data d => d -> u) -> Primitive -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Primitive -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Primitive -> m Primitive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Primitive -> m Primitive)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Primitive -> m Primitive)
-> Data Primitive
Primitive -> DataType
Primitive -> Constr
(forall b. Data b => b -> b) -> Primitive -> Primitive
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Primitive -> c Primitive
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Primitive
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Primitive -> u
forall u. (forall d. Data d => d -> u) -> Primitive -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Primitive -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Primitive -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Primitive -> m Primitive
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Primitive -> m Primitive
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Primitive
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Primitive -> c Primitive
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Primitive)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive)
$cNullPrim :: Constr
$cBoolPrim :: Constr
$cNumberPrim :: Constr
$cStringPrim :: Constr
$tPrimitive :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Primitive -> m Primitive
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Primitive -> m Primitive
gmapMp :: (forall d. Data d => d -> m d) -> Primitive -> m Primitive
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Primitive -> m Primitive
gmapM :: (forall d. Data d => d -> m d) -> Primitive -> m Primitive
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Primitive -> m Primitive
gmapQi :: Int -> (forall d. Data d => d -> u) -> Primitive -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Primitive -> u
gmapQ :: (forall d. Data d => d -> u) -> Primitive -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Primitive -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Primitive -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Primitive -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Primitive -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Primitive -> r
gmapT :: (forall b. Data b => b -> b) -> Primitive -> Primitive
$cgmapT :: (forall b. Data b => b -> b) -> Primitive -> Primitive
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Primitive)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Primitive)
dataTypeOf :: Primitive -> DataType
$cdataTypeOf :: Primitive -> DataType
toConstr :: Primitive -> Constr
$ctoConstr :: Primitive -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Primitive
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Primitive
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Primitive -> c Primitive
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Primitive -> c Primitive
$cp1Data :: Typeable Primitive
Data,Typeable)

instance AsNumber Primitive where
  _Number :: Optic A_Prism NoIx Primitive Primitive Scientific Scientific
_Number = (Scientific -> Primitive)
-> (Primitive -> Either Primitive Scientific)
-> Optic A_Prism NoIx Primitive Primitive Scientific Scientific
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Scientific -> Primitive
NumberPrim ((Primitive -> Either Primitive Scientific)
 -> Optic A_Prism NoIx Primitive Primitive Scientific Scientific)
-> (Primitive -> Either Primitive Scientific)
-> Optic A_Prism NoIx Primitive Primitive Scientific Scientific
forall a b. (a -> b) -> a -> b
$ \Primitive
v -> case Primitive
v of NumberPrim Scientific
s -> Scientific -> Either Primitive Scientific
forall a b. b -> Either a b
Right Scientific
s; Primitive
_ -> Primitive -> Either Primitive Scientific
forall a b. a -> Either a b
Left Primitive
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
  default _Primitive :: AsValue t => Prism' t Primitive
  _Primitive = Prism' t Value
forall t. AsValue t => Prism' t Value
_ValuePrism' t Value
-> Optic A_Prism NoIx Value Value Primitive Primitive
-> Prism' t Primitive
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%Optic A_Prism NoIx Value Value Primitive Primitive
forall t. AsPrimitive t => Prism' t Primitive
_Primitive
  {-# INLINE _Primitive #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" % _String
  -- Just "xyz"
  --
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" % _String
  -- Nothing
  --
  -- >>> _Object # HashMap.fromList [("key", _String # "value")] :: String
  -- "{\"key\":\"value\"}"
  _String :: Prism' t Text
  _String = Prism' t Primitive
forall t. AsPrimitive t => Prism' t Primitive
_PrimitivePrism' t Primitive
-> Optic A_Prism NoIx Primitive Primitive Text Text
-> Prism' t Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%(Text -> Primitive)
-> (Primitive -> Either Primitive Text)
-> Optic A_Prism NoIx Primitive Primitive Text Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> Primitive
StringPrim (\Primitive
v -> case Primitive
v of StringPrim Text
s -> Text -> Either Primitive Text
forall a b. b -> Either a b
Right Text
s; Primitive
_ -> Primitive -> Either Primitive Text
forall a b. a -> Either a b
Left Primitive
v)
  {-# INLINE _String #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" % _Bool
  -- Just True
  --
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "a" % _Bool
  -- Nothing
  --
  -- >>> _Bool # True :: String
  -- "true"
  --
  -- >>> _Bool # False :: String
  -- "false"
  _Bool :: Prism' t Bool
  _Bool = Prism' t Primitive
forall t. AsPrimitive t => Prism' t Primitive
_PrimitivePrism' t Primitive
-> Optic A_Prism NoIx Primitive Primitive Bool Bool
-> Prism' t Bool
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%(Bool -> Primitive)
-> (Primitive -> Either Primitive Bool)
-> Optic A_Prism NoIx Primitive Primitive Bool Bool
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Bool -> Primitive
BoolPrim (\Primitive
v -> case Primitive
v of BoolPrim Bool
b -> Bool -> Either Primitive Bool
forall a b. b -> Either a b
Right Bool
b; Primitive
_ -> Primitive -> Either Primitive Bool
forall a b. a -> Either a b
Left Primitive
v)
  {-# INLINE _Bool #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" % _Null
  -- Just ()
  --
  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" % _Null
  -- Nothing
  --
  -- >>> _Null # () :: String
  -- "null"
  _Null :: Prism' t ()
  _Null = Prism' t Primitive
forall t. AsPrimitive t => Prism' t Primitive
_Primitive Prism' t Primitive
-> Optic A_Prism NoIx Primitive Primitive () () -> Prism' t ()
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (() -> Primitive)
-> (Primitive -> Either Primitive ())
-> Optic A_Prism NoIx Primitive Primitive () ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Primitive -> () -> Primitive
forall a b. a -> b -> a
const Primitive
NullPrim) (\Primitive
v -> case Primitive
v of Primitive
NullPrim -> () -> Either Primitive ()
forall a b. b -> Either a b
Right (); Primitive
_ -> Primitive -> Either Primitive ()
forall a b. a -> Either a b
Left Primitive
v)
  {-# INLINE _Null #-}


instance AsPrimitive Value where
  _Primitive :: Optic A_Prism NoIx Value Value Primitive Primitive
_Primitive = (Primitive -> Value)
-> (Value -> Either Value Primitive)
-> Optic A_Prism NoIx Value Value Primitive Primitive
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Primitive -> Value
fromPrim Value -> Either Value Primitive
toPrim
    where
      toPrim :: Value -> Either Value Primitive
toPrim (String Text
s) = Primitive -> Either Value Primitive
forall a b. b -> Either a b
Right (Primitive -> Either Value Primitive)
-> Primitive -> Either Value Primitive
forall a b. (a -> b) -> a -> b
$ Text -> Primitive
StringPrim Text
s
      toPrim (Number Scientific
n) = Primitive -> Either Value Primitive
forall a b. b -> Either a b
Right (Primitive -> Either Value Primitive)
-> Primitive -> Either Value Primitive
forall a b. (a -> b) -> a -> b
$ Scientific -> Primitive
NumberPrim Scientific
n
      toPrim (Bool Bool
b)   = Primitive -> Either Value Primitive
forall a b. b -> Either a b
Right (Primitive -> Either Value Primitive)
-> Primitive -> Either Value Primitive
forall a b. (a -> b) -> a -> b
$ Bool -> Primitive
BoolPrim Bool
b
      toPrim Value
Null       = Primitive -> Either Value Primitive
forall a b. b -> Either a b
Right Primitive
NullPrim
      toPrim Value
v          = Value -> Either Value Primitive
forall a b. a -> Either a b
Left Value
v
      {-# INLINE toPrim #-}
      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 #-}
  {-# INLINE _Primitive #-}
  _String :: Prism' Value Text
_String = (Text -> Value)
-> (Value -> Either Value Text) -> Prism' Value Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> Value
String ((Value -> Either Value Text) -> Prism' Value Text)
-> (Value -> Either Value Text) -> Prism' Value Text
forall a b. (a -> b) -> a -> b
$ \Value
v -> case Value
v of String Text
s -> Text -> Either Value Text
forall a b. b -> Either a b
Right Text
s; Value
_ -> Value -> Either Value Text
forall a b. a -> Either a b
Left Value
v
  {-# INLINE _String #-}
  _Bool :: Prism' Value Bool
_Bool = (Bool -> Value)
-> (Value -> Either Value Bool) -> Prism' Value Bool
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Bool -> Value
Bool (\Value
v -> case Value
v of Bool Bool
b -> Bool -> Either Value Bool
forall a b. b -> Either a b
Right Bool
b; Value
_ -> Value -> Either Value Bool
forall a b. a -> Either a b
Left Value
v)
  {-# INLINE _Bool #-}
  _Null :: Prism' Value ()
_Null = (() -> Value) -> (Value -> Either Value ()) -> Prism' Value ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (Value -> () -> Value
forall a b. a -> b -> a
const Value
Null) (\Value
v -> case Value
v of Value
Null -> () -> Either Value ()
forall a b. b -> Either a b
Right (); Value
_ -> Value -> Either Value ()
forall a b. a -> Either a b
Left Value
v)
  {-# INLINE _Null #-}

instance AsPrimitive Strict.ByteString
instance AsPrimitive Lazy.ByteString
instance AsPrimitive StrictText.Text
instance AsPrimitive LazyText.Text
instance AsPrimitive String

instance AsPrimitive Primitive where
  _Primitive :: Prism' Primitive Primitive
_Primitive = Optic An_Iso NoIx Primitive Primitive Primitive Primitive
-> Prism' Primitive Primitive
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic An_Iso NoIx Primitive Primitive Primitive Primitive
forall a. Iso' a a
simple
  {-# 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' Value Value
nonNull = (Value -> Value)
-> (Value -> Either Value Value) -> Prism' Value Value
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Value -> Value
forall a. a -> a
id (\Value
v -> if Prism' Value () -> Value -> Bool
forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Bool
isn't Prism' Value ()
forall t. AsPrimitive t => Prism' t ()
_Null Value
v then Value -> Either Value Value
forall a b. b -> Either a b
Right Value
v else Value -> Either Value Value
forall a b. a -> Either a b
Left Value
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 # HashMap.fromList [("key", _String # "value")] :: String
  -- "{\"key\":\"value\"}"
  _Object :: Prism' t (HashMap Text Value)
  _Object = Prism' t Value
forall t. AsValue t => Prism' t Value
_ValuePrism' t Value
-> Optic
     A_Prism NoIx Value Value (HashMap Text Value) (HashMap Text Value)
-> Prism' t (HashMap Text Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%(HashMap Text Value -> Value)
-> (Value -> Either Value (HashMap Text Value))
-> Optic
     A_Prism NoIx Value Value (HashMap Text Value) (HashMap Text Value)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism (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
fwd) (\Value
v -> case Value
v of Object Object
o -> HashMap Text Value -> Either Value (HashMap Text Value)
forall a b. b -> Either a b
Right (Object -> HashMap Text Value
forall v. KeyMap v -> HashMap Text v
bwd Object
o); Value
_ -> Value -> Either Value (HashMap Text Value)
forall a b. a -> Either a b
Left Value
v)
    where
#if MIN_VERSION_aeson(2,0,0)
    fwd :: HashMap Text v -> KeyMap v
fwd = HashMap Text v -> KeyMap v
forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText
    bwd :: KeyMap v -> HashMap Text v
bwd = KeyMap v -> HashMap Text v
forall v. KeyMap v -> HashMap Text v
KM.toHashMapText
#else
    fwd = id
    bwd = id
#endif
  {-# INLINE _Object #-}

  -- |
  -- >>> preview _Array "[1,2,3]" == Just (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])
  -- True
  _Array :: Prism' t (Vector Value)
  _Array = Prism' t Value
forall t. AsValue t => Prism' t Value
_ValuePrism' t Value
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
-> Prism' t (Vector Value)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%(Vector Value -> Value)
-> (Value -> Either Value (Vector Value))
-> Optic A_Prism NoIx Value Value (Vector Value) (Vector Value)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Vector Value -> Value
Array (\Value
v -> case Value
v of Array Vector Value
a -> Vector Value -> Either Value (Vector Value)
forall a b. b -> Either a b
Right Vector Value
a; Value
_ -> Value -> Either Value (Vector Value)
forall a b. a -> Either a b
Left Value
v)
  {-# INLINE _Array #-}

instance AsValue Value where
  _Value :: Prism' Value Value
_Value = Optic An_Iso NoIx Value Value Value Value -> Prism' Value Value
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic An_Iso NoIx Value Value Value Value
forall a. Iso' a a
simple
  {-# INLINE _Value #-}

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

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

instance AsValue String where
  _Value :: Prism' String Value
_Value = Iso' String ByteString
strictUtf8Iso' String ByteString
-> Prism' ByteString Value -> Prism' String Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%Prism' ByteString Value
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  {-# INLINE _Value #-}

instance AsValue Text where
  _Value :: Prism' Text Value
_Value = Iso' Text ByteString
strictTextUtf8Iso' Text ByteString
-> Prism' ByteString Value -> Prism' Text Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%Prism' ByteString Value
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  {-# INLINE _Value #-}

instance AsValue LazyText.Text where
  _Value :: Prism' Text Value
_Value = Iso' Text ByteString
lazyTextUtf8Iso' Text ByteString
-> Prism' ByteString Value -> Prism' Text Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
%Prism' ByteString Value
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_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 -> AffineTraversal' t Value
key :: Text -> AffineTraversal' t Value
key Text
i = Prism' t (HashMap Text Value)
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object Prism' t (HashMap Text Value)
-> Optic
     An_AffineTraversal
     NoIx
     (HashMap Text Value)
     (HashMap Text Value)
     Value
     Value
-> AffineTraversal' t Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (HashMap Text Value)
-> Optic'
     (IxKind (HashMap Text Value))
     NoIx
     (HashMap Text Value)
     (IxValue (HashMap Text Value))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Text
Index (HashMap Text Value)
i
{-# INLINE key #-}

-- | An indexed Traversal into Object properties
--
-- >>> Data.List.sort (itoListOf (members % _Number) "{\"a\": 4, \"b\": 7}")
-- [("a",4.0),("b",7.0)]
--
-- >>> "{\"a\": 4}" & members % _Number %~ (*10)
-- "{\"a\":40}"
members :: AsValue t => IxTraversal' Text t Value
members :: IxTraversal' Text t Value
members = Prism' t (HashMap Text Value)
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object Prism' t (HashMap Text Value)
-> Optic
     A_Traversal
     (WithIx Text)
     (HashMap Text Value)
     (HashMap Text Value)
     Value
     Value
-> IxTraversal' Text t Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal
  (WithIx Text)
  (HashMap Text Value)
  (HashMap Text Value)
  Value
  Value
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
IxTraversal i (f a) (f b) a b
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 -> AffineTraversal' t Value
nth :: Int -> AffineTraversal' t Value
nth Int
i = Prism' t (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array Prism' t (Vector Value)
-> Optic
     An_AffineTraversal NoIx (Vector Value) (Vector Value) Value Value
-> AffineTraversal' t Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Vector Value)
-> Optic'
     (IxKind (Vector Value))
     NoIx
     (Vector Value)
     (IxValue (Vector Value))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Int
Index (Vector Value)
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 => IxTraversal' Int t Value
values :: IxTraversal' Int t Value
values = Prism' t (Vector Value)
forall t. AsValue t => Prism' t (Vector Value)
_Array Prism' t (Vector Value)
-> Optic
     A_Traversal (WithIx Int) (Vector Value) (Vector Value) Value Value
-> IxTraversal' Int t Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Traversal (WithIx Int) (Vector Value) (Vector Value) Value Value
forall i (f :: * -> *) a b.
TraversableWithIndex i f =>
IxTraversal i (f a) (f b) a b
itraversed
{-# INLINE values #-}

strictUtf8 :: Iso' String Strict.ByteString
strictUtf8 :: Iso' String ByteString
strictUtf8 = Iso' String Text
forall t. IsText t => Iso' String t
packed Iso' String Text -> Iso' Text ByteString -> Iso' String ByteString
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Iso' Text ByteString
strictTextUtf8

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

lazyTextUtf8 :: Iso' LazyText.Text Lazy.ByteString
lazyTextUtf8 :: Iso' Text ByteString
lazyTextUtf8 = (Text -> ByteString)
-> (ByteString -> Text) -> Iso' Text ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Text -> ByteString
LazyText.encodeUtf8 ByteString -> Text
LazyText.decodeUtf8

_JSON' :: (AsJSON t, FromJSON a, ToJSON a) => Prism' t a
_JSON' :: Prism' t a
_JSON' = Prism' t a
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON

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

instance AsJSON Strict.ByteString where
  _JSON :: Prism ByteString ByteString a b
_JSON = (ByteString -> ByteString)
-> (ByteString -> ByteString)
-> Iso ByteString ByteString ByteString ByteString
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ByteString -> ByteString
LBS.fromStrict ByteString -> ByteString
LBS.toStrict Iso ByteString ByteString ByteString ByteString
-> Optic A_Prism NoIx ByteString ByteString a b
-> Prism ByteString ByteString a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx ByteString ByteString a b
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  {-# INLINE _JSON #-}

instance AsJSON Lazy.ByteString where
  _JSON :: Prism ByteString ByteString a b
_JSON = (b -> ByteString)
-> (ByteString -> Maybe a) -> Prism ByteString ByteString a b
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' b -> ByteString
forall a. ToJSON a => a -> ByteString
encode ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decodeValue
    where
      decodeValue :: (FromJSON a) => Lazy.ByteString -> Maybe a
      decodeValue :: ByteString -> Maybe a
decodeValue ByteString
s = 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
s) 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
v -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
        Result a
_         -> Maybe a
forall a. Maybe a
Nothing
  {-# INLINE _JSON #-}

instance AsJSON String where
  _JSON :: Prism String String a b
_JSON = Iso' String ByteString
strictUtf8 Iso' String ByteString
-> Optic A_Prism NoIx ByteString ByteString a b
-> Prism String String a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx ByteString ByteString a b
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  {-# INLINE _JSON #-}

instance AsJSON Text where
  _JSON :: Prism Text Text a b
_JSON = Iso' Text ByteString
strictTextUtf8 Iso' Text ByteString
-> Optic A_Prism NoIx ByteString ByteString a b
-> Prism Text Text a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx ByteString ByteString a b
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  {-# INLINE _JSON #-}

instance AsJSON LazyText.Text where
  _JSON :: Prism Text Text a b
_JSON = Iso' Text ByteString
lazyTextUtf8 Iso' Text ByteString
-> Optic A_Prism NoIx ByteString ByteString a b
-> Prism Text Text a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism NoIx ByteString ByteString a b
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON
  {-# INLINE _JSON #-}

instance AsJSON Value where
  _JSON :: Prism Value Value a b
_JSON = (b -> Value) -> (Value -> Either Value a) -> Prism Value Value a b
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism b -> Value
forall a. ToJSON a => a -> Value
toJSON ((Value -> Either Value a) -> Prism Value Value a b)
-> (Value -> Either Value a) -> Prism Value Value a b
forall a b. (a -> b) -> a -> b
$ \Value
x -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
x of
    Success a
y -> a -> Either Value a
forall a b. b -> Either a b
Right a
y;
    Result a
_         -> Value -> Either Value a
forall a b. a -> Either a b
Left Value
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 :: Index Value -> Optic' (IxKind Value) NoIx Value (IxValue Value)
ix Index Value
i = Optic
  A_Prism NoIx Value Value (HashMap Text Value) (HashMap Text Value)
forall t. AsValue t => Prism' t (HashMap Text Value)
_Object Optic
  A_Prism NoIx Value Value (HashMap Text Value) (HashMap Text Value)
-> Optic
     An_AffineTraversal
     NoIx
     (HashMap Text Value)
     (HashMap Text Value)
     Value
     Value
-> Optic An_AffineTraversal NoIx Value Value Value Value
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (HashMap Text Value)
-> Optic'
     (IxKind (HashMap Text Value))
     NoIx
     (HashMap Text Value)
     (IxValue (HashMap Text Value))
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index (HashMap Text Value)
Index Value
i
  {-# 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 #-}
-}

#if MIN_VERSION_aeson(2,0,0)
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 :: Index (KeyMap v) -> Lens' (KeyMap v) (Maybe (IxValue (KeyMap v)))
at Index (KeyMap v)
i = LensVL (KeyMap v) (KeyMap v) (Maybe v) (Maybe v)
-> Lens (KeyMap v) (KeyMap v) (Maybe v) (Maybe v)
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (\Maybe v -> f (Maybe v)
f -> (Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)
forall (f :: * -> *) v.
Functor f =>
(Maybe v -> f (Maybe v)) -> Key -> KeyMap v -> f (KeyMap v)
KM.alterF Maybe v -> f (Maybe v)
f Key
Index (KeyMap v)
i)
  {-# INLINE at #-}

instance Each Key.Key (KM.KeyMap a) (KM.KeyMap b) a b where
  each :: IxTraversal Key (KeyMap a) (KeyMap b) a b
each = IxTraversalVL Key (KeyMap a) (KeyMap b) a b
-> IxTraversal Key (KeyMap a) (KeyMap b) a b
forall i s t a b. IxTraversalVL i s t a b -> IxTraversal i s t a b
itraversalVL IxTraversalVL Key (KeyMap a) (KeyMap b) a b
forall (f :: * -> *) v1 v2.
Applicative f =>
(Key -> v1 -> f v2) -> KeyMap v1 -> f (KeyMap v2)
KM.traverseWithKey
  {-# INLINE[1] each #-}
#endif

------------------------------------------------------------------------------
-- Pattern Synonyms
------------------------------------------------------------------------------

#if __GLASGOW_HASKELL__ >= 800
pattern JSON :: (FromJSON a, ToJSON a, AsJSON t) => () => a -> t
pattern $bJSON :: a -> t
$mJSON :: forall r a t.
(FromJSON a, ToJSON a, AsJSON t) =>
t -> (a -> r) -> (Void# -> r) -> r
JSON a <- (preview _JSON -> Just a) where
  JSON a
a = Prism t t a a
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON Prism t t a a -> a -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# a
a

pattern Value_ :: (FromJSON a, ToJSON a) => () => a -> Value
pattern $bValue_ :: a -> Value
$mValue_ :: forall r a.
(FromJSON a, ToJSON a) =>
Value -> (a -> r) -> (Void# -> r) -> r
Value_ a <- (fromJSON -> Success a) where
  Value_ a
a = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a

pattern Number_ :: AsNumber t => Scientific -> t
pattern $bNumber_ :: Scientific -> t
$mNumber_ :: forall r t.
AsNumber t =>
t -> (Scientific -> r) -> (Void# -> r) -> r
Number_ n <- (preview _Number -> Just n) where
  Number_ Scientific
n = Prism' t Scientific
forall t. AsNumber t => Prism' t Scientific
_Number Prism' t Scientific -> Scientific -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# Scientific
n

pattern Double :: AsNumber t => Double -> t
pattern $bDouble :: Double -> t
$mDouble :: forall r t. AsNumber t => t -> (Double -> r) -> (Void# -> r) -> r
Double d <- (preview _Double -> Just d) where
  Double Double
d = Prism' t Double
forall t. AsNumber t => Prism' t Double
_Double Prism' t Double -> Double -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# Double
d

pattern Integer :: AsNumber t => Integer -> t
pattern $bInteger :: Integer -> t
$mInteger :: forall r t. AsNumber t => t -> (Integer -> r) -> (Void# -> r) -> r
Integer i <- (preview _Integer -> Just i) where
  Integer Integer
i = Prism' t Integer
forall t. AsNumber t => Prism' t Integer
_Integer Prism' t Integer -> Integer -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# Integer
i

pattern Integral :: (AsNumber t, Integral a) => a -> t
pattern $bIntegral :: a -> t
$mIntegral :: forall r t a.
(AsNumber t, Integral a) =>
t -> (a -> r) -> (Void# -> r) -> r
Integral d <- (preview _Integral -> Just d) where
  Integral a
d = Prism' t a
forall t a. (AsNumber t, Integral a) => Prism' t a
_Integral Prism' t a -> a -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# a
d

pattern Primitive :: AsPrimitive t => Primitive -> t
pattern $bPrimitive :: Primitive -> t
$mPrimitive :: forall r t.
AsPrimitive t =>
t -> (Primitive -> r) -> (Void# -> r) -> r
Primitive p <- (preview _Primitive -> Just p) where
  Primitive Primitive
p = Prism' t Primitive
forall t. AsPrimitive t => Prism' t Primitive
_Primitive Prism' t Primitive -> Primitive -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# Primitive
p

pattern Bool_ :: AsPrimitive t => Bool -> t
pattern $bBool_ :: Bool -> t
$mBool_ :: forall r t. AsPrimitive t => t -> (Bool -> r) -> (Void# -> r) -> r
Bool_ b <- (preview _Bool -> Just b) where
  Bool_ Bool
b = Prism' t Bool
forall t. AsPrimitive t => Prism' t Bool
_Bool Prism' t Bool -> Bool -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# Bool
b

pattern String_ :: AsPrimitive t => Text -> t
pattern $bString_ :: Text -> t
$mString_ :: forall r t. AsPrimitive t => t -> (Text -> r) -> (Void# -> r) -> r
String_ p <- (preview _String -> Just p) where
  String_ Text
p = Prism' t Text
forall t. AsPrimitive t => Prism' t Text
_String Prism' t Text -> Text -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# Text
p

pattern Null_ :: AsPrimitive t => t
pattern $bNull_ :: t
$mNull_ :: forall r t. AsPrimitive t => t -> (Void# -> r) -> (Void# -> r) -> r
Null_ <- (preview _Null -> Just ()) where
  Null_ = Prism' t ()
forall t. AsPrimitive t => Prism' t ()
_Null Prism' t () -> () -> t
forall k (is :: IxList) t b.
Is k A_Review =>
Optic' k is t b -> b -> t
# ()
#endif