module Data.JSON2
(
module Data.JSON2.Pretty
, module Data.JSON2.Internal
, Json (..)
, Jsons (..)
, toString
, ToJson (toJson)
, FromJson(safeFromJson)
, fromJson
, emptyObj, (.=), mkObj
, (+=), merges, mergeRec
, projectionObj
)
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 Data.Maybe (catMaybes)
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 .=
class Typeable a => ToJson a where
toJson :: a -> Json
class Typeable a => FromJson a where
safeFromJson :: Json -> ConvResult a
fromJson :: FromJson a => Json -> a
fromJson x = case safeFromJson x of
Left e -> error (show e)
Right r -> r
emptyObj :: Json
emptyObj = JObject Map.empty
(.=) :: (ToJson v, Typeable v) => String -> v -> Json
k .= v = JObject $ Map.singleton k (toJson v)
mkObj :: (ToJson v, Typeable v) => [(String ,v)] -> Json
mkObj xs = JObject $ Map.fromList (map (\(k,v) -> (k, toJson v)) xs)
(+=) :: Json -> Json -> Json
(+=) (JObject x ) (JObject y) = JObject $ Map.union y x
(+=) (JObject x ) _ = JObject x
(+=) _ (JObject y) = JObject y
(+=) _ _ = emptyObj
merges :: [Json] -> Json
merges = foldl (+=) emptyObj
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
projectionObj :: [String] -> Json -> Jsons
projectionObj ps (JObject m) = case (nub ps) \\ (Map.keys m) of
[] -> catMaybes $ map (\k -> Map.lookup k m) ps
_ -> []
where ks = Map.keys m
projectionObj _ _ = []
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
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
instance ToJson Char where
toJson = jsonifyIntegral . fromEnum
instance FromJson Char where
safeFromJson (JNumber x) = checkBoundsEnum (toEnum . round) x
safeFromJson x = mkError x
instance ToJson Integer where
toJson = jsonifyIntegral
instance FromJson Integer where
safeFromJson (JNumber x) = return (round x)
safeFromJson x = mkError x
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
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)
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)
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
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