fields-json-0.2.2.4: Abusing monadic syntax JSON objects generation.

Copyright(c) Scrive 2011
LicenseBSD-style (see the LICENSE file in the distribution)
Maintainerandrzej@scrive.com
Stabilitydevelopment
Portabilityportable
Safe HaskellNone
LanguageHaskell98

Text.JSON.Gen

Contents

Description

Abusing monadic 'do' notation library for generating JSON object. Hard-bound to JSValue from json package from hackage.

Main ideas

  • Overloaded function value to set values in underlying JSON - Bool, Int, String, lists, etc.
  • JSON generation may not be pure with valueM. You can perform some IO while generating JSON. This is usefull skip useless inner binding.
  • Compositionality - use object to easy create JSON objects. The objects function is there to support arrays of objects.
  • Monadic notation - it really looks nicer then composition with . or some magic combinator
runJSONGen $ do
    value "a" "a"
    value "b" [1,2,3]
    object "c" $ do
        value "x" True
        value "y" False

Will generate json object:

{a : "a", b: [1,2,3], c: {x: true, y : false}}
Synopsis

Documentation

Basic types

type JSONGen = JSONGenT Identity Source #

Basic types

data JSONGenT m a Source #

Instances
MonadTrans JSONGenT Source # 
Instance details

Defined in Text.JSON.Gen

Methods

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

Monad m => Monad (JSONGenT m) Source # 
Instance details

Defined in Text.JSON.Gen

Methods

(>>=) :: JSONGenT m a -> (a -> JSONGenT m b) -> JSONGenT m b #

(>>) :: JSONGenT m a -> JSONGenT m b -> JSONGenT m b #

return :: a -> JSONGenT m a #

fail :: String -> JSONGenT m a #

Functor m => Functor (JSONGenT m) Source # 
Instance details

Defined in Text.JSON.Gen

Methods

fmap :: (a -> b) -> JSONGenT m a -> JSONGenT m b #

(<$) :: a -> JSONGenT m b -> JSONGenT m a #

Monad m => Applicative (JSONGenT m) Source # 
Instance details

Defined in Text.JSON.Gen

Methods

pure :: a -> JSONGenT m a #

(<*>) :: JSONGenT m (a -> b) -> JSONGenT m a -> JSONGenT m b #

liftA2 :: (a -> b -> c) -> JSONGenT m a -> JSONGenT m b -> JSONGenT m c #

(*>) :: JSONGenT m a -> JSONGenT m b -> JSONGenT m b #

(<*) :: JSONGenT m a -> JSONGenT m b -> JSONGenT m a #

MonadIO m => MonadIO (JSONGenT m) Source # 
Instance details

Defined in Text.JSON.Gen

Methods

liftIO :: IO a -> JSONGenT m a #

Monad m => MonadReader (Seq (String, JSValue)) (JSONGenT m) Source #

This instance gives us the ability to use FromJSValue function while generating.

Instance details

Defined in Text.JSON.Gen

Methods

ask :: JSONGenT m (Seq (String, JSValue)) #

local :: (Seq (String, JSValue) -> Seq (String, JSValue)) -> JSONGenT m a -> JSONGenT m a #

reader :: (Seq (String, JSValue) -> a) -> JSONGenT m a #

Runners

runJSONGen :: JSONGen () -> JSValue Source #

Simple runner

Creating JSON's

value :: (Monad m, ToJSValue a) => String -> a -> JSONGenT m () Source #

Set pure value under given name in final JSON object

valueM :: (Monad m, ToJSValue a) => String -> m a -> JSONGenT m () Source #

Monadic verion of value

object :: Monad m => String -> JSONGenT m () -> JSONGenT m () Source #

Embed other JSON object as field in resulting JSON object.

objects :: Monad m => String -> [JSONGenT m ()] -> JSONGenT m () Source #

Version for lists of objects.