@@ -1,4 +1,4 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
1+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances #-}
3-- Module: Data.Aeson.Types
3-- Module: Data.Aeson.Types
4-- Copyright: (c) 2011 MailRank, Inc.
4-- Copyright: (c) 2011 MailRank, Inc.
@@ -14,7 +14,10 @@ module Data.Aeson.Types
14 -- * Core JSON types
14 -- * Core JSON types
18 -- * Type conversion
21 -- * Type conversion
19 , FromJSON(..)
22 , FromJSON(..)
20 , ToJSON(..)
23 , ToJSON(..)
@@ -25,23 +28,32 @@ module Data.Aeson.Types
31+import Control.Arrow ((***))
28import Control.Applicative
32import Control.Applicative
29import Control.DeepSeq (NFData(..))
33import Control.DeepSeq (NFData(..))
34+-- import Data.Data (Data)
35+import Data.Hashable (Hashable)
30import Data.HashMap (HashMap)
36import Data.HashMap (HashMap)
31−import qualified Data.ByteString as B
37+import Data.Monoid (Dual(..), First(..), Last(..))
32−import qualified Data.ByteString.Lazy as LB
33−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
34import Data.Text (Text, pack, unpack)
38import Data.Text (Text, pack, unpack)
35−import qualified Data.Text.Lazy as LT
39+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
36import Data.Time.Clock (UTCTime)
40import Data.Time.Clock (UTCTime)
37import Data.Time.Format (formatTime, parseTime)
41import Data.Time.Format (formatTime, parseTime)
38import Data.Typeable (Typeable)
42import Data.Typeable (Typeable)
39import Data.Vector (Vector)
43import Data.Vector (Vector)
40import System.Locale (defaultTimeLocale)
44import System.Locale (defaultTimeLocale)
41−import qualified Data.HashMap as M
45+import qualified Data.HashMap as HM
46+import qualified Data.Map as M
47+import qualified Data.ByteString as B
48+import qualified Data.ByteString.Lazy as LB
49+import qualified Data.Set as Set
50+import qualified Data.Text.Lazy as LT
42import qualified Data.Vector as V
51import qualified Data.Vector as V
53+-- | A JSON \"object\" (key\/value map).
44type Object = HashMap Text Value
54type Object = HashMap Text Value
56+-- | A JSON \"array\" (sequence).
45type Array = Vector Value
57type Array = Vector Value
47-- | A JSON value represented as a Haskell value.
59-- | A JSON value represented as a Haskell value.
@@ -61,9 +73,24 @@ instance NFData Value where
61 rnf (Bool b) = rnf b
73 rnf (Bool b) = rnf b
62 rnf Null = ()
74 rnf Null = ()
78+emptyArray = Array V.empty
80+-- | The empty object.
82+emptyObject = Object HM.empty
84+-- | A key\/value pair for an 'Object'.
85+newtype Pair = Pair { unPair :: (Text, Value) }
86+ deriving (Eq, Typeable)
88+instance Show Pair where
64−-- | Construct an 'Object' from a key and a value.
91+-- | Construct a 'Pair' from a key and a value.
65−(.=) :: ToJSON a => Text -> a -> Object
92+(.=) :: ToJSON a => Text -> a -> Pair
66−name .= value = M.singleton name (toJSON value)
93+name .= value = Pair (name, toJSON value)
67{-# INLINE (.=) #-}
94{-# INLINE (.=) #-}
69-- | Retrieve the value associated with the given key of an 'Object'.
96-- | Retrieve the value associated with the given key of an 'Object'.
@@ -73,8 +100,8 @@ name .= value = M.singleton name (toJSON value)
73-- This accessor is appropriate if the key and value /must/ be present
100-- This accessor is appropriate if the key and value /must/ be present
74-- in an object for it to be valid. If the key and value are
101-- in an object for it to be valid. If the key and value are
75-- optional, use '(.:?)' instead.
102-- optional, use '(.:?)' instead.
76−(.:) :: (Alternative f, FromJSON a) => Object -> Text -> f a
103+(.:) :: (Alternative m, FromJSON a) => Object -> Text -> m a
77−obj .: key = case M.lookup key obj of
104+obj .: key = case HM.lookup key obj of
78 Nothing -> empty
105 Nothing -> empty
79 Just v -> fromJSON v
106 Just v -> fromJSON v
80{-# INLINE (.:) #-}
107{-# INLINE (.:) #-}
@@ -86,16 +113,16 @@ obj .: key = case M.lookup key obj of
86-- This accessor is most useful if the key and value can be absent
113-- This accessor is most useful if the key and value can be absent
87-- from an object without affecting its validity. If the key and
114-- from an object without affecting its validity. If the key and
88-- value are mandatory, use '(.:?)' instead.
115-- value are mandatory, use '(.:?)' instead.
89−(.:?) :: (Alternative f, FromJSON a) => Object -> Text -> f (Maybe a)
116+(.:?) :: (Alternative m, FromJSON a) => Object -> Text -> m (Maybe a)
90−obj .:? key = case M.lookup key obj of
117+obj .:? key = case HM.lookup key obj of
91 Nothing -> pure Nothing
118 Nothing -> pure Nothing
92 Just v -> fromJSON v
119 Just v -> fromJSON v
93{-# INLINE (.:?) #-}
120{-# INLINE (.:?) #-}
95−-- | Create a 'Value' from a list of 'Object's. If duplicate
122+-- | Create a 'Value' from a list of 'Pair's. If duplicate
96-- keys arise, earlier keys and their associated values win.
123-- keys arise, earlier keys and their associated values win.
97−object :: [Object] -> Value
124+object :: [Pair] -> Value
98−object = Object . M.fromList . concat . map M.toList
125+object = Object . HM.fromList . map unPair
99{-# INLINE object #-}
126{-# INLINE object #-}
101-- | A type that can be converted to JSON.
128-- | A type that can be converted to JSON.
@@ -113,7 +140,7 @@ class ToJSON a where
113-- | A type that can be converted from JSON, with the possibility of
140-- | A type that can be converted from JSON, with the possibility of
114-- failure.
141-- failure.
116−-- When writing an instance, use 'empty' to make a conversion fail,
143+-- When writing an instance, use 'mzero' to make a conversion fail,
117-- e.g. if an 'Object' is missing a required key, or the value is of
144-- e.g. if an 'Object' is missing a required key, or the value is of
118-- the wrong type.
145-- the wrong type.
@@ -126,11 +153,11 @@ class ToJSON a where
126-- v '.:' \"x\" '<*>'
153-- v '.:' \"x\" '<*>'
127-- v '.:' \"y\"
154-- v '.:' \"y\"
129−-- \-- A non-'Object' value is of the wrong type, so use 'empty' to fail.
156+-- \-- A non-'Object' value is of the wrong type, so use 'mzero' to fail.
130−-- fromJSON _ = 'empty'
157+-- fromJSON _ = 'mzero'
132class FromJSON a where
159class FromJSON a where
133− fromJSON :: Alternative f => Value -> f a
160+ fromJSON :: Alternative m => Value -> m a
135instance (ToJSON a) => ToJSON (Maybe a) where
162instance (ToJSON a) => ToJSON (Maybe a) where
136 toJSON (Just a) = toJSON a
163 toJSON (Just a) = toJSON a
@@ -223,12 +250,6 @@ instance FromJSON LB.ByteString where
223 fromJSON _ = empty
250 fromJSON _ = empty
224 {-# INLINE fromJSON #-}
251 {-# INLINE fromJSON #-}
226−mapA :: (Applicative f) => (t -> f a) -> [t] -> f [a]
229− go (a:as) = (:) <$> f a <*> go as
232instance (ToJSON a) => ToJSON [a] where
253instance (ToJSON a) => ToJSON [a] where
233 toJSON = Array . V.fromList . map toJSON
254 toJSON = Array . V.fromList . map toJSON
234 {-# INLINE toJSON #-}
255 {-# INLINE toJSON #-}
@@ -247,6 +268,37 @@ instance (FromJSON a) => FromJSON (Vector a) where
247 fromJSON _ = empty
268 fromJSON _ = empty
248 {-# INLINE fromJSON #-}
269 {-# INLINE fromJSON #-}
271+instance (ToJSON a) => ToJSON (Set.Set a) where
272+ toJSON = toJSON . Set.toList
273+ {-# INLINE toJSON #-}
275+instance (Ord a, FromJSON a) => FromJSON (Set.Set a) where
276+ fromJSON = fmap Set.fromList . fromJSON
277+ {-# INLINE fromJSON #-}
279+instance (ToJSON v) => ToJSON (M.Map Text v) where
280+ toJSON = Object . HM.fromList . M.toList . M.map toJSON
281+ {-# INLINE toJSON #-}
283+instance (FromJSON v) => FromJSON (M.Map Text v) where
284+ fromJSON (Object o) = M.fromList <$> go (HM.toList o)
286+ go ((k,v):kvs) = ((:) . (,) k) <$> fromJSON v <*> go kvs
290+instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
291+ toJSON = Object . transformMap LT.toStrict toJSON
293+instance (FromJSON v) => FromJSON (M.Map LT.Text v) where
294+ fromJSON = fmap (M.mapKeysMonotonic LT.fromStrict) . fromJSON
296+instance (ToJSON v) => ToJSON (M.Map String v) where
297+ toJSON = Object . transformMap pack toJSON
299+instance (FromJSON v) => FromJSON (M.Map String v) where
300+ fromJSON = fmap (M.mapKeysMonotonic unpack) . fromJSON
250instance ToJSON Value where
302instance ToJSON Value where
251 toJSON a = a
303 toJSON a = a
252 {-# INLINE toJSON #-}
304 {-# INLINE toJSON #-}
@@ -280,12 +332,38 @@ instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
280 fromJSON _ = empty
332 fromJSON _ = empty
281 {-# INLINE fromJSON #-}
333 {-# INLINE fromJSON #-}
335+instance ToJSON a => ToJSON (Dual a) where
336+ toJSON = toJSON . getDual
337+ {-# INLINE toJSON #-}
339+instance FromJSON a => FromJSON (Dual a) where
340+ fromJSON = fmap Dual . fromJSON
341+ {-# INLINE fromJSON #-}
343+instance ToJSON a => ToJSON (First a) where
344+ toJSON = toJSON . getFirst
345+ {-# INLINE toJSON #-}
347+instance FromJSON a => FromJSON (First a) where
348+ fromJSON = fmap First . fromJSON
349+ {-# INLINE fromJSON #-}
351+instance ToJSON a => ToJSON (Last a) where
352+ toJSON = toJSON . getLast
353+ {-# INLINE toJSON #-}
355+instance FromJSON a => FromJSON (Last a) where
356+ fromJSON = fmap Last . fromJSON
357+ {-# INLINE fromJSON #-}
359+-- | Transform one map into another. The ordering of keys must be
361+transformMap :: (Ord k1, Hashable k2, Ord k2) => (k1 -> k2) -> (v1 -> v2)
362+ -> M.Map k1 v1 -> HM.HashMap k2 v2
363+transformMap fk fv = HM.fromList . map (fk *** fv) . M.toList
290−
365+mapA :: (Alternative m) => (t -> m a) -> [t] -> m [a]
368+ go (a:as) = (:) <$> f a <*> go as