json2-0.8.1: Library provides support for JSON.

Data.JSON2

Contents

Description

  1. Pretty prints

Re-export module Data.JSON2.Pretty. Example of use:

    *ghci>  pp $ mkObj [(show x, x) | x <- [0..7]]
    {0: 0, 1: 1, 2: 2, 3: 3, 4: 4, 5: 5, 6: 6, 7: 7}
  1. Renders JSON to String

Haskell value has a JSON string:

     HASKELL value                             JSON string (toString . toJson)
    -------------------------------           -----------------------------
    Just "bla" :: Maybe String                "bla"
    Nothing :: Maybe String                   null
    Left 1 :: Either Int Int                  [[1], []]
    Right 1 :: Either Int Int                 [[], [1]]
    'a' :: Char                               97
    () :: ()                                  []
    (1, "bla") :: (Int, String)               [1, "bla"]
    fromList [1,2,3,4] :: Set Int             [1, 2, 3, 4]
    fromList [("0",0),("1",10),("2",20)]      {"0": 0, "1": 10, "2": 20}
        :: Map String Int
  1. Conversion haskell values from and to JSON

This module provides many instances classes FromJson and ToJson for haskell data types. See instances class ToJson for SQL (HDBC) in module Database.HDBC.JSON2 (package json2-hdbc).

Adding Instance class ToJson or FromJson

Transformation of algebraic product in Json. For example:

    data Person = Person {name :: String, age:: Int}
        deriving (Typeable, Show, Eq)
    instance ToJson Person where
        toJson (Person s n) = toJson [toJson s, toJson n]
    instance FromJson Person where
        safeFromJson (JArray [js, jn])
                       = return $ Person (fromJson js) (fromJson jn)
        safeFromJson x = mkError x

Converting Bounded and Enum values to Json. For example:

    data Color = Red | Green | Blue | Black
        deriving (Typeable, Show, Eq, Enum, Bounded)
    instance ToJson Color where
        toJson = JNumber . toRational . fromEnum
    instance FromJson Color where
        safeFromJson (JNumber x) = checkBoundsEnum (toEnum . round) x
        safeFromJson x =  mkError x

Synopsis

Re-export module for pretty printing

Base data types

type Jsons = [Json]

Renders JSON to string

toString :: Json -> String

Renders Json to String.

Conversion haskell values from and to JSON

class Typeable a => ToJson a whereSource

Class for conversion from Json.

Methods

toJson :: a -> JsonSource

fromJson :: FromJson a => Json -> aSource

Conversion from Json.

Building JSON objects

emptyObj :: JsonSource

Create empty Json object.

 pp $ emptyObj   ==   {}

(.=) :: (ToJson v, Typeable v) => String -> v -> JsonSource

Create single Json object.

  pp ("key" .= (Just False))   ==   {"key": false}

mkObj :: (ToJson v, Typeable v) => [(String, v)] -> JsonSource

Create Json object from list.

  pp $ mkObj [("a", "old"), ("a", "new"), ("bb", "other")]   == {"a": "new", "bb": "other"}

Merges JSON objects

(+=) :: Json -> Json -> JsonSource

Merge two JObject. Other Json values interpreted as emptyObj.

 pp $ ("a" .= "old") += ("a" .= "new") += ("bb" .= "other")  ==   {"a": "new", "bb": "other"}
 obj += emptyObj   ==   emptyObj += obj
 obj += obj   ==   emptyObj += obj   ==   obj += emptyObj  
 obj1 += (obj2 += obj3)   ==   (obj1 += obj2) += obj3

merges :: [Json] -> JsonSource

Merge Json objects from list.

  pp $ merges [("a" .= "old"), ("a" .= "new"), ("bb" .= "other")]   ==   {"a": "new", "bb": "other"}

mergeRec :: Json -> Json -> JsonSource

Recursively merge the two Json objects.