Copyright | (c) Alexey Raga 2016 (c) Edward Kmett 2013-2014 (c) Paul Wilson 2012 |
---|---|
License | BSD3 |
Maintainer | Alexey Raga <alexey.raga@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Synopsis
- class AsNumber t where
- _Integral :: (AsNumber t, Integral a) => Prism' t a
- data Primitive
- = StringPrim !String
- | NumberPrim !Scientific
- | BoolPrim !Bool
- | NullPrim
- class AsNumber t => AsPrimitive t where
- nonNull :: Prism' JsonPartialValue JsonPartialValue
- class AsPrimitive t => AsValue t where
- key :: AsValue t => String -> Traversal' t JsonPartialValue
- members :: AsValue t => IndexedTraversal' String t JsonPartialValue
- nth :: AsValue t => Int -> Traversal' t JsonPartialValue
- values :: AsValue t => IndexedTraversal' Int t JsonPartialValue
Documentation
class AsNumber t where Source #
_Number :: Prism' t Scientific Source #
>>>
"[1, \"x\"]" ^? nth 0 . _Number
Just 1.0
>>>
"[1, \"x\"]" ^? nth 1 . _Number
Nothing
_Number :: AsPrimitive t => Prism' t Scientific Source #
>>>
"[1, \"x\"]" ^? nth 0 . _Number
Just 1.0
>>>
"[1, \"x\"]" ^? nth 1 . _Number
Nothing
_Double :: Prism' t Double Source #
Prism into an Double
over a Value
, Primitive
or Scientific
>>>
"[10.2]" ^? nth 0 . _Double
Just 10.2
_Integer :: Prism' t Integer Source #
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
Instances
AsNumber JsonPartialValue Source # | |
AsNumber Scientific Source # | |
Defined in HaskellWorks.Data.Json.Lens | |
AsNumber Primitive Source # | |
_Integral :: (AsNumber t, Integral a) => Prism' t a Source #
Access Integer Value
s as Integrals.
>>>
"[10]" ^? nth 0 . _Integral
Just 10
>>>
"[10.5]" ^? nth 0 . _Integral
Just 10
Primitives of Value
Instances
Eq Primitive Source # | |
Data Primitive Source # | |
Defined in HaskellWorks.Data.Json.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 Source # | |
Defined in HaskellWorks.Data.Json.Lens | |
Show Primitive Source # | |
AsPrimitive Primitive Source # | |
AsNumber Primitive Source # | |
class AsNumber t => AsPrimitive t where Source #
_Primitive :: Prism' t Primitive Source #
>>>
"[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 :: AsValue t => Prism' t Primitive Source #
>>>
"[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 :: Prism' t String Source #
>>>
"{\"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 :: Prism' t Bool Source #
>>>
"{\"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"
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "b" . _Null
Just ()
>>>
"{\"a\": \"xyz\", \"b\": null}" ^? key "a" . _Null
Nothing
>>>
_Null # () :: String
"null"
Instances
AsPrimitive JsonPartialValue Source # | |
AsPrimitive Primitive Source # | |
nonNull :: Prism' JsonPartialValue JsonPartialValue Source #
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 AsPrimitive t => AsValue t where Source #
_Value :: Prism' t JsonPartialValue Source #
>>>
preview _Value "[1,2,3]" == Just (Array (Vector.fromList [Number 1.0,Number 2.0,Number 3.0]))
True
_Object :: Prism' t (ListMap JsonPartialValue) Source #
>>>
"{\"a\": {}, \"b\": null}" ^? key "a" . _Object
Just (fromList [])
>>>
"{\"a\": {}, \"b\": null}" ^? key "b" . _Object
Nothing
>>>
_Object._Wrapped # [("key" :: String, _String # "value")] :: String
"{\"key\":\"value\"}"
_Array :: Prism' t [JsonPartialValue] Source #
>>>
preview _Array "[1,2,3]" == Just (Vector.fromList [Number 1.0,Number 2.0,Number 3.0])
True
Instances
AsValue JsonPartialValue Source # | |
key :: AsValue t => String -> Traversal' t JsonPartialValue Source #
members :: AsValue t => IndexedTraversal' String t JsonPartialValue Source #
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}"
nth :: AsValue t => Int -> Traversal' t JsonPartialValue Source #
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]"
values :: AsValue t => IndexedTraversal' Int t JsonPartialValue Source #
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]"
>>>
"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"
>>>
"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"
>>>
"42" ^? (_JSON :: Prism' String Value)
Just (Number 42.0)
>>>
preview (_Integer :: Prism' String Integer) "42"
Just 42
>>>
review (_Integer :: Prism' String Integer) 42
"42"