json2-0.8: src/Data/JSON2.hs
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-|
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}
@
2. /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
@
3. /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
@
-}
module Data.JSON2
( -- * Re-export module for pretty printing
module Data.JSON2.Pretty
-- * Base data types
, Json (..)
, Jsons (..)
-- * Renders JSON to string
, toString
-- * Conversion haskell values from and to JSON
, ToJson (toJson)
, FromJson(safeFromJson)
, fromJson
-- * Building JSON objects
, emptyObj, (.=), mkObj
-- * Merges JSON objects
, (+=), merges, mergeRec
)
where
import Data.JSON2.Internal
import Data.JSON2.Types
import Data.JSON2.Pretty
import Data.Typeable (Typeable)
import Data.List
import Data.Ratio
import Data.Int
import Data.Word
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Lazy as L(ByteString)
import qualified Data.ByteString.UTF8 as U8 (fromString, toString)
import qualified Data.ByteString.Lazy.UTF8 as LU8 (fromString, toString)
infixl 4 +=
infixr 6 .=
-------------- Conversion from and to JSON --------------------------------------
-- | Class for conversion from `Json`.
class Typeable a => ToJson a where
toJson :: a -> Json
-- | Class for conversion from `Json`.
class Typeable a => FromJson a where
safeFromJson :: Json -> ConvResult a
-- | Conversion from `Json`.
fromJson :: FromJson a => Json -> a
fromJson x = case safeFromJson x of
Left e -> error (show e)
Right r -> r
---------------- Building and manipulation JSON objects ---------
-- Building JSON objects
-- | Create empty `Json` object.
--
-- > pp $ emptyObj == {}
emptyObj :: Json
emptyObj = JObject Map.empty
-- | Create single `Json` object.
--
-- > pp ("key" .= (Just False)) == {"key": false}
(.=) :: (ToJson v, Typeable v) => String -> v -> Json
k .= v = JObject $ Map.singleton k (toJson v)
-- | Create `Json` object from list.
--
-- > pp $ mkObj [("a", "old"), ("a", "new"), ("bb", "other")] == {"a": "new", "bb": "other"}
mkObj :: (ToJson v, Typeable v) => [(String ,v)] -> Json
mkObj xs = JObject $ Map.fromList (map (\(k,v) -> (k, toJson v)) xs)
-- * Merges JSON objects
-- | 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
(+=) :: Json -> Json -> Json
(+=) (JObject x ) (JObject y) = JObject $ Map.union y x
(+=) (JObject x ) _ = JObject x
(+=) _ (JObject y) = JObject y
(+=) _ _ = emptyObj
-- | Merge `Json` objects from list.
--
-- > pp $ merges [("a" .= "old"), ("a" .= "new"), ("bb" .= "other")] == {"a": "new", "bb": "other"}
merges :: [Json] -> Json
merges = foldl (+=) emptyObj
-- | Recursively merge the two `Json` objects.
mergeRec :: Json -> Json -> Json
mergeRec ox@(JObject x) oy@(JObject y) = mergeRec' ox oy
mergeRec _ _ = emptyObj
mergeRec' (JObject x) (JObject y) = JObject $ Map.unionWith mergeRec' x y
mergeRec' _ js = js
------------------------- Instances -----------------------------
-- Mix instances
instance ToJson Json where
toJson = id
instance FromJson Json where
safeFromJson = return
instance ToJson () where
toJson () = JArray []
instance FromJson () where
safeFromJson (JArray []) = return ()
safeFromJson x = mkError x
instance ToJson a => ToJson (Maybe a) where
toJson = maybe JNull toJson
instance FromJson a => FromJson (Maybe a) where
safeFromJson x = if x == JNull then return Nothing
else return $ Just (fromJson x)
instance ToJson Bool where
toJson = JBool
instance FromJson Bool where
safeFromJson (JBool x) = return x
safeFromJson x = mkError x
instance (ToJson a, ToJson b) => ToJson (Either a b) where
toJson (Right x) = toJson [[], [x]]
toJson (Left x) = toJson [[x], []]
instance (FromJson a, FromJson b) => FromJson (Either a b) where
safeFromJson (JArray [JArray [], JArray [x]]) = (return . Right . fromJson) x
safeFromJson (JArray [JArray [x], JArray []]) = (return . Left . fromJson) x
safeFromJson x = mkError x
-- Instances String
instance ToJson String where
toJson = JString
instance FromJson String where
safeFromJson (JString x) = return x
safeFromJson x = mkError x
instance ToJson B.ByteString where
toJson = JString . U8.toString
instance FromJson B.ByteString where
safeFromJson (JString x) = (return . U8.fromString) x
safeFromJson x = mkError x
instance ToJson L.ByteString where
toJson = JString . LU8.toString
instance FromJson L.ByteString where
safeFromJson (JString x) = (return . LU8.fromString) x
safeFromJson x = mkError x
-- Instances Char
instance ToJson Char where
toJson = jsonifyIntegral . fromEnum
instance FromJson Char where
safeFromJson (JNumber x) = checkBoundsEnum (toEnum . round) x
safeFromJson x = mkError x
-- Instances Numeric
instance ToJson Integer where
toJson = jsonifyIntegral
instance FromJson Integer where
safeFromJson (JNumber x) = return (round x)
safeFromJson x = mkError x
-- Instances Int
instance ToJson Int where
toJson = jsonifyIntegral
instance FromJson Int where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Int8 where
toJson = jsonifyIntegral
instance FromJson Int8 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Int16 where
toJson = jsonifyIntegral
instance FromJson Int16 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Int32 where
toJson = jsonifyIntegral
instance FromJson Int32 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Int64 where
toJson = jsonifyIntegral
instance FromJson Int64 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
-- Instances Word
instance ToJson Word where
toJson = jsonifyIntegral
instance FromJson Word where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Word8 where
toJson = jsonifyIntegral
instance FromJson Word8 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Word16 where
toJson = jsonifyIntegral
instance FromJson Word16 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Word32 where
toJson = jsonifyIntegral
instance FromJson Word32 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
instance ToJson Word64 where
toJson = jsonifyIntegral
instance FromJson Word64 where
safeFromJson (JNumber x) = checkBoundsIntegral round x
safeFromJson x = mkError x
--
jsonifyIntegral :: (Integral a) => a -> Json
jsonifyIntegral i = JNumber (fromIntegral i % 1)
-- Instances Floating and Rational
instance ToJson Double where
toJson = jsonifyRealFrac
instance FromJson Double where
safeFromJson (JNumber x) = checkInfinite fromRational x
safeFromJson x = mkError x
instance ToJson Float where
toJson = jsonifyRealFrac
instance FromJson Float where
safeFromJson (JNumber x) = checkInfinite fromRational x
safeFromJson x = mkError x
instance ToJson Rational where
toJson = JNumber
instance FromJson Rational where
safeFromJson (JNumber x) = return x
safeFromJson x = mkError x
--
jsonifyRealFrac :: (RealFrac a) => a -> Json
jsonifyRealFrac i = JNumber (approxRational i 1e-666)
-- ** Instances Containers
instance ToJson a => ToJson [a] where
toJson = JArray . map toJson
instance FromJson a => FromJson [a] where
safeFromJson (JArray xs) = return (map fromJson xs)
safeFromJson x = mkError x
instance ToJson v => ToJson (Map String v) where
toJson = JObject . Map.map toJson
instance FromJson v => FromJson (Map String v) where
safeFromJson (JObject m) = return $ Map.map fromJson m
safeFromJson x = mkError x
instance ToJson a => ToJson (Set a) where
toJson = JArray . (map toJson) . Set.toList
instance (FromJson a, Ord a) => FromJson (Set a) where
safeFromJson (JArray xs) = return . Set.fromList $ map fromJson xs
safeFromJson x = mkError x
-- Instances Tuples
instance ( ToJson t1, ToJson t2)
=> ToJson (t1, t2) where
toJson (x1, x2) = JArray [toJson x1, toJson x2]
instance (FromJson t1, FromJson t2)
=> FromJson (t1, t2) where
safeFromJson (JArray [x1, x2]) = return (fromJson x1, fromJson x2)
safeFromJson x = mkError x
instance (ToJson t1, ToJson t2, ToJson t3)
=> ToJson (t1, t2, t3) where
toJson (x1, x2, x3) = JArray [toJson x1, toJson x2, toJson x3]
instance (FromJson t1, FromJson t2, FromJson t3)
=> FromJson (t1, t2, t3) where
safeFromJson (JArray [x1, x2, x3]) = return (fromJson x1, fromJson x2, fromJson x3)
safeFromJson x = mkError x
instance (ToJson t1, ToJson t2, ToJson t3, ToJson t4) => ToJson (t1, t2, t3, t4) where
toJson (x1, x2, x3, x4) = JArray [toJson x1, toJson x2, toJson x3, toJson x4]
instance (FromJson t1, FromJson t2, FromJson t3, FromJson t4)
=> FromJson (t1, t2, t3, t4) where
safeFromJson (JArray [x1, x2, x3, x4]) = return (fromJson x1, fromJson x2, fromJson x3,
fromJson x4)
safeFromJson x = mkError x
instance (ToJson t1, ToJson t2, ToJson t3, ToJson t4, ToJson t5)
=> ToJson (t1, t2, t3, t4, t5) where
toJson (x1, x2, x3, x4, x5) = JArray [toJson x1, toJson x2, toJson x3, toJson x4, toJson x5]
instance (FromJson t1, FromJson t2, FromJson t3, FromJson t4, FromJson t5)
=> FromJson (t1, t2, t3, t4, t5) where
safeFromJson (JArray [x1, x2, x3, x4, x5]) = return (fromJson x1, fromJson x2, fromJson x3,
fromJson x4, fromJson x5)
safeFromJson x = mkError x