{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett 2013-2019, (c) Paul Wilson 2012
-- License   :  BSD3
-- 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.Lens
  (
  -- * Numbers
    AsNumber(..)
  , _Integral
  , nonNull
  -- * Objects and Arrays
  , AsValue(..)
  , key, atKey, members
  , nth, values
  , IsKey(..)
  -- * Decoding
  , AsJSON(..)
  , _JSON'
  -- * Pattern Synonyms
  , pattern JSON
  , pattern Value_
  , pattern Number_
  , pattern Double
  , pattern Integer
  , pattern Integral
  , pattern Bool_
  , pattern String_
  , pattern Null_
  , pattern Key_
  ) where

import Control.Applicative
import Control.Lens
import Data.Aeson
import qualified Data.Aeson.Key    as Key
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.KeyMap (KeyMap)
import Data.Aeson.Parser (value)
import Data.Attoparsec.ByteString.Lazy (maybeResult, parse)
import Data.Scientific (Scientific)
import qualified Data.Scientific as Scientific
import qualified Data.ByteString as Strict
import Data.ByteString.Lazy.Char8 as Lazy hiding (putStrLn)
import Data.Text as Text
import qualified Data.Text.Encoding.Error as Encoding
import qualified Data.Text.Lazy as LazyText
import Data.Text.Short (ShortText)
import Data.Text.Lens (packed)
import qualified Data.Text.Encoding as StrictText
import qualified Data.Text.Lazy.Encoding as LazyText
import Data.Vector (Vector)
import Prelude hiding (null)

-- $setup
-- >>> import Control.Lens
-- >>> import Data.Aeson
-- >>> import Data.Text (Text)
-- >>> import qualified Data.ByteString as Strict (ByteString)
-- >>> import Data.ByteString.Char8 as Strict.Char8
-- >>> import qualified Data.ByteString.Lazy as Lazy (ByteString)
-- >>> import qualified Data.Vector as Vector
-- >>> :set -XOverloadedStrings

------------------------------------------------------------------------------
-- 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 :: AsValue t => Prism' t Scientific
  _Number = p Value (f Value) -> p t (f t)
forall t. AsValue t => Prism' t Value
_Value(p Value (f Value) -> p t (f t))
-> (p Scientific (f Scientific) -> p Value (f Value))
-> p Scientific (f Scientific)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p Scientific (f Scientific) -> p Value (f Value)
forall t. AsNumber t => Prism' t Scientific
_Number
  {-# INLINE _Number #-}

  -- |
  -- Prism into an 'Double' over a 'Value' or 'Scientific'
  --
  -- >>> "[10.2]" ^? nth 0 . _Double
  -- Just 10.2
  _Double :: Prism' t Double
  _Double = p Scientific (f Scientific) -> p t (f t)
forall t. AsNumber t => Prism' t Scientific
_Number(p Scientific (f Scientific) -> p t (f t))
-> (p Double (f Double) -> p Scientific (f Scientific))
-> p Double (f Double)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Scientific -> Double)
-> (Double -> Scientific)
-> Iso 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' or 'Scientific'
  --
  -- >>> "[10]" ^? nth 0 . _Integer
  -- Just 10
  --
  -- >>> "[10.5]" ^? nth 0 . _Integer
  -- Just 10
  --
  -- >>> "42" ^? _Integer
  -- Just 42
  _Integer :: Prism' t Integer
  _Integer = p Scientific (f Scientific) -> p t (f t)
forall t. AsNumber t => Prism' t Scientific
_Number(p Scientific (f Scientific) -> p t (f t))
-> (p Integer (f Integer) -> p Scientific (f Scientific))
-> p Integer (f Integer)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Scientific -> Integer)
-> (Integer -> Scientific)
-> Iso 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 :: p Scientific (f Scientific) -> p Value (f Value)
_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 :: p Scientific (f Scientific) -> p Scientific (f Scientific)
_Number = p Scientific (f Scientific) -> p 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 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 = p Scientific (f Scientific) -> p t (f t)
forall t. AsNumber t => Prism' t Scientific
_Number (p Scientific (f Scientific) -> p t (f t))
-> (p a (f a) -> p Scientific (f Scientific))
-> p a (f a)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scientific -> a)
-> (a -> Scientific) -> Iso 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
------------------------------------------------------------------------------

