Safe Haskell | None |
---|---|
Language | Haskell2010 |
Several newtypes and combinators for dealing with less-than-cleanly JSON input.
- newtype JSONString a = JSONString {
- jsonString :: a
- (.:$) :: FromJSON a => Object -> Text -> Parser a
- (.=$) :: ToJSON a => Text -> a -> Pair
- newtype OneOrZero = OneOrZero {}
- newtype YesOrNo = YesOrNo {}
- newtype OnOrOff = OnOrOff {}
- newtype AnyBool = AnyBool {}
- newtype EmptyAsNothing a = EmptyAsNothing {
- emptyAsNothing :: Maybe a
- (.:~) :: FromJSON a => Object -> Text -> Parser a
Double-Encodings
newtype JSONString a Source #
A double-encoded JSON value.
>>>
encode (JSONString True)
"\"true\""
>>>
decode "\"true\"" :: Maybe (JSONString Bool)
Just (JSONString {jsonString = True})
JSONString | |
|
Bounded a => Bounded (JSONString a) Source # | |
Enum a => Enum (JSONString a) Source # | |
Eq a => Eq (JSONString a) Source # | |
Floating a => Floating (JSONString a) Source # | |
Fractional a => Fractional (JSONString a) Source # | |
Integral a => Integral (JSONString a) Source # | |
Num a => Num (JSONString a) Source # | |
Ord a => Ord (JSONString a) Source # | |
Read a => Read (JSONString a) Source # | |
Real a => Real (JSONString a) Source # | |
RealFloat a => RealFloat (JSONString a) Source # | |
RealFrac a => RealFrac (JSONString a) Source # | |
Show a => Show (JSONString a) Source # | |
Ix a => Ix (JSONString a) Source # | |
IsString a => IsString (JSONString a) Source # | |
Generic (JSONString a) Source # | |
ToJSON a => ToJSON (JSONString a) Source # | |
FromJSON a => FromJSON (JSONString a) Source # | |
Storable a => Storable (JSONString a) Source # | |
Bits a => Bits (JSONString a) Source # | |
FiniteBits a => FiniteBits (JSONString a) Source # | |
type Rep (JSONString a) Source # | |
(.=$) :: ToJSON a => Text -> a -> Pair Source #
Works like aeson's (.=
), but double-encodes the value being serialized.
Booleans
There's a surprising number of ways people like to encode Booleans. At present, the
docs below lie a bit in that values which don't parse to a True
value are considered false.
For instance,
>>>
oneOrZero <$> decode "0"
Just False
>>>
oneOrZero <$> decode "1"
Just True
>>>
oneOrZero <$> decode "2"
Just False
Bool
s rendered "yes" or "no"
>>>
yesOrNo <$> decode "\"yes\""
Just True
>>>
yesOrNo <$> decode "\"no\""
Just False
Bool
s rendered "on" or "off"
>>>
onOrOff <$> decode "\"on\""
Just True
>>>
onOrOff <$> decode "\"off\""
Just False
Bool
s rendered as more-or-less anything.
>>>
let Just bs = decode "[1, \"1\", \"true\", \"yes\", \"on\", true]"
>>>
and $ map anyBool bs
True
Maybe
newtype EmptyAsNothing a Source #
Sometimes an empty string in a JSON object actually means Nothing
>>>
emptyAsNothing <$> decode "\"\"" :: Maybe (Maybe Text)
Just Nothing
>>>
emptyAsNothing <$> decode "\"something\"" :: Maybe (Maybe Text)
Just (Just "something")
Monad EmptyAsNothing Source # | |
Functor EmptyAsNothing Source # | |
MonadFix EmptyAsNothing Source # | |
Applicative EmptyAsNothing Source # | |
Foldable EmptyAsNothing Source # | |
Traversable EmptyAsNothing Source # | |
Alternative EmptyAsNothing Source # | |
MonadPlus EmptyAsNothing Source # | |
Eq a => Eq (EmptyAsNothing a) Source # | |
Ord a => Ord (EmptyAsNothing a) Source # | |
Read a => Read (EmptyAsNothing a) Source # | |
Show a => Show (EmptyAsNothing a) Source # | |
Generic (EmptyAsNothing a) Source # | |
Semigroup a => Semigroup (EmptyAsNothing a) Source # | |
Monoid a => Monoid (EmptyAsNothing a) Source # | |
ToJSON a => ToJSON (EmptyAsNothing a) Source # | |
FromJSON a => FromJSON (EmptyAsNothing a) Source # | |
Generic1 * EmptyAsNothing Source # | |
type Rep (EmptyAsNothing a) Source # | |
type Rep1 * EmptyAsNothing Source # | |
Case Insensitive Keys
(.:~) :: FromJSON a => Object -> Text -> Parser a Source #
Some systems attempt to treat keys in JSON objects case-insensitively(ish). Golang's JSON
marshalling is a prominent example: https://golang.org/pkg/encoding/json/#Marshal. The
(.:~
) combinator works like (.:
), but if it fails to match, attempts to find a
case-insensitive variant of the key being sought. If there is an exact match, (.:~
) will
take that; if there are multiple non-exact matches, the choice of selected value is
unspecified. Mnemonic: ~
swaps case in vi.
>>>
data Foo = Foo Int deriving (Read, Show)
>>>
instance FromJSON Foo where parseJSON (Object o) = Foo <$> o .:~ "foo"
>>>
decode "{\"FOO\": 12}" :: Maybe Foo
Just (Foo 12)>>>
decode "{\"foo\": 17, \"FOO\": 12}" :: Maybe Foo
Just (Foo 17)