aeson-filthy-0.0: Several newtypes and combinators for dealing with less-than-cleanly JSON input.

Safe HaskellNone
LanguageHaskell2010

Data.Aeson.Filthy

Contents

Description

Several newtypes and combinators for dealing with less-than-cleanly JSON input.

Synopsis

Double-Encodings

newtype JSONString a Source

A double-encoded JSON value.

>>> encode (JSONString True)
"\"true\""
>>> decode "\"true\"" :: Maybe (JSONString Bool)
Just (JSONString {jsonString = True})

Constructors

JSONString 

Fields

jsonString :: a
 

(.:$) :: FromJSON a => Object -> Text -> Parser a Source

Works like aeson's (.:), but assumes the value being parsed is double-encoded. Mnemonic: $ sorta looks like an S (for String).

(.=$) :: 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

newtype YesOrNo Source

Bools rendered "yes" or "no"

>>> yesOrNo <$> decode "\"yes\""
Just True
>>> yesOrNo <$> decode "\"no\""
Just False

Constructors

YesOrNo 

Fields

yesOrNo :: Bool
 

newtype OnOrOff Source

Bools rendered "on" or "off"

>>> onOrOff <$> decode "\"on\""
Just True
>>> onOrOff <$> decode "\"off\""
Just False

Constructors

OnOrOff 

Fields

onOrOff :: Bool
 

newtype AnyBool Source

Bools rendered as more-or-less anything.

>>> let Just bs = decode "[1, \"1\", \"true\", \"yes\", \"on\", true]"
>>> and $ map anyBool bs
True

Constructors

AnyBool 

Fields

anyBool :: Bool
 

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")

Constructors

EmptyAsNothing 

Fields

emptyAsNothing :: Maybe a
 

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)