waargonaut-0.4.2.0: JSON wrangling

Safe HaskellNone
LanguageHaskell2010

Waargonaut.Decode

Contents

Description

Types and Functions for turning JSON into Haskell.

Synopsis

Types

type CursorHistory = CursorHistory' Count Source #

We define the index of our CursorHistory' to be the Count.

type SuccinctCursor = JsonCursor ByteString Poppy512 (SimpleBalancedParens (Vector Word64)) Source #

Convenience alias defined for the concrete JsonCursor type.

newtype DecodeResult f a Source #

Provide some of the type parameters that the underlying DecodeResultT requires. This contains the state and error management as we walk around our zipper and decode our JSON input.

Addtionally we keep our parsing function in a ReaderT such that it's accessible for all of the decoding steps.

Instances
MMonad DecodeResult Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

embed :: Monad n => (forall a. m a -> DecodeResult n a) -> DecodeResult m b -> DecodeResult n b #

MonadTrans DecodeResult Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

lift :: Monad m => m a -> DecodeResult m a #

Monad f => MonadReader ParseFn (DecodeResult f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

ask :: DecodeResult f ParseFn #

local :: (ParseFn -> ParseFn) -> DecodeResult f a -> DecodeResult f a #

reader :: (ParseFn -> a) -> DecodeResult f a #

Monad f => MonadState CursorHistory (DecodeResult f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Monad f => MonadError DecodeError (DecodeResult f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Monad f => Monad (DecodeResult f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

(>>=) :: DecodeResult f a -> (a -> DecodeResult f b) -> DecodeResult f b #

(>>) :: DecodeResult f a -> DecodeResult f b -> DecodeResult f b #

return :: a -> DecodeResult f a #

fail :: String -> DecodeResult f a #

Functor f => Functor (DecodeResult f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

fmap :: (a -> b) -> DecodeResult f a -> DecodeResult f b #

(<$) :: a -> DecodeResult f b -> DecodeResult f a #

Monad f => Applicative (DecodeResult f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

pure :: a -> DecodeResult f a #

(<*>) :: DecodeResult f (a -> b) -> DecodeResult f a -> DecodeResult f b #

liftA2 :: (a -> b -> c) -> DecodeResult f a -> DecodeResult f b -> DecodeResult f c #

(*>) :: DecodeResult f a -> DecodeResult f b -> DecodeResult f b #

(<*) :: DecodeResult f a -> DecodeResult f b -> DecodeResult f a #

MFunctor DecodeResult Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

hoist :: Monad m => (forall a. m a -> n a) -> DecodeResult m b -> DecodeResult n b #

newtype Decoder f a Source #

Decoder type that is used directly to convert Json structures to other data types.

Constructors

Decoder 
Instances
Monad f => MonadError DecodeError (Decoder f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

throwError :: DecodeError -> Decoder f a #

catchError :: Decoder f a -> (DecodeError -> Decoder f a) -> Decoder f a #

Monad f => Monad (Decoder f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

(>>=) :: Decoder f a -> (a -> Decoder f b) -> Decoder f b #

(>>) :: Decoder f a -> Decoder f b -> Decoder f b #

return :: a -> Decoder f a #

fail :: String -> Decoder f a #

Functor f => Functor (Decoder f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

fmap :: (a -> b) -> Decoder f a -> Decoder f b #

(<$) :: a -> Decoder f b -> Decoder f a #

Monad f => Applicative (Decoder f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

pure :: a -> Decoder f a #

(<*>) :: Decoder f (a -> b) -> Decoder f a -> Decoder f b #

liftA2 :: (a -> b -> c) -> Decoder f a -> Decoder f b -> Decoder f c #

(*>) :: Decoder f a -> Decoder f b -> Decoder f b #

(<*) :: Decoder f a -> Decoder f b -> Decoder f a #

Monad f => Alt (Decoder f) Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

(<!>) :: Decoder f a -> Decoder f a -> Decoder f a #

some :: Applicative (Decoder f) => Decoder f a -> Decoder f [a] #

many :: Applicative (Decoder f) => Decoder f a -> Decoder f [a] #

MFunctor Decoder Source # 
Instance details

Defined in Waargonaut.Decode.Types

Methods

hoist :: Monad m => (forall a. m a -> n a) -> Decoder m b -> Decoder n b #

newtype JCurs Source #

Wrapper type for the SuccinctCursor

Constructors

JCurs 
Instances
Wrapped JCurs Source # 
Instance details

Defined in Waargonaut.Decode.Types

Associated Types

type Unwrapped JCurs :: * #

JCurs ~ t => Rewrapped JCurs t Source # 
Instance details

Defined in Waargonaut.Decode.Types

type Unwrapped JCurs Source # 
Instance details

Defined in Waargonaut.Decode.Types

type ParseFn = ByteString -> Either DecodeError Json Source #

Another convenience alias for the type of the function we will use to parse the input string into the Json structure.

data Err c e Source #

Convenience Error structure for the separate parsing/decoding phases. For when things really aren't that complicated.

Constructors

Parse e 
Decode (DecodeError, c) 
Instances
Functor (Err c) Source # 
Instance details

Defined in Waargonaut.Decode.Error

Methods

fmap :: (a -> b) -> Err c a -> Err c b #

(<$) :: a -> Err c b -> Err c a #

(Eq e, Eq c) => Eq (Err c e) Source # 
Instance details

Defined in Waargonaut.Decode.Error

Methods

(==) :: Err c e -> Err c e -> Bool #

(/=) :: Err c e -> Err c e -> Bool #

(Show e, Show c) => Show (Err c e) Source # 
Instance details

Defined in Waargonaut.Decode.Error

Methods

showsPrec :: Int -> Err c e -> ShowS #

show :: Err c e -> String #

showList :: [Err c e] -> ShowS #

Runners

runDecode :: Monad f => Decoder f a -> ParseFn -> JCurs -> f (Either (DecodeError, CursorHistory) a) Source #

Run a Decoder for the final result to see if you have your a or an error.

runDecodeResult :: Monad f => ParseFn -> DecodeResult f a -> f (Either (DecodeError, CursorHistory) a) Source #

Using the ParseFn, complete a DecodeResult to find out if we have the type we're after. This is mostly used internally to help build Decoder structures. Exported as it may prove useful when abstracting over the Decoder types or other such shenanigans.

runPureDecode :: Decoder Identity a -> ParseFn -> JCurs -> Either (DecodeError, CursorHistory) a Source #

Similar to the simpleDecode function, however this function expects you've already converted your input to a JCurs.

simpleDecode :: Decoder Identity a -> ParseFn -> ByteString -> Either (DecodeError, CursorHistory) a Source #

Basic usage of a Decoder is to specialise the f to be Identity, then provide the ParseFn and the ByteString input. This will run the Decoder to try to parse and decode the JSON to the a you require.

This function takes care of converting the ByteString to a JCurs.

simpleDecode (list int) myParseFn "[1,2,3]"
=
Right [1,2,3]

overrideParser :: Monad f => ParseFn -> DecodeResult f a -> DecodeResult f a Source #

This function lets you override the parsing function that is being used in a decoder for a different one. This means that when building your Decoder you are not bound to only using a single parsing function. If you have specific needs for alternate parsers then you can use this function in your Decoder to make that change.

myTricksyObj = withCursor $ curs -> do
  curs' <- down curs
  fA <- fromKey "normalFieldA" int curs'
  fB <- fromKey "normalFieldB" text curs'
  wB <- overrideParser handTunedParser $ fromKey "weirdFieldC" fieldCDecoder curs'
  pure $ Foo fA fB wB

generaliseDecoder :: Monad f => Decoder Identity a -> Decoder f a Source #

Generalise a Decoder that has been specialised to Identity back to some 'Monad f'.

Helpers

ppCursorHistory :: CursorHistory' i -> Doc a Source #

Pretty print the given CursorHistory' to a more useful format compared to a Seq of i.

Cursors

withCursor :: (JCurs -> DecodeResult f a) -> Decoder f a Source #

Function to define a Decoder for a specific data type.

For example, given the following data type:

data Image = Image
  { _imageW        :: Int
  , _imageH        :: Int
  , _imageTitle    :: Text
  , _imageAnimated :: Bool
  , _imageIDs      :: [Int]
  }

We can use withCursor to write a decoder that will be given a cursor that we can use to build the data types that we need.

imageDecoder :: Monad f => Decoder f Image
imageDecoder = withCursor $ \curs -> D.down curs >>= Image
  <$> D.fromKey "Width" D.int curs
  <*> D.fromKey "Height" D.int curs
  <*> D.fromKey "Title" D.text curs
  <*> D.fromKey "Animated" D.bool curs
  <*> D.fromKey "IDs" intArray curs

It's up to you to provide a cursor that is at the correct position for a Decoder to operate, but building decoders in this way simplifies creating decoders for larger structures, as the smaller pieces contain fewer assumptions. This encourages greater reuse of decoders and simplifies the debugging process.

mkCursor :: ByteString -> JCurs Source #

Take a ByteString input and build an index of the JSON structure inside

cursorRankL :: Lens' (JsonCursor s i p) Count Source #

Lens for accessing the rank of the JsonCursor. The rank forms part of the calculation that is the cursors current position in the index.

manyMoves :: Monad m => Natural -> (b -> m b) -> b -> m b Source #

Execute the given function n times'.

down :: Monad f => JCurs -> DecodeResult f JCurs Source #

Move the cursor down or into the child of the current cursor position.

The following examples use "*" to represent the cursor position.

Starting position:

 *{"fred": 33, "sally": 44 }

After moving down:

 { *"fred": 33, "sally": 44 }

This function will also move into the elements in an array:

Starting position:

 *[1,2,3]

After moving down:

 [*1,2,3]

This function is essential when dealing with the inner elements of objects or arrays. As you must first move down into the focus.

up :: Monad f => JCurs -> DecodeResult f JCurs Source #

Move the cursor up into the parent of the current cursor position.

The following examples use "*" to represent the cursor position.

Starting position:

 { "fred": 33, *"sally": 44 }

After moving up:

 *{"fred": 33, "sally": 44 }

try :: MonadError e m => m a -> m (Maybe a) Source #

Attempt a Decoder action that might fail and return a Maybe value instead.

moveRightN :: Monad f => Natural -> JCurs -> DecodeResult f JCurs Source #

Move the cursor rightwards n times.

Starting position:

 [*1, 2, 3]

After moveRightN 2:

 [1, 2, *3]

moveRight1 :: Monad f => JCurs -> DecodeResult f JCurs Source #

Helper function to move right once.

moveLeftN :: Monad f => Natural -> JCurs -> DecodeResult f JCurs Source #

Move the cursor leftwards n times.

moveLeft1 :: Monad f => JCurs -> DecodeResult f JCurs Source #

Helper function to move left once.

Starting position:

 [1, 2, *3]

Ater moveLeft1:

 [1, *2, 3]

moveToKey :: Monad f => Text -> JCurs -> DecodeResult f JCurs Source #

Attempt to move to the value at a given key on the current JSON object. This will only work if you have already moved down into the JSON object, because the cursor allows you to step over an entire object in a single. It has to be told to move into the object first, otherwise it will not look in the correct location for keys.

Cursor position indicated by "*".

Assuming cursor positioned here:

 *{ "foo": 33, "fieldB": "pew pew" }

This won't work, because we're AT the object, not IN the object: moveToKey "foo" cursor

This will work, because we've moved down INTO the object: down cursor >>= moveToKey "foo"

moveToRankN :: Monad f => Word64 -> JCurs -> DecodeResult f JCurs Source #

Given a rank value, attempt to move the cursor directly to that position.

Returns a InputOutOfBounds error if that position is invalid.

Decoding at cursor

jsonAtCursor :: Monad f => (ByteString -> Either DecodeError a) -> JCurs -> DecodeResult f a Source #

Using the given parsing function, attempt to decode the value of the ByteString at the current cursor position.

fromKey :: Monad f => Text -> Decoder f b -> JCurs -> DecodeResult f b Source #

Move to the first occurence of this key, as per moveToKey and then attempt to run the given Decoder on that value, returning the result.

This decoder does not assume you have moved into the object.

...
txtVal <- fromKey "foo" text c
...

atKey :: Monad f => Text -> Decoder f a -> Decoder f a Source #

A simplified version of fromKey that takes a Text value indicating a key to be moved to and decoded using the given 'Decoder f a'. If you don't need any special cursor movements to reach the list of keys you require, you could use this function to build a trivial Decoder for a record type:

This decoder assumes it is positioned at the top of an object and will move down each time, before attempting to find the given key.

data MyRec = MyRec { fieldA :: Text, fieldB :: Int }

myRecDecoder :: Decoder f MyRec
myRecDecoder = MyRec
  <$> atKey "field_a" text
  <*> atKey "field_b" int

focus :: Monad f => Decoder f a -> JCurs -> DecodeResult f a Source #

Using the given Decoder, try to decode the current focus.

myIntList <- focus (list int) cursor

Attempting decoding

fromKeyOptional :: Monad f => Text -> Decoder f b -> JCurs -> DecodeResult f (Maybe b) Source #

A version of fromKey that returns its result in Maybe. If the key is not present in the object, Nothing is returned. If the key is present, decoding will be performed as with fromKey.

For example, if a key could be absent and could be null if present, it could be decoded as follows:

join $ fromKeyOptional "key" (maybeOrNull text)

atKeyOptional :: Monad f => Text -> Decoder f b -> Decoder f (Maybe b) Source #

A version of atKey that returns its result in Maybe. If the key is not present in the object, Nothing is returned. If the key is present, decoding will be performed as with atKey.

Provided Decoders

leftwardCons :: (Monad f, Cons s s a a) => s -> Decoder f a -> JCurs -> DecodeResult f s Source #

From the current cursor position, move leftwards one position at a time and push each a onto the front of some Cons structure.

rightwardSnoc :: (Monad f, Snoc s s a a) => s -> Decoder f a -> JCurs -> DecodeResult f s Source #

From the current cursor position, move rightwards one position at a time, and append the a to some Snoc structure.

foldCursor :: Monad f => (b -> a -> b) -> (JCurs -> DecodeResult f JCurs) -> b -> Decoder f a -> JCurs -> DecodeResult f b Source #

Higher order function for combining a folding function with repeated cursor movements. This lets you combine arbitrary cursor movements with an accumulating function.

The functions leftwardCons and rightwardSnoc are both implemented using this function.

leftwardCons = foldCursor (flip cons) moveLeft1
rightwardSnoc = foldCursor snoc moveRight1

rank :: Monad f => Decoder f Count Source #

At the given cursor position, return the Count or rank of that position. Useful if you want to build a map of a complicated structure such that you're able to optimise your Decoder by using moveToRankN instead of individual cursor movements.

prismD :: Monad f => Prism' a b -> Decoder f a -> Decoder f (Maybe b) Source #

Create a Decoder from a Prism'.

prismDOrFail :: Monad f => DecodeError -> Prism' a b -> Decoder f a -> Decoder f b Source #

As per prismD but fail the Decoder if unsuccessful.

json :: Monad f => Decoder f Json Source #

Decode the Json structure at the cursor. Useful if you don't have a need to convert the Json and only want to make changes before sending it on its way.

int :: Monad f => Decoder f Int Source #

Decode an Int.

scientific :: Monad f => Decoder f Scientific Source #

Decode a Scientific number value.

integral :: (Monad f, Integral n, Bounded n) => Decoder f n Source #

Decoder for some Integral type. This conversion is walked through Mayan, I mean, Scientific to try to avoid numeric explosion issues.

string :: Monad f => Decoder f String Source #

Decode a String value.

unboundedChar :: Monad f => Decoder f Char Source #

Decode a Char value that is equivalent to a Haskell Char value, as Haskell Char supports a wider range than JSON.

boundedChar :: Monad f => Decoder f Char Source #

Decode a Char that will fail if the Char is outside of the range U+D800 to U+DFFF.

text :: Monad f => Decoder f Text Source #

Decode Text

bool :: Monad f => Decoder f Bool Source #

Decode a Bool value.

null :: Monad f => Decoder f () Source #

Decode an explicit null value at the current cursor position.

nonemptyAt :: Monad f => Decoder f a -> JCurs -> DecodeResult f (NonEmpty a) Source #

Given a Decoder for a, attempt to decode a NonEmpty list of a at the current cursor position.

nonempty :: Monad f => Decoder f a -> Decoder f (NonEmpty a) Source #

Helper to create a 'NonEmpty a' Decoder.

listAt :: Monad f => Decoder f a -> JCurs -> DecodeResult f [a] Source #

Like nonemptyAt, this takes a Decoder of a and at the given cursor will try to decode a '[a]'.

list :: Monad f => Decoder f a -> Decoder f [a] Source #

Helper function to simplify writing a '[]' decoder.

withDefault :: Monad f => a -> Decoder f (Maybe a) -> Decoder f a Source #

Try to decode an optional value, returning the given default value if Nothing is returned.

maybeOrNull :: Monad f => Decoder f a -> Decoder f (Maybe a) Source #

Named to match it's Encoder counterpart, this function will decode an optional value.

either :: Monad f => Decoder f a -> Decoder f b -> Decoder f (Either a b) Source #

Decode either an a or a b, failing if neither Decoder succeeds. The Right decoder is attempted first.

oneOf :: (Foldable g, Monad f, Eq a) => Decoder f a -> Text -> g (a, b) -> Decoder f b Source #

Helper function for "pattern matching" on a decoded value to some Haskell value. The Text argument is used in the error message should this decoder fail. Normally it would simply be the name of the type you are writing the decoder for.

This is useful for decoding sum types, such as:

data MyEnum
  = A
  | B
  | C

decodeMyEnum :: Monad f => Decoder f MyEnum
decodeMyEnum = D.oneOf D.text MyEnum
  [ ("a", A)
  , ("b", B)
  , ("c", C)
  ]

decodeMyEnumFromInt :: Monad f => Decoder f MyEnum
decodeMyEnumFromInt = D.oneOf D.int MyEnum
  [ (1, A)
  , (2, B)
  , (3, C)
  ]