-- | 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 :: p Value (f Value) -> p Value (f Value)
nonNull = (Value -> Value)
-> (Value -> Either Value Value) -> Prism Value Value 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 APrism Value Value () () -> Value -> Bool
forall s t a b. APrism s t a b -> s -> Bool
isn't APrism Value Value () ()
forall t. AsValue 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-number traversals
------------------------------------------------------------------------------

class AsNumber 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\": \"xyz\", \"b\": true}" ^? key "a" . _String
  -- Just "xyz"
  --
  -- >>> "{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String
  -- Nothing
  --
  -- >>> _Object._Wrapped # [("key" :: Key, _String # "value")] :: String
  -- "{\"key\":\"value\"}"
  _String :: Prism' t Text
  _String = p Value (f Value) -> p t (f t)
forall t. AsValue t => Prism' t Value
_Value(p Value (f Value) -> p t (f t))
-> (p Text (f Text) -> p Value (f Value))
-> p Text (f Text)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Value)
-> (Value -> Either Value Text) -> Prism Value Value Text Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> Value
String (\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 #-}

  -- |
  -- >>> "{\"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 = p Value (f Value) -> p t (f t)
forall t. AsValue t => Prism' t Value
_Value(p Value (f Value) -> p t (f t))
-> (p Bool (f Bool) -> p Value (f Value))
-> p Bool (f Bool)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Value)
-> (Value -> Either Value Bool) -> Prism Value Value Bool 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 #-}

  -- |
  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null
  -- Just ()
  --
  -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null
  -- Nothing
  --
  -- >>> _Null # () :: String
  -- "null"
  _Null :: Prism' t ()
  _Null = p Value (f Value) -> p t (f t)
