Safe Haskell | None |
---|---|
Language | Haskell2010 |
Types and functions to encode your data types to Json
.
We will work through a basic example, using the following type:
data Person = Person { _personName :: Text , _personAge :: Int , _personAddress :: Text , _personFavouriteLotteryNumbers :: [Int] } deriving (Eq, Show)
To create an Encoder
for our Person
record, we will encode it as a "map
like object", that is we have decided that there are no duplicate keys allowed. We can then use
the following functions to build up the structure we want:
mapLikeObj :: ( AsJType Json ws a , Semigroup ws -- This library supports GHC 7.10.3 andSemigroup
wasn't a superclass ofMonoid
then. , Monoid ws , Applicative f ) => (i -> MapLikeObj ws a -> MapLikeObj ws a) -> Encoder f i
And:
atKey' :: ( At t , IxValue t ~ Json ) => Index t -> Encoder' a -> a -> t -> t
These types may seem pretty wild, but their usage is mundane. The mapLikeObj
function is used when we want to encode some particular type i
as a JSON object. In such a way
as to prevent duplicate keys from appearing. The atKey'
function is designed
such that it can be composed with itself to build up an object with multiple keys.
import Waargonaut.Encode (Encoder) import qualified Waargonaut.Encode as E
personEncoder :: Applicative f => Encoder f Person personEncoder = E.mapLikeObj $ \p -> E.atKey' "name" E.text (_personName p) . E.atKey' "age" E.int (_personAge p) . E.atKey' "address" E.text (_personAddress p) . E.atKey' "numbers" (E.list E.int) (_personFavouriteLotteryNumbers p)
The JSON RFC leaves the handling of duplicate keys on an object as a choice. It is up to the implementor of a JSON handling package to decide what they will do. Waargonaut passes on this choice to you. In both encoding and decoding, the handling of duplicate keys is up to you. Waargonaut provides functionality to support both use cases.
To then turn these values into JSON output:
simpleEncodeText :: Applicative f => Encoder f a -> a -> f Text simpleEncodeTextNoSpaces :: Applicative f => Encoder f a -> a -> f Text simpleEncodeByteString :: Applicative f => Encoder f a -> a -> f ByteString simpleEncodeByteStringNoSpaces :: Applicative f => Encoder f a -> a -> f ByteString
Or
simplePureEncodeText :: Encoder' a -> a -> Text simplePureEncodeTextNoSpaces :: Encoder' a -> a -> Text simplePureEncodeByteString :: Encoder' a -> a -> ByteString simplePureEncodeByteStringNoSpaces :: Encoder' a -> a -> ByteString
The latter functions specialise the f
to be Identity
.
Then, like the use of the Decoder
you select the Encoder
you wish to use and run it against a value of a matching type:
simplePureEncodeTextNoSpaces personEncoder (Person "Krag" 33 "Red House 4, Three Neck Lane, Greentown." [86,3,32,42,73]) = "{"name":"Krag","age":88,"address":"Red House 4, Three Neck Lane, Greentown.","numbers":[86,3,32,42,73]}"
Synopsis
- type Encoder f a = EncoderFns Json f a
- type Encoder' a = EncoderFns Json Identity a
- type ObjEncoder f a = EncoderFns (JObject WS Json) f a
- type ObjEncoder' a = EncoderFns (JObject WS Json) Identity a
- encodeA :: (a -> f Json) -> Encoder f a
- encodePureA :: (a -> Json) -> Encoder' a
- jsonEncoder :: (a -> f Json) -> EncoderFns Json f a
- objEncoder :: (a -> f (JObject WS Json)) -> EncoderFns (JObject WS Json) f a
- runPureEncoder :: EncoderFns i Identity a -> a -> Json
- runEncoder :: Functor f => EncoderFns i f a -> a -> f Json
- simpleEncodeWith :: (Applicative f, Monoid b, IsString t) => Builder t b -> (b -> out) -> (Builder t b -> WS -> b) -> Encoder f a -> a -> f out
- simplePureEncodeWith :: (Monoid b, IsString t) => Builder t b -> (b -> out) -> (Builder t b -> WS -> b) -> Encoder Identity a -> a -> out
- simpleEncodeText :: Applicative f => Encoder f a -> a -> f Text
- simpleEncodeTextNoSpaces :: Applicative f => Encoder f a -> a -> f Text
- simpleEncodeByteString :: Applicative f => Encoder f a -> a -> f ByteString
- simpleEncodeByteStringNoSpaces :: Applicative f => Encoder f a -> a -> f ByteString
- simplePureEncodeText :: Encoder Identity a -> a -> Text
- simplePureEncodeTextNoSpaces :: Encoder Identity a -> a -> Text
- simplePureEncodeByteString :: Encoder Identity a -> a -> ByteString
- simplePureEncodeByteStringNoSpaces :: Encoder Identity a -> a -> ByteString
- int :: Applicative f => Encoder f Int
- integral :: (Applicative f, Integral n) => Encoder f n
- scientific :: Applicative f => Encoder f Scientific
- bool :: Applicative f => Encoder f Bool
- string :: Applicative f => Encoder f String
- text :: Applicative f => Encoder f Text
- null :: Applicative f => Encoder f ()
- either :: Functor f => Encoder f a -> Encoder f b -> Encoder f (Either a b)
- maybe :: Functor f => Encoder f () -> Encoder f a -> Encoder f (Maybe a)
- maybeOrNull :: Applicative f => Encoder f a -> Encoder f (Maybe a)
- traversable :: (Applicative f, Traversable t) => Encoder f a -> Encoder f (t a)
- list :: Applicative f => Encoder f a -> Encoder f [a]
- nonempty :: Applicative f => Encoder f a -> Encoder f (NonEmpty a)
- mapToObj :: Applicative f => Encoder f a -> (k -> Text) -> Encoder f (Map k a)
- json :: Applicative f => Encoder f Json
- prismE :: Prism' a b -> Encoder f a -> Encoder f b
- asJson :: Applicative f => Encoder f a -> a -> f Json
- mapLikeObj :: (AsJType Json ws a, Monoid ws, Semigroup ws, Applicative f) => (i -> MapLikeObj ws a -> MapLikeObj ws a) -> Encoder f i
- atKey :: (At t, IxValue t ~ Json, Applicative f) => Index t -> Encoder f a -> a -> t -> f t
- atOptKey :: (At t, IxValue t ~ Json, Applicative f) => Index t -> Encoder f a -> Maybe a -> t -> f t
- intAt :: Text -> Int -> MapLikeObj WS Json -> MapLikeObj WS Json
- textAt :: Text -> Text -> MapLikeObj WS Json -> MapLikeObj WS Json
- boolAt :: Text -> Bool -> MapLikeObj WS Json -> MapLikeObj WS Json
- traversableAt :: (At t, Traversable f, IxValue t ~ Json) => Encoder' a -> Index t -> f a -> t -> t
- listAt :: (At t, IxValue t ~ Json) => Encoder' a -> Index t -> [a] -> t -> t
- nonemptyAt :: (At t, IxValue t ~ Json) => Encoder' a -> Index t -> NonEmpty a -> t -> t
- encAt :: Applicative f => Encoder f b -> Text -> (a -> b) -> a -> JObject WS Json -> f (JObject WS Json)
- keyValuesAsObj :: (Foldable g, Monad f) => g (a -> JObject WS Json -> f (JObject WS Json)) -> Encoder f a
- onObj :: Applicative f => Text -> b -> Encoder f b -> JObject WS Json -> f (JObject WS Json)
- keyValueTupleFoldable :: (Monad f, Foldable g) => Encoder f a -> Encoder f (g (Text, a))
- extendObject :: Functor f => ObjEncoder f a -> a -> (JObject WS Json -> JObject WS Json) -> f Json
- extendMapLikeObject :: Functor f => ObjEncoder f a -> a -> (MapLikeObj WS Json -> MapLikeObj WS Json) -> f Json
- combineObjects :: Applicative f => (a -> (b, c)) -> ObjEncoder f b -> ObjEncoder f c -> ObjEncoder f a
- int' :: Encoder' Int
- integral' :: Integral n => Encoder' n
- scientific' :: Encoder' Scientific
- bool' :: Encoder' Bool
- string' :: Encoder' String
- text' :: Encoder' Text
- null' :: Encoder' ()
- either' :: Encoder' a -> Encoder' b -> Encoder' (Either a b)
- maybe' :: Encoder' () -> Encoder' a -> Encoder' (Maybe a)
- maybeOrNull' :: Encoder' a -> Encoder' (Maybe a)
- traversable' :: Traversable t => Encoder' a -> Encoder' (t a)
- nonempty' :: Encoder' a -> Encoder' (NonEmpty a)
- list' :: Encoder' a -> Encoder' [a]
- atKey' :: (At t, IxValue t ~ Json) => Index t -> Encoder' a -> a -> t -> t
- atOptKey' :: (At t, IxValue t ~ Json) => Index t -> Encoder' a -> Maybe a -> t -> t
- mapLikeObj' :: (AsJType Json ws a, Semigroup ws, Monoid ws) => (i -> MapLikeObj ws a -> MapLikeObj ws a) -> Encoder' i
- mapToObj' :: Encoder' a -> (k -> Text) -> Encoder' (Map k a)
- keyValuesAsObj' :: (Foldable g, Functor g) => g (a -> JObject WS Json -> JObject WS Json) -> Encoder' a
- json' :: Encoder' Json
- asJson' :: Encoder Identity a -> a -> Json
- onObj' :: Text -> b -> Encoder' b -> JObject WS Json -> JObject WS Json
- generaliseEncoder :: Monad f => EncoderFns i Identity a -> EncoderFns i f a
Encoder type
type Encoder f a = EncoderFns Json f a Source #
As a convenience, this type defines the i
to be a specific Json
structure:
type Encoder' a = EncoderFns Json Identity a Source #
As a convenience, this type is a pure Encoder over Identity
in place of the f
.
type ObjEncoder f a = EncoderFns (JObject WS Json) f a Source #
As a convenience, this type defines the i
to be a specific 'JObject WS Json' structure:
type ObjEncoder' a = EncoderFns (JObject WS Json) Identity a Source #
As a convenience, this type is a pure ObjEncoder over Identity
in place of the f
.
Creation
encodeA :: (a -> f Json) -> Encoder f a Source #
Create an Encoder'
for a
by providing a function from 'a -> f Json'.
encodePureA :: (a -> Json) -> Encoder' a Source #
jsonEncoder :: (a -> f Json) -> EncoderFns Json f a Source #
Helper function for creating an Encoder
, provides the default
finaliseEncoding
function for Json
encoders.
objEncoder :: (a -> f (JObject WS Json)) -> EncoderFns (JObject WS Json) f a Source #
Helper function for creating a JSON object
Encoder
. Provides the
default finaliseEncoding
function for completing the JObject
to the
necessary Json
type.
Runners
runPureEncoder :: EncoderFns i Identity a -> a -> Json Source #
runEncoder :: Functor f => EncoderFns i f a -> a -> f Json Source #
simpleEncodeWith :: (Applicative f, Monoid b, IsString t) => Builder t b -> (b -> out) -> (Builder t b -> WS -> b) -> Encoder f a -> a -> f out Source #
simplePureEncodeWith :: (Monoid b, IsString t) => Builder t b -> (b -> out) -> (Builder t b -> WS -> b) -> Encoder Identity a -> a -> out Source #
simpleEncodeText :: Applicative f => Encoder f a -> a -> f Text Source #
simpleEncodeTextNoSpaces :: Applicative f => Encoder f a -> a -> f Text Source #
simpleEncodeByteString :: Applicative f => Encoder f a -> a -> f ByteString Source #
Encode an a
directly to a ByteString
using the provided Encoder
.
simpleEncodeByteStringNoSpaces :: Applicative f => Encoder f a -> a -> f ByteString Source #
Encode an a
directly to a ByteString
using the provided Encoder
.
simplePureEncodeText :: Encoder Identity a -> a -> Text Source #
As per simpleEncodeText
but specialised the f
to Identity
.
simplePureEncodeTextNoSpaces :: Encoder Identity a -> a -> Text Source #
As per simpleEncodeTextNoSpaces
but specialised the f
to Identity
.
simplePureEncodeByteString :: Encoder Identity a -> a -> ByteString Source #
As per simpleEncodeByteString
but specialised the f
to Identity
.
simplePureEncodeByteStringNoSpaces :: Encoder Identity a -> a -> ByteString Source #
As per simpleEncodeByteStringNoSpaces
but specialised the f
to Identity
.
Provided encoders
integral :: (Applicative f, Integral n) => Encoder f n Source #
Encode a numeric value of the typeclass Integral
scientific :: Applicative f => Encoder f Scientific Source #
Encode an Scientific
maybeOrNull :: Applicative f => Encoder f a -> Encoder f (Maybe a) Source #
Encode a 'Maybe a' to either 'Encoder a' or null
traversable :: (Applicative f, Traversable t) => Encoder f a -> Encoder f (t a) Source #
Encode some Traversable
of a
into a JSON array.
mapToObj :: Applicative f => Encoder f a -> (k -> Text) -> Encoder f (Map k a) Source #
Encode a Map
in a JSON object.
Object encoder helpers
mapLikeObj :: (AsJType Json ws a, Monoid ws, Semigroup ws, Applicative f) => (i -> MapLikeObj ws a -> MapLikeObj ws a) -> Encoder f i Source #
Apply a function to update a MapLikeObj
and encode that as a JSON object.
For example, given the following data type:
data Image = Image { _imageW :: Int , _imageH :: Int , _imageTitle :: Text , _imageAnimated :: Bool , _imageIDs :: [Int] }
We can use this function to create an encoder, composing the individual update functions to set the keys and values as desired.
encodeImage :: Applicative f => Encoder f Image encodeImage = mapLikeObj $ \img -> intAt "Width" (_imageW img) . -- ^ Set anInt
value at the "Width" key. intAt "Height" (_imageH img) . textAt "Title" (_imageTitle img) . boolAt "Animated" (_imageAnimated img) . listAt int "IDs" (_imageIDs img) -- ^ Set an[Int]
value at the "IDs" key.
atKey :: (At t, IxValue t ~ Json, Applicative f) => Index t -> Encoder f a -> a -> t -> f t Source #
When encoding a MapLikeObj
, this function lets you encode a value at a specific key
atOptKey :: (At t, IxValue t ~ Json, Applicative f) => Index t -> Encoder f a -> Maybe a -> t -> f t Source #
Optionally encode an a
if it is a Just a
. A Nothing
will result in the key being absent from the object.
traversableAt :: (At t, Traversable f, IxValue t ~ Json) => Encoder' a -> Index t -> f a -> t -> t Source #
Encode a Foldable
of a
at the given index on a JSON object.
listAt :: (At t, IxValue t ~ Json) => Encoder' a -> Index t -> [a] -> t -> t Source #
Encode a standard Haskell list at the given index on a JSON object.
nonemptyAt :: (At t, IxValue t ~ Json) => Encoder' a -> Index t -> NonEmpty a -> t -> t Source #
Encode a NonEmpty
list at the given index on a JSON object.
encAt :: Applicative f => Encoder f b -> Text -> (a -> b) -> a -> JObject WS Json -> f (JObject WS Json) Source #
Using a given Encoder
, encode a key value pair on the JSON object, using
the accessor function to retrieve the value.
keyValuesAsObj :: (Foldable g, Monad f) => g (a -> JObject WS Json -> f (JObject WS Json)) -> Encoder f a Source #
Encode key value pairs as a JSON object, allowing duplicate keys.
onObj :: Applicative f => Text -> b -> Encoder f b -> JObject WS Json -> f (JObject WS Json) Source #
When encoding a JSON object that may contain duplicate keys, this function
works the same as the atKey
function for MapLikeObj
.
keyValueTupleFoldable :: (Monad f, Foldable g) => Encoder f a -> Encoder f (g (Text, a)) Source #
Encode some Foldable
of (Text, a)
as a JSON object. This permits duplicate
keys.
extendObject :: Functor f => ObjEncoder f a -> a -> (JObject WS Json -> JObject WS Json) -> f Json Source #
This function allows you to extend the fields on a JSON object created by a separate encoder.
extendMapLikeObject :: Functor f => ObjEncoder f a -> a -> (MapLikeObj WS Json -> MapLikeObj WS Json) -> f Json Source #
This function lets you extend the fields on a JSON object but enforces the
uniqueness of the keys by working through the MapLikeObj
structure.
This will keep the first occurence of each unique key in the map. So be sure to check your output.
combineObjects :: Applicative f => (a -> (b, c)) -> ObjEncoder f b -> ObjEncoder f c -> ObjEncoder f a Source #
Given encoders for things that are represented in JSON as objects
, and a
way to get to the b
and c
from the a
. This function lets you create an
encoder for a
. The two objects are combined to make one single JSON object.
Given
encodeFoo :: ObjEncoder f Foo encodeBar :: ObjEncoder f Bar -- and some wrapping type: data A = { _foo :: Foo, _bar :: Bar }
We can use this function to utilise our already defined ObjEncoder
structures to give us an encoder for A
:
combineObjects (aRecord -> (_foo aRecord, _bar aRecord)) encodeFoo encodeBar :: ObjEncoder f Bar
Encoders specialised to Identity
scientific' :: Encoder' Scientific Source #
As per scientific
but with the f
specialised to Identity
.
maybeOrNull' :: Encoder' a -> Encoder' (Maybe a) Source #
As per maybeOrNull
but with the f
specialised to Identity
.
traversable' :: Traversable t => Encoder' a -> Encoder' (t a) Source #
As per traversable
but with the f
specialised to Identity
.
atKey' :: (At t, IxValue t ~ Json) => Index t -> Encoder' a -> a -> t -> t Source #
Encode an a
at the given index on the JSON object.
atOptKey' :: (At t, IxValue t ~ Json) => Index t -> Encoder' a -> Maybe a -> t -> t Source #
Optionally encode a key : value
pair on an object.
encoder = E.mapLikeObj $ \a -> atKey' "A" E.text (_getterA a) atOptKey' "B" E.int (_maybeB a) simplePureEncodeByteString encoder (Foo "bob" (Just 33)) = "{"A":"bob","B":33}" simplePureEncodeByteString encoder (Foo "bob" Nothing) = "{"A":"bob"}"
mapLikeObj' :: (AsJType Json ws a, Semigroup ws, Monoid ws) => (i -> MapLikeObj ws a -> MapLikeObj ws a) -> Encoder' i Source #
As per mapLikeObj
but specialised for Identity
as the Applicative
.
keyValuesAsObj' :: (Foldable g, Functor g) => g (a -> JObject WS Json -> JObject WS Json) -> Encoder' a Source #
As per keyValuesAsObj
but with the f
specialised to Identity
.
generaliseEncoder :: Monad f => EncoderFns i Identity a -> EncoderFns i f a Source #
Generalise any Encoder
a' to 'Encoder f a'