Safe Haskell | None |
---|---|
Language | Haskell2010 |
JSON functionality common to both encoding and decoding. Re-exported by both Json.Encode and Json.Decode for convenience.
Synopsis
- data Value
- data Primitive
- = StringPrim !Text
- | NumberPrim !Scientific
- | BoolPrim !Bool
- | NullPrim
- class AsNumber t
- _Number :: AsNumber t => Prism' t Scientific
- _Double :: AsNumber t => Prism' t Double
- _Integer :: AsNumber t => Prism' t Integer
- _Integral :: (AsNumber t, Integral a) => Prism' t a
- nonNull :: Prism' Value Value
- class AsNumber t => AsPrimitive t
- _Primitive :: AsPrimitive t => Prism' t Primitive
- _String :: AsPrimitive t => Prism' t Text
- _Bool :: AsPrimitive t => Prism' t Bool
- _Null :: AsPrimitive t => Prism' t ()
- class AsPrimitive t => AsValue t
- _Value :: AsValue t => Prism' t Value
- _Object :: AsValue t => Prism' t (HashMap Text Value)
- _Array :: AsValue t => Prism' t (Vector Value)
- class AsJSON t
- _JSON :: (AsJSON t, FromJSON a, ToJSON a) => Prism' t a
- key :: AsValue t => Text -> Traversal' t Value
- members :: AsValue t => IndexedTraversal' Text t Value
- nth :: AsValue t => Int -> Traversal' t Value
- values :: AsValue t => IndexedTraversal' Int t Value
Documentation
A JSON value represented as a Haskell value.
Instances
Eq Value | |
Data Value | |
Defined in Data.Aeson.Types.Internal gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Value -> c Value # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Value # dataTypeOf :: Value -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Value) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value) # gmapT :: (forall b. Data b => b -> b) -> Value -> Value # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r # gmapQ :: (forall d. Data d => d -> u) -> Value -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Value -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Value -> m Value # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Value -> m Value # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Value -> m Value # | |
Read Value | |
Show Value | |
IsString Value | |
Defined in Data.Aeson.Types.Internal fromString :: String -> Value # | |
Generic Value | |
Lift Value | |
Hashable Value | |
Defined in Data.Aeson.Types.Internal | |
ToJSON Value | |
Defined in Data.Aeson.Types.ToJSON | |
KeyValue Pair | |
FromJSON Value | |
NFData Value | |
Defined in Data.Aeson.Types.Internal | |
AsNumber Value | |
AsPrimitive Value | |
AsValue Value | |
AsJSON Value | |
FromString Encoding | |
Defined in Data.Aeson.Types.ToJSON fromString :: String -> Encoding | |
FromString Value | |
Defined in Data.Aeson.Types.ToJSON fromString :: String -> Value | |
GToJSON Encoding arity (U1 :: * -> *) | |
GToJSON Value arity (V1 :: * -> *) | |
GToJSON Value arity (U1 :: * -> *) | |
ToJSON1 f => GToJSON Encoding One (Rec1 f) | |
ToJSON1 f => GToJSON Value One (Rec1 f) | |
ToJSON a => GToJSON Encoding arity (K1 i a :: * -> *) | |
(EncodeProduct arity a, EncodeProduct arity b) => GToJSON Encoding arity (a :*: b) | |
ToJSON a => GToJSON Value arity (K1 i a :: * -> *) | |
(WriteProduct arity a, WriteProduct arity b, ProductSize a, ProductSize b) => GToJSON Value arity (a :*: b) | |
(ToJSON1 f, GToJSON Encoding One g) => GToJSON Encoding One (f :.: g) | |
(ToJSON1 f, GToJSON Value One g) => GToJSON Value One (f :.: g) | |
FromPairs Value (DList Pair) | |
Defined in Data.Aeson.Types.ToJSON | |
v ~ Value => KeyValuePair v (DList Pair) | |
Defined in Data.Aeson.Types.ToJSON | |
(GToJSON Encoding arity a, ConsToJSON Encoding arity a, Constructor c) => SumToJSON' TwoElemArray Encoding arity (C1 c a) | |
Defined in Data.Aeson.Types.ToJSON | |
(GToJSON Value arity a, ConsToJSON Value arity a, Constructor c) => SumToJSON' TwoElemArray Value arity (C1 c a) | |
Defined in Data.Aeson.Types.ToJSON | |
type Rep Value | |
Defined in Data.Aeson.Types.Internal type Rep Value = D1 (MetaData "Value" "Data.Aeson.Types.Internal" "aeson-1.4.1.0-1EKdJf7q4ER7d8NqHIeTgp" False) ((C1 (MetaCons "Object" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Object)) :+: (C1 (MetaCons "Array" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Array)) :+: C1 (MetaCons "String" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Text)))) :+: (C1 (MetaCons "Number" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Scientific)) :+: (C1 (MetaCons "Bool" PrefixI False) (S1 (MetaSel (Nothing :: Maybe Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Bool)) :+: C1 (MetaCons "Null" PrefixI False) (U1 :: * -> *)))) | |
type Index Value | |
Defined in Data.Aeson.Lens | |
type IxValue Value | |
Defined in Data.Aeson.Lens |
Primitives of Value
Instances
Eq Primitive | |
Data Primitive | |
Defined in Data.Aeson.Lens gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Primitive -> c Primitive # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Primitive # toConstr :: Primitive -> Constr # dataTypeOf :: Primitive -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Primitive) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Primitive) # gmapT :: (forall b. Data b => b -> b) -> Primitive -> Primitive # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Primitive -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Primitive -> r # gmapQ :: (forall d. Data d => d -> u) -> Primitive -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Primitive -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Primitive -> m Primitive # | |
Ord Primitive | |
Defined in Data.Aeson.Lens | |
Show Primitive | |
AsNumber Primitive | |
AsPrimitive Primitive | |
Prisms
Instances
AsNumber String | |
AsNumber ByteString | |
Defined in Data.Aeson.Lens | |
AsNumber ByteString | |
Defined in Data.Aeson.Lens | |
AsNumber Scientific | |
Defined in Data.Aeson.Lens | |
AsNumber Text | |
AsNumber Value | |
AsNumber Text | |
AsNumber Primitive | |
_Number :: AsNumber t => Prism' t Scientific #
>>>
"[1, \"x\"]" ^? nth 0 . _Number
Just 1.0
>>>
"[1, \"x\"]" ^? nth 1 . _Number
Nothing
_Double :: AsNumber t => Prism' t Double #
Prism into an Double
over a Value
, Primitive
or Scientific
>>>
"[10.2]" ^? nth 0 . _Double
Just 10.2
_Integer :: AsNumber t => Prism' t Integer #
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
_Integral :: (AsNumber t, Integral a) => Prism' t a #
Access Integer Value
s as Integrals.
>>>
"[10]" ^? nth 0 . _Integral
Just 10
>>>
"[10.5]" ^? nth 0 . _Integral
Just 10
nonNull :: Prism' Value Value #
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
class AsNumber t => AsPrimitive t #
Instances
AsPrimitive String | |
AsPrimitive ByteString | |
Defined in Data.Aeson.Lens _Primitive :: Prism' ByteString Primitive # _String :: Prism' ByteString Text # _Bool :: Prism' ByteString Bool # _Null :: Prism' ByteString () # | |
AsPrimitive ByteString | |
Defined in Data.Aeson.Lens _Primitive :: Prism' ByteString Primitive # _String :: Prism' ByteString Text # _Bool :: Prism' ByteString Bool # _Null :: Prism' ByteString () # | |
AsPrimitive Text | |
AsPrimitive Value | |
AsPrimitive Text | |
AsPrimitive Primitive | |
_Primitive :: AsPrimitive t => Prism' t Primitive #
>>>
"[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)
_String :: AsPrimitive t => Prism' t Text #
>>>
"{\"a\": \"xyz\", \"b\": true}" ^? key "a" . _String
Just "xyz"
>>>
"{\"a\": \"xyz\", \"b\": true}" ^? key "b" . _String
Nothing
>>>
_Object._Wrapped # [("key" :: Text, _String # "value")] :: String
"{\"key\":\"value\"}"
_Bool :: AsPrimitive t => Prism' t Bool #
>>>
"{\"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"
_Null :: AsPrimitive t => Prism' t () #
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null
Just ()
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null
Nothing
>>>
_Null # () :: String
"null"
class AsPrimitive t => AsValue t #
Instances
AsValue String | |
AsValue ByteString | |
Defined in Data.Aeson.Lens | |
AsValue ByteString | |
Defined in Data.Aeson.Lens | |
AsValue Text | |
AsValue Value | |
AsValue Text | |
_Value :: AsValue t => Prism' t Value #
>>>
preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0]))
True
_Object :: AsValue t => Prism' t (HashMap Text Value) #
>>>
"{\"a\": {}, \"b\": null}" ^? key "a" . _Object
Just (fromList [])
>>>
"{\"a\": {}, \"b\": null}" ^? key "b" . _Object
Nothing
>>>
_Object._Wrapped # [("key" :: Text, _String # "value")] :: String
"{\"key\":\"value\"}"
_Array :: AsValue t => Prism' t (Vector Value) #
>>>
preview _Array "[1,2,3]" == Just (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])
True
Instances
AsJSON String | |
AsJSON ByteString | |
Defined in Data.Aeson.Lens | |
AsJSON ByteString | |
Defined in Data.Aeson.Lens | |
AsJSON Text | |
AsJSON Value | |
AsJSON Text | |
Traversals
members :: AsValue t => IndexedTraversal' Text t Value #
An indexed Traversal into Object properties
>>>
"{\"a\": 4, \"b\": 7}" ^@.. members
[("a",Number 4.0),("b",Number 7.0)]
>>>
"{\"a\": 4, \"b\": 7}" & members . _Number *~ 10
"{\"a\":40,\"b\":70}"