forall t. AsValue t => Prism' t Value
_Value(p Value (f Value) -> p t (f t))
-> (p () (f ()) -> p Value (f Value)) -> p () (f ()) -> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(() -> Value)
-> (Value -> Either 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 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 #-}

  -- |
  -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object
  -- Just (fromList [])
  --
  -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object
  -- Nothing
  --
  -- >>> _Object._Wrapped # [("key" :: Key, _String # "value")] :: String
  -- "{\"key\":\"value\"}"
  _Object :: Prism' t (KeyMap Value)
  _Object = p Value (f Value) -> p t (f t)
forall t. AsValue t => Prism' t Value
_Value(p Value (f Value) -> p t (f t))
-> (p (KeyMap Value) (f (KeyMap Value)) -> p Value (f Value))
-> p (KeyMap Value) (f (KeyMap Value))
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyMap Value -> Value)
-> (Value -> Either Value (KeyMap Value))
-> Prism Value Value (KeyMap Value) (KeyMap Value)
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism KeyMap Value -> Value
Object (\Value
v -> case Value
v of Object KeyMap Value
o -> KeyMap Value -> Either Value (KeyMap Value)
forall a b. b -> Either a b
Right KeyMap Value
o; Value
_ -> Value -> Either Value (KeyMap Value)
forall a b. a -> Either a b
Left Value
v)
  {-# 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 = p Value (f Value) -> p t (f t)
forall t. AsValue t => Prism' t Value
_Value(p Value (f Value) -> p t (f t))
-> (p (Vector Value) (f (Vector Value)) -> p Value (f Value))
-> p (Vector Value) (f (Vector Value))
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector Value -> Value)
-> (Value -> Either Value (Vector Value))
-> Prism 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 :: p Value (f Value) -> p Value (f Value)
_Value = p Value (f Value) -> p Value (f Value)
forall a. a -> a
id
  {-# INLINE _Value #-}

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

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

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

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

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

-- |
-- Like 'key', but uses 'at' instead of 'ix'. This is handy when
-- adding and removing object keys:
--
-- >>> "{\"a\": 100, \"b\": 200}" & atKey "a" .~ Nothing
-- "{\"b\":200}"
--
-- >>> "{\"a\": 100, \"b\": 200}" & atKey "c" ?~ String "300"
-- "{\"a\":100,\"b\":200,\"c\":\"300\"}"
atKey :: AsValue t => Key -> Traversal' t (Maybe Value)
atKey :: Key -> Traversal' t (Maybe Value)
atKey Key
i = (KeyMap Value -> f (KeyMap Value)) -> t -> f t
forall t. AsValue t => Prism' t (KeyMap Value)
_Object ((KeyMap Value -> f (KeyMap Value)) -> t -> f t)
-> ((Maybe Value -> f (Maybe Value))
    -> KeyMap Value -> f (KeyMap Value))
-> (Maybe Value -> f (Maybe Value))
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (KeyMap Value)
-> Lens' (KeyMap Value) (Maybe (IxValue (KeyMap Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index (KeyMap Value)
i
{-# INLINE atKey #-}

-- | An indexed Traversal into Object properties
--
-- >>> Data.List.sort ("{\"a\": 4, \"b\": 7}" ^@.. members . _Number)
-- [("a",4.0),("b",7.0)]
--
-- >>> "{\"a\": 4}" & members . _Number *~ 10
-- "{\"a\":40}"
members :: AsValue t => IndexedTraversal' Key t Value
members :: IndexedTraversal' Key t Value
members = (KeyMap Value -> f (KeyMap Value)) -> t -> f t
forall t. AsValue t => Prism' t (KeyMap Value)
_Object ((KeyMap Value -> f (KeyMap Value)) -> t -> f t)
-> (p Value (f Value) -> KeyMap Value -> f (KeyMap Value))
-> p Value (f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Value (f Value) -> KeyMap Value -> f (KeyMap Value)
forall i (t :: * -> *) a b.
TraversableWithIndex i t =>
IndexedTraversal i (t a) (t 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 -> Traversal' t Value
nth :: Int -> Traversal' t Value
nth Int
i = (Vector Value -> f (Vector Value)) -> t -> f t
forall t. AsValue t => Prism' 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 #-}

-- | An indexed Traversal into Array elements
--
-- >>> "[1,2,3]" ^.. values
-- [Number 1.0,Number 2.0,Number 3.0]
--
-- >>> "[1,2,3]" & values . _Number *~ 10
-- "[10,20,30]"
values :: AsValue t => IndexedTraversal' Int t Value
values :: IndexedTraversal' Int t Value
values = (Vector Value -> f (Vector Value)) -> t -> f t
forall t. AsValue t => Prism' t (Vector Value)
_Array ((Vector Value -> f (Vector Value)) -> t -> f t)
-> (p Value (f Value) -> Vector Value -> f (Vector Value))
-> p Value (f Value)
-> t
-> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Value (f Value) -> Vector Value -> f (Vector Value)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
{-# INLINE values #-}

strictUtf8 :: Iso' String Strict.ByteString
strictUtf8 :: p ByteString (f ByteString) -> p String (f String)
strictUtf8 = p Text (f Text) -> p String (f String)
forall t. IsText t => Iso' String t
packed (p Text (f Text) -> p String (f String))
-> (p ByteString (f ByteString) -> p Text (f Text))
-> p ByteString (f ByteString)
-> p String (f String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ByteString (f ByteString) -> p Text (f Text)
Iso' Text ByteString
strictTextUtf8

strictTextUtf8 :: Iso' Text.Text Strict.ByteString
strictTextUtf8 :: p ByteString (f ByteString) -> p Text (f Text)
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 (OnDecodeError -> ByteString -> Text
StrictText.decodeUtf8With OnDecodeError
Encoding.lenientDecode)

lazyTextUtf8 :: Iso' LazyText.Text Lazy.ByteString
lazyTextUtf8 :: p ByteString (f ByteString) -> p Text (f Text)
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 (OnDecodeError -> ByteString -> Text
LazyText.decodeUtf8With OnDecodeError
Encoding.lenientDecode)

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


class IsKey t where
  -- | '_Key' is an 'Iso' from something to a 'Key'. This is primarily intended
  -- for situations where one wishes to use object keys that are not string
  -- literals and therefore must be converted:
  --
  -- >>> let k = "a" :: Text
  -- >>> "{\"a\": 100, \"b\": 200}" ^? key (k ^. _Key)
  -- Just (Number 100.0)
  --
  -- Note that applying '_Key' directly to a string literal
  -- (e.g., @\"a\" ^. '_Key'@) will likely not typecheck when
  -- @OverloadedStrings@ is enabled.
  _Key :: Iso' t Key

instance IsKey Key where
  _Key :: p Key (f Key) -> p Key (f Key)
_Key = p Key (f Key) -> p Key (f Key)
forall a. a -> a
id
  {-# INLINE _Key #-}

instance IsKey String where
  _Key :: p Key (f Key) -> p String (f String)
_Key = (String -> Key) -> (Key -> String) -> Iso' String Key
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso String -> Key
Key.fromString Key -> String
Key.toString
  {-# INLINE _Key #-}

instance IsKey Text.Text where
  _Key :: p Key (f Key) -> p Text (f Text)
_Key = (Text -> Key) -> (Key -> Text) -> Iso' Text Key
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Text -> Key
Key.fromText Key -> Text
Key.toText
  {-# INLINE _Key #-}

instance IsKey LazyText.Text where
  _Key :: p Key (f Key) -> p Text (f Text)
_Key = p Text (f Text) -> p Text (f Text)
forall lazy strict. Strict lazy strict => Iso' lazy strict
strict(p Text (f Text) -> p Text (f Text))
-> (p Key (f Key) -> p Text (f Text))
-> p Key (f Key)
-> p Text (f Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p Key (f Key) -> p Text (f Text)
forall t. IsKey t => Iso' t Key
_Key
  {-# INLINE _Key #-}

instance IsKey ShortText where
  _Key :: p Key (f Key) -> p ShortText (f ShortText)
_Key = (ShortText -> Key) -> (Key -> ShortText) -> Iso' ShortText Key
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ShortText -> Key
Key.fromShortText Key -> ShortText
Key.toShortText
  {-# INLINE _Key #-}

-- | This instance assumes that you are dealing with UTF-8–encoded
-- 'Strict.ByteString's, as this is the encoding that RFC 8259 requires JSON
-- values to use. As such, this is not a full 'Iso', since non–UTF-8–encoded
-- 'Strict.ByteString's will not roundtrip:
--
-- >>> let str = view _Key ("\255" :: Strict.ByteString)
-- >>> str
-- "\65533"
-- >>> view (from _Key) str :: Strict.ByteString
-- "\239\191\189"
instance IsKey Strict.ByteString where
  _Key :: p Key (f Key) -> p ByteString (f ByteString)
_Key = AnIso Text Text ByteString ByteString
-> Iso ByteString ByteString Text Text
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Text Text ByteString ByteString
Iso' Text ByteString
strictTextUtf8(p Text (f Text) -> p ByteString (f ByteString))
-> (p Key (f Key) -> p Text (f Text))
-> p Key (f Key)
-> p ByteString (f ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p Key (f Key) -> p Text (f Text)
forall t. IsKey t => Iso' t Key
_Key
  {-# INLINE _Key #-}

-- | This instance assumes that you are dealing with UTF-8–encoded
-- 'Lazy.ByteString's, as this is the encoding that RFC 8259 requires JSON
-- values to use. As such, this is not a full 'Iso', since non–UTF-8–encoded
-- 'Lazy.ByteString's will not roundtrip:
--
-- >>> let str = view _Key ("\255" :: Lazy.ByteString)
-- >>> str
-- "\65533"
-- >>> view (from _Key) str :: Lazy.ByteString
-- "\239\191\189"
instance IsKey Lazy.ByteString where
  _Key :: p Key (f Key) -> p ByteString (f ByteString)
_Key = AnIso Text Text ByteString ByteString
-> Iso ByteString ByteString Text Text
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso Text Text ByteString ByteString
Iso' Text ByteString
lazyTextUtf8(p Text (f Text) -> p ByteString (f ByteString))
-> (p Key (f Key) -> p Text (f Text))
-> p Key (f Key)
-> p ByteString (f ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p Key (f Key) -> p Text (f Text)
forall t. IsKey t => Iso' t Key
_Key
  {-# INLINE _Key #-}

class AsJSON t where
  -- | '_JSON' is a 'Prism' from something containing JSON to something encoded in that structure
  _JSON :: (FromJSON a, ToJSON b) => Prism t t a b

instance AsJSON Strict.ByteString where
  _JSON :: Prism ByteString ByteString a b
_JSON = p ByteString (f ByteString) -> p ByteString (f ByteString)
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy(p ByteString (f ByteString) -> p ByteString (f ByteString))
-> (p a (f b) -> p ByteString (f ByteString))
-> p a (f b)
-> p ByteString (f ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p a (f b) -> p ByteString (f ByteString)
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 = p ByteString (f ByteString) -> p String (f String)
Iso' String ByteString
strictUtf8(p ByteString (f ByteString) -> p String (f String))
-> (p a (f b) -> p ByteString (f ByteString))
-> p a (f b)
-> p String (f String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p a (f b) -> p ByteString (f ByteString)
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 = p ByteString (f ByteString) -> p Text (f Text)
Iso' Text ByteString
strictTextUtf8(p ByteString (f ByteString) -> p Text (f Text))
-> (p a (f b) -> p ByteString (f ByteString))
-> p a (f b)
-> p Text (f Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p a (f b) -> p ByteString (f ByteString)
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 = p ByteString (f ByteString) -> p Text (f Text)
Iso' Text ByteString
lazyTextUtf8(p ByteString (f ByteString) -> p Text (f Text))
-> (p a (f b) -> p ByteString (f ByteString))
-> p a (f b)
-> p Text (f Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p a (f b) -> p ByteString (f ByteString)
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
-- >>> import qualified Data.ByteString.Lazy.Char8 as Lazy
--
-- >>> "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
-- >>> import qualified Data.ByteString.Char8 as Strict
--
-- >>> "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 = Key

type instance IxValue Value = Value
instance Ixed Value where
  ix :: Index Value -> Traversal' Value (IxValue Value)
ix Index Value
i IxValue Value -> f (IxValue Value)
f (Object KeyMap Value
o) = KeyMap Value -> Value
Object (KeyMap Value -> Value) -> f (KeyMap Value) -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (KeyMap Value)
-> (IxValue (KeyMap Value) -> f (IxValue (KeyMap Value)))
-> KeyMap Value
-> f (KeyMap Value)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Value
Index (KeyMap Value)
i IxValue Value -> f (IxValue Value)
IxValue (KeyMap Value) -> f (IxValue (KeyMap Value))
f KeyMap Value
o
  ix Index Value
_ IxValue Value -> f (IxValue Value)
_ Value
v          = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  {-# INLINE ix #-}

instance Plated Value where
  plate :: (Value -> f Value) -> Value -> f Value
plate Value -> f Value
f (Object KeyMap Value
o) = KeyMap Value -> Value
Object (KeyMap Value -> Value) -> f (KeyMap Value) -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> f Value) -> KeyMap Value -> f (KeyMap Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> f Value
f KeyMap Value
o
  plate Value -> f 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
<$> (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 Value -> f Value
f Vector Value
a
  plate Value -> f Value
_ Value
xs = Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
xs
  {-# INLINE plate #-}

type instance Index (KM.KeyMap v) = Key.Key
type instance IxValue (KM.KeyMap v) = v

instance Ixed (KM.KeyMap v)

instance At (KM.KeyMap v) where
  at :: Index (KeyMap v) -> Lens' (KeyMap v) (Maybe (IxValue (KeyMap v)))
at Index (KeyMap v)
k Maybe (IxValue (KeyMap v)) -> f (Maybe (IxValue (KeyMap 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)
Maybe (IxValue (KeyMap v)) -> f (Maybe (IxValue (KeyMap v)))
f Key
Index (KeyMap v)
k
  {-# INLINE at #-}

instance Each (KM.KeyMap a) (KM.KeyMap b) a b where
  each :: (a -> f b) -> KeyMap a -> f (KeyMap b)
each = (a -> f b) -> KeyMap a -> f (KeyMap b)
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed
  {-# INLINE each #-}

-- | Use @'iso' 'KM.toList' 'KM.fromList'@.
-- Unwrapping returns some permutation of the list.
instance (t ~ KeyMap v') => Rewrapped (KeyMap v) t
instance Wrapped (KeyMap v) where
  type Unwrapped (KeyMap v) = [(Key, v)]
  _Wrapped' :: p (Unwrapped (KeyMap v)) (f (Unwrapped (KeyMap v)))
-> p (KeyMap v) (f (KeyMap v))
_Wrapped' = (KeyMap v -> [(Key, v)])
-> ([(Key, v)] -> KeyMap v)
-> Iso (KeyMap v) (KeyMap v) [(Key, v)] [(Key, v)]
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
KM.toList [(Key, v)] -> KeyMap v
forall v. [(Key, v)] -> KeyMap v
KM.fromList
  {-# INLINE _Wrapped' #-}

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

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 = Tagged a (Identity a) -> Tagged t (Identity t)
forall t a b. (AsJSON t, FromJSON a, ToJSON b) => Prism t t a b
_JSON (Tagged a (Identity a) -> Tagged t (Identity t)) -> a -> t
forall t b. AReview 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 = Tagged Scientific (Identity Scientific) -> Tagged t (Identity t)
forall t. AsNumber t => Prism' t Scientific
_Number (Tagged Scientific (Identity Scientific) -> Tagged t (Identity t))
-> Scientific -> t
forall t b. AReview 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 = Tagged Double (Identity Double) -> Tagged t (Identity t)
forall t. AsNumber t => Prism' t Double
_Double (Tagged Double (Identity Double) -> Tagged t (Identity t))
-> Double -> t
forall t b. AReview 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 = Tagged Integer (Identity Integer) -> Tagged t (Identity t)
forall t. AsNumber t => Prism' t Integer
_Integer (Tagged Integer (Identity Integer) -> Tagged t (Identity t))
-> Integer -> t
forall t b. AReview 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 = Tagged a (Identity a) -> Tagged t (Identity t)
forall t a. (AsNumber t, Integral a) => Prism' t a
_Integral (Tagged a (Identity a) -> Tagged t (Identity t)) -> a -> t
forall t b. AReview t b -> b -> t
# a
d

pattern Bool_ :: AsValue t => Bool -> t
pattern $bBool_ :: Bool -> t
$mBool_ :: forall r t. AsValue t => t -> (Bool -> r) -> (Void# -> r) -> r
Bool_ b <- (preview _Bool -> Just b) where
  Bool_ Bool
b = Tagged Bool (Identity Bool) -> Tagged t (Identity t)
forall t. AsValue t => Prism' t Bool
_Bool (Tagged Bool (Identity Bool) -> Tagged t (Identity t)) -> Bool -> t
forall t b. AReview t b -> b -> t
# Bool
b

pattern String_ :: AsValue t => Text -> t
pattern $bString_ :: Text -> t
$mString_ :: forall r t. AsValue t => t -> (Text -> r) -> (Void# -> r) -> r
String_ p <- (preview _String -> Just p) where
  String_ Text
p = Tagged Text (Identity Text) -> Tagged t (Identity t)
forall t. AsValue t => Prism' t Text
_String (Tagged Text (Identity Text) -> Tagged t (Identity t)) -> Text -> t
forall t b. AReview t b -> b -> t
# Text
p

pattern Null_ :: AsValue t => t
pattern $bNull_ :: t
$mNull_ :: forall r t. AsValue t => t -> (Void# -> r) -> (Void# -> r) -> r
Null_ <- (preview _Null -> Just ()) where
  Null_ = Tagged () (Identity ()) -> Tagged t (Identity t)
forall t. AsValue t => Prism' t ()
_Null (Tagged () (Identity ()) -> Tagged t (Identity t)) -> () -> t
forall t b. AReview t b -> b -> t
# ()

pattern Key_ :: IsKey t => Key -> t
pattern $bKey_ :: Key -> t
$mKey_ :: forall r t. IsKey t => t -> (Key -> r) -> (Void# -> r) -> r
Key_ k <- (preview _Key -> Just k) where
  Key_ Key
k = Tagged Key (Identity Key) -> Tagged t (Identity t)
forall t. IsKey t => Iso' t Key
_Key (Tagged Key (Identity Key) -> Tagged t (Identity t)) -> Key -> t
forall t b. AReview t b -> b -> t
# Key
k