Safe Haskell | None |
---|---|
Language | Haskell2010 |
Welcome to Waargonaut, we hope you enjoy your stay.
The handling of JSON is managed using the Decoder
and
Encoder
types, these are not typeclasses but data structures. As such you're
able to pass them around as values, manipulate or create them at runtime. This allows you to have
one data type, but several decoding and encoding techniques to match your requirements. You don't
have to pile on the newtypes or manage orphan instances.
Simple Decode
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)
Expect the following JSON as input:
{ "name": "Krag" , "age": 88 , "address": "Red House 4, Three Neck Lane, Greentown." , "numbers": [86,3,32,42,73] }
We'll need to import the Waargonaut.Decode
module. You may of course use whatever import scheme you like,
I prefer this method:
import Waargonaut.Decode (Decoder) import qualified Waargonaut.Decode as D
The Decoder
is based upon a data structure called a "zipper". This allows us
to move around the JSON structure using arbitrary movements. Such as
moveRight1
to move from a key on an object to the value at that key. Or
down
to move into the first element of an array or object. Waargonaut
provides a suite of these functions to move around and dissect the JSON input.
This zipper is combined with a StateT
transformer that maintains a history
of your movements.
So if the JSON input is not as your Decoder
expects you are given a complete
path to where things went awry.
Decoding a JSON value is done by moving the cursor to specific points of interest, then focusing
on that point with a Decoder
of the desired value.
NB: The Monad constraint is provided as a flexibility for more interesting and nefarious uses
of Decoder
.
Here is the Decoder
for our Person
data type. It will help to turn on the
OverloadedStrings
language pragma as these functions expect Text
input.
personDecoder :: Monad f => Decoder f Person personDecoder = D.withCursor $ \c -> do o <- D.down c name <- D.fromKey "name" D.text o age <- D.fromKey "age" D.int o addr <- D.fromKey "address" D.text o lotto <- D.fromKey "numbers" (D.list D.int) o pure $ Person name age addr lotto
The withCursor
function provides our cursor: "c". We then move
down
into the JSON object. The reasons for this are:
- The initial cursor position is always at the very beginning of the input. On freshly indexed JSON input, using our example, the cursor will be at:
<cursor>{ "name": "Krag" , "age": 88 ...
- Because of the above reason, our decoder makes an assumption about the placement of the cursor on the JSON input. This sort of assumption is reasonable for reasons we will go over later.
The cursor output from down
will located here:
{ <cursor>"name": "Krag" , "age": 88 ...
Then we use one of the helper functions, fromKey
to find the "key - value"
pair that we're interested in and decode it for us:
fromKey :: Monad f => Text -> Decoder f b -> JCurs -> DecodeResult f b
We could also write this Decoder
as:
personDecoder2 :: Monad f => Decoder f Person personDecoder2 = Person <$> D.atKey "name" D.text <*> D.atKey "age" D.int <*> D.atKey "address" D.text <*> D.atKey "numbers" (D.list D.int)
Using the atKey
function which tries to handle those basic movements for us
and has those assumptions included. Very useful for when the JSON input closely mirrors your data
structure.
atKey :: Monad f => Text -> Decoder f a -> Decoder f a
The next part is being able to apply our Decoder
to some input. Assuming we
have some input. We want to pass it through our personDecoder
for a result. Waargonaut uses
the parsers package to define its parser. This
allows you to choose your own favourite parsing library to do the heavy lifting. Provided it
implements the right typeclasses from the parsers
package.
To apply a Decoder
to some input you will need one of the
decoder running functions from Decode
. There are a few different
functions provided for some of the common input text-like types.:
decodeFromByteString :: ( CharParsing f , Monad f , Monad g , Show e ) => (forall a. f a -> ByteString -> Either e a) -> Decoder g x -> ByteString -> g (Either (DecodeError, CursorHistory) x)
As well as a parsing function from your parsing library of choice, that also
has an implementation of the CharParsing
typeclass from parsers
. We will
use attoparsec
in the examples below.
import qualified Data.Attoparsec.ByteString as AB
decodeFromByteString AB.parseOnly personDecode inp
Which will run the personDecode
Decoder
using the parsing function
(AB.parseOnly
), starting at the cursor from the top of the inp
input.
Again the Monad
constraint is there so that you have more options available for utilising the
Decoder
in ways we haven't thought of.
Or if you don't need the Monad
constraint then you may use pureDecodeFromByteString
.
This function specialises the Monad
constraint to Identity
.:
pureDecodeFromByteString :: ( Monad f , CharParsing f , Show e ) => (forall a. f a -> ByteString -> Either e a) -> Decoder Identity x -> ByteString -> Either (DecodeError, CursorHistory) x
pureDecodeFromByteString AB.parseOnly personDecode inp
Waargonaut provides some default implementations using the attoparsec package in the Waargonaut.Attoparsec
module. These functions have exactly the same behaviour as the functions above, without the need to provide the parsing function.
Simple Encode
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 , Applicative f ) => Index t -> Encoder f a -> a -> t -> f 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]}"
Types
Top level Json type, we specialise the whitespace to WS
and the digit
type to Digit
. Also defining that our structures can recursively only contain
Json
types.
Instances
Individual JSON Types and their trailing whitespace.
Instances
Bitraversable JType Source # | |
Defined in Waargonaut.Types.Json bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> JType a b -> f (JType c d) # | |
Bifoldable JType Source # | |
Bifunctor JType Source # | |
Functor (JType ws) Source # | |
Foldable (JType ws) Source # | |
Defined in Waargonaut.Types.Json fold :: Monoid m => JType ws m -> m # foldMap :: Monoid m => (a -> m) -> JType ws a -> m # foldMap' :: Monoid m => (a -> m) -> JType ws a -> m # foldr :: (a -> b -> b) -> b -> JType ws a -> b # foldr' :: (a -> b -> b) -> b -> JType ws a -> b # foldl :: (b -> a -> b) -> b -> JType ws a -> b # foldl' :: (b -> a -> b) -> b -> JType ws a -> b # foldr1 :: (a -> a -> a) -> JType ws a -> a # foldl1 :: (a -> a -> a) -> JType ws a -> a # elem :: Eq a => a -> JType ws a -> Bool # maximum :: Ord a => JType ws a -> a # minimum :: Ord a => JType ws a -> a # | |
Traversable (JType ws) Source # | |
(Eq ws, Eq a) => Eq (JType ws a) Source # | |
(Show ws, Show a) => Show (JType ws a) Source # | |
AsJType (JType ws a) ws a Source # | |
Defined in Waargonaut.Types.Json |