git.iko.soy/typeable/aeson
on master help sign in
Merge
2b73451Bryan O'Sullivan
.hgignore+1−1
compare with master
unifiedsplit
@@ -1,6 +1,6 @@
1^(?:dist|\.DS_Store)$
1^(?:dist|\.DS_Store)$
2^benchmarks/(?:AesonParse|EncodeFile|JsonParse|.*_p)$
2^benchmarks/(?:AesonParse|EncodeFile|JsonParse|.*_p)$
3−.*\.(?:h[ip]|o|orig|out|pdf|prof|ps|rej)$
3+.*\.(?:aux|h[ip]|o|orig|out|pdf|prof|ps|rej)$
4
4
5syntax: glob
5syntax: glob
6*~
6*~
.hgtags+1
@@ -1,2 +1,3 @@
105d9437b2280648ae25ac170697ec1c48eda7af0 0.1.0.0
105d9437b2280648ae25ac170697ec1c48eda7af0 0.1.0.0
2f4cf6abd5a81affb08c6563d51e38ac4f8451217 0.2.0.0
2f4cf6abd5a81affb08c6563d51e38ac4f8451217 0.2.0.0
3+fe4084e5615941d9822834239e4c32a036291327 0.3.0.0
Data/Aeson/Functions.hs+20
@@ -3,10 +3,18 @@ module Data.Aeson.Functions
3 hashMap
3 hashMap
4 , mapHash
4 , mapHash
5 , transformMap
5 , transformMap
6+ -- * String conversions
7+ , decode
8+ , strict
9+ , lazy
6 ) where
10 ) where
7
11
8import Control.Arrow ((***), first)
12import Control.Arrow ((***), first)
9import Data.Hashable (Hashable)
13import Data.Hashable (Hashable)
14+import Data.Text (Text)
15+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
16+import qualified Data.ByteString as B
17+import qualified Data.ByteString.Lazy as L
10import qualified Data.HashMap.Strict as H
18import qualified Data.HashMap.Strict as H
11import qualified Data.Map as M
19import qualified Data.Map as M
12
20
@@ -27,3 +35,15 @@ hashMap fk kv = M.fromList . map (fk *** kv) . H.toList
27mapHash :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.Map k1 v -> H.HashMap k2 v
35mapHash :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.Map k1 v -> H.HashMap k2 v
28mapHash fk = H.fromList . map (first fk) . M.toList
36mapHash fk = H.fromList . map (first fk) . M.toList
29{-# INLINE mapHash #-}
37{-# INLINE mapHash #-}
38+
39+strict :: L.ByteString -> Text
40+strict = decode . B.concat . L.toChunks
41+{-# INLINE strict #-}
42+
43+lazy :: Text -> L.ByteString
44+lazy = L.fromChunks . (:[]) . encodeUtf8
45+{-# INLINE lazy #-}
46+
47+decode :: B.ByteString -> Text
48+decode = decodeUtf8
49+{-# INLINE decode #-}
Data/Aeson/Generic.hs+17−7
@@ -22,7 +22,7 @@ module Data.Aeson.Generic
22import Control.Applicative ((<$>))
22import Control.Applicative ((<$>))
23import Control.Arrow (first)
23import Control.Arrow (first)
24import Control.Monad.State.Strict
24import Control.Monad.State.Strict
25−import Data.Aeson.Functions (hashMap, transformMap)
25+import Data.Aeson.Functions
26import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
26import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
27import Data.Attoparsec.Number (Number)
27import Data.Attoparsec.Number (Number)
28import Data.Generics
28import Data.Generics
@@ -31,6 +31,7 @@ import Data.Int (Int8, Int16, Int32, Int64)
31import Data.IntSet (IntSet)
31import Data.IntSet (IntSet)
32import Data.Maybe (fromJust)
32import Data.Maybe (fromJust)
33import Data.Text (Text, pack, unpack)
33import Data.Text (Text, pack, unpack)
34+import Data.Text.Encoding (encodeUtf8)
34import Data.Time.Clock (UTCTime)
35import Data.Time.Clock (UTCTime)
35import Data.Word (Word, Word8, Word16, Word32, Word64)
36import Data.Word (Word, Word8, Word16, Word32, Word64)
36import qualified Data.Aeson.Types as T
37import qualified Data.Aeson.Types as T
@@ -88,18 +89,22 @@ toJSON = toJSON_generic
88 set s = Array . V.fromList . map toJSON . Set.toList $ s
89 set s = Array . V.fromList . map toJSON . Set.toList $ s
89
90
90 mapAny m
91 mapAny m
91− | tyrep == typeOf "" = remap pack
92 | tyrep == typeOf DT.empty = remap id
92 | tyrep == typeOf DT.empty = remap id
93 | tyrep == typeOf LT.empty = remap LT.toStrict
93 | tyrep == typeOf LT.empty = remap LT.toStrict
94+ | tyrep == typeOf "" = remap pack
95+ | tyrep == typeOf B.empty = remap decode
96+ | tyrep == typeOf L.empty = remap strict
94 | otherwise = modError "toJSON" $
97 | otherwise = modError "toJSON" $
95 "cannot convert map keyed by type " ++ show tyrep
98 "cannot convert map keyed by type " ++ show tyrep
96 where tyrep = typeOf . head . Map.keys $ m
99 where tyrep = typeOf . head . Map.keys $ m
97 remap f = Object . transformMap (f . fromJust . cast) toJSON $ m
100 remap f = Object . transformMap (f . fromJust . cast) toJSON $ m
98
101
99 hashMapAny m
102 hashMapAny m
100− | tyrep == typeOf "" = remap pack
101 | tyrep == typeOf DT.empty = remap id
103 | tyrep == typeOf DT.empty = remap id
102 | tyrep == typeOf LT.empty = remap LT.toStrict
104 | tyrep == typeOf LT.empty = remap LT.toStrict
105+ | tyrep == typeOf "" = remap pack
106+ | tyrep == typeOf B.empty = remap decode
107+ | tyrep == typeOf L.empty = remap strict
103 | otherwise = modError "toJSON" $
108 | otherwise = modError "toJSON" $
104 "cannot convert map keyed by type " ++ show tyrep
109 "cannot convert map keyed by type " ++ show tyrep
105 where tyrep = typeOf . head . H.keys $ m
110 where tyrep = typeOf . head . H.keys $ m
@@ -195,18 +200,21 @@ parseJSON j = parseJSON_generic j
195 _ -> myFail
200 _ -> myFail
196 mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)
201 mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)
197 mapAny
202 mapAny
198− | tyrep `elem` [typeOf LT.empty, typeOf DT.empty, typeOf ""] = res
203+ | tyrep `elem` stringyTypes = res
199 | otherwise = myFail
204 | otherwise = myFail
200 where res = case j of
205 where res = case j of
201 Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js
206 Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js
202 _ -> myFail
207 _ -> myFail
203 trans
208 trans
204− | tyrep == typeOf DT.empty = fromJust . cast . id
209+ | tyrep == typeOf DT.empty = remap id
205− | tyrep == typeOf LT.empty = fromJust . cast . LT.fromStrict
210+ | tyrep == typeOf LT.empty = remap LT.fromStrict
206− | tyrep == typeOf "" = fromJust . cast . DT.unpack
211+ | tyrep == typeOf "" = remap DT.unpack
212+ | tyrep == typeOf B.empty = remap encodeUtf8
213+ | tyrep == typeOf L.empty = remap lazy
207 | otherwise = modError "parseJSON"
214 | otherwise = modError "parseJSON"
208 "mapAny -- should never happen"
215 "mapAny -- should never happen"
209 tyrep = typeOf (undefined :: f)
216 tyrep = typeOf (undefined :: f)
217+ remap f = fromJust . cast . f
210 hashMapAny :: forall e f. (Data e, Data f) => Parser (H.HashMap f e)
218 hashMapAny :: forall e f. (Data e, Data f) => Parser (H.HashMap f e)
211 hashMapAny
219 hashMapAny
212 | tyrep == typeOf "" = process DT.unpack
220 | tyrep == typeOf "" = process DT.unpack
@@ -222,6 +230,8 @@ parseJSON j = parseJSON_generic j
222 _ -> myFail
230 _ -> myFail
223 tyrep = typeOf (undefined :: f)
231 tyrep = typeOf (undefined :: f)
224 myFail = modFail "parseJSON" $ "bad data: " ++ show j
232 myFail = modFail "parseJSON" $ "bad data: " ++ show j
233+ stringyTypes = [typeOf LT.empty, typeOf DT.empty, typeOf B.empty,
234+ typeOf L.empty, typeOf ""]
225
235
226parseJSON_generic :: (Data a) => Value -> Parser a
236parseJSON_generic :: (Data a) => Value -> Parser a
227parseJSON_generic j = generic
237parseJSON_generic j = generic
Data/Aeson/Types.hs+40−24
@@ -38,7 +38,7 @@ module Data.Aeson.Types
38import Control.Applicative
38import Control.Applicative
39import Control.DeepSeq (NFData(..))
39import Control.DeepSeq (NFData(..))
40import Control.Monad (MonadPlus(..))
40import Control.Monad (MonadPlus(..))
41−import Data.Aeson.Functions (hashMap, mapHash, transformMap)
41+import Data.Aeson.Functions
42import Data.Attoparsec.Char8 (Number(..))
42import Data.Attoparsec.Char8 (Number(..))
43import Data.Data (Data)
43import Data.Data (Data)
44import Data.Int (Int8, Int16, Int32, Int64)
44import Data.Int (Int8, Int16, Int32, Int64)
@@ -48,7 +48,7 @@ import Data.Monoid (Monoid(..))
48import Data.Ratio (Ratio)
48import Data.Ratio (Ratio)
49import Data.String (IsString(..))
49import Data.String (IsString(..))
50import Data.Text (Text, pack, unpack)
50import Data.Text (Text, pack, unpack)
51−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
51+import Data.Text.Encoding (encodeUtf8)
52import Data.Time.Clock (UTCTime)
52import Data.Time.Clock (UTCTime)
53import Data.Time.Format (FormatTime, formatTime, parseTime)
53import Data.Time.Format (FormatTime, formatTime, parseTime)
54import Data.Typeable (Typeable)
54import Data.Typeable (Typeable)
@@ -458,7 +458,7 @@ instance FromJSON LT.Text where
458 {-# INLINE parseJSON #-}
458 {-# INLINE parseJSON #-}
459
459
460instance ToJSON B.ByteString where
460instance ToJSON B.ByteString where
461− toJSON = String . decodeUtf8
461+ toJSON = String . decode
462 {-# INLINE toJSON #-}
462 {-# INLINE toJSON #-}
463
463
464instance FromJSON B.ByteString where
464instance FromJSON B.ByteString where
@@ -467,11 +467,11 @@ instance FromJSON B.ByteString where
467 {-# INLINE parseJSON #-}
467 {-# INLINE parseJSON #-}
468
468
469instance ToJSON LB.ByteString where
469instance ToJSON LB.ByteString where
470− toJSON = toJSON . B.concat . LB.toChunks
470+ toJSON = toJSON . strict
471 {-# INLINE toJSON #-}
471 {-# INLINE toJSON #-}
472
472
473instance FromJSON LB.ByteString where
473instance FromJSON LB.ByteString where
474− parseJSON (String t) = pure . LB.fromChunks . (:[]) . encodeUtf8 $ t
474+ parseJSON (String t) = pure . lazy $ t
475 parseJSON _ = empty
475 parseJSON _ = empty
476 {-# INLINE parseJSON #-}
476 {-# INLINE parseJSON #-}
477
477
@@ -480,7 +480,7 @@ instance (ToJSON a) => ToJSON [a] where
480 {-# INLINE toJSON #-}
480 {-# INLINE toJSON #-}
481
481
482instance (FromJSON a) => FromJSON [a] where
482instance (FromJSON a) => FromJSON [a] where
483− parseJSON (Array a) = mapA parseJSON (V.toList a)
483+ parseJSON (Array a) = mapM parseJSON (V.toList a)
484 parseJSON _ = empty
484 parseJSON _ = empty
485 {-# INLINE parseJSON #-}
485 {-# INLINE parseJSON #-}
486
486
@@ -489,7 +489,7 @@ instance (ToJSON a) => ToJSON (Vector a) where
489 {-# INLINE toJSON #-}
489 {-# INLINE toJSON #-}
490
490
491instance (FromJSON a) => FromJSON (Vector a) where
491instance (FromJSON a) => FromJSON (Vector a) where
492− parseJSON (Array a) = V.fromList <$> mapA parseJSON (V.toList a)
492+ parseJSON (Array a) = V.mapM parseJSON a
493 parseJSON _ = empty
493 parseJSON _ = empty
494 {-# INLINE parseJSON #-}
494 {-# INLINE parseJSON #-}
495
495
@@ -514,10 +514,8 @@ instance (ToJSON v) => ToJSON (M.Map Text v) where
514 {-# INLINE toJSON #-}
514 {-# INLINE toJSON #-}
515
515
516instance (FromJSON v) => FromJSON (M.Map Text v) where
516instance (FromJSON v) => FromJSON (M.Map Text v) where
517− parseJSON (Object o) = M.fromAscList <$> go (M.toAscList o)
517+ parseJSON (Object o) = M.fromAscList <$> mapM go (M.toAscList o)
518− where
519− go ((k,v):kvs) = ((:) . (,) k) <$> parseJSON v <*> go kvs
518+ where go (k,v) = ((,) k) <$> parseJSON v
520− go _ = pure []
521 parseJSON _ = empty
519 parseJSON _ = empty
522
520
523instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
521instance (ToJSON v) => ToJSON (M.Map LT.Text v) where
@@ -532,15 +530,25 @@ instance (ToJSON v) => ToJSON (M.Map String v) where
532instance (FromJSON v) => FromJSON (M.Map String v) where
530instance (FromJSON v) => FromJSON (M.Map String v) where
533 parseJSON = fmap (M.mapKeysMonotonic unpack) . parseJSON
531 parseJSON = fmap (M.mapKeysMonotonic unpack) . parseJSON
534
532
533+instance (ToJSON v) => ToJSON (M.Map B.ByteString v) where
534+ toJSON = Object . transformMap decode toJSON
535+
536+instance (FromJSON v) => FromJSON (M.Map B.ByteString v) where
537+ parseJSON = fmap (M.mapKeysMonotonic encodeUtf8) . parseJSON
538+
539+instance (ToJSON v) => ToJSON (M.Map LB.ByteString v) where
540+ toJSON = Object . transformMap strict toJSON
541+
542+instance (FromJSON v) => FromJSON (M.Map LB.ByteString v) where
543+ parseJSON = fmap (M.mapKeysMonotonic lazy) . parseJSON
544+
535instance (ToJSON v) => ToJSON (H.HashMap Text v) where
545instance (ToJSON v) => ToJSON (H.HashMap Text v) where
536 toJSON = Object . hashMap id toJSON
546 toJSON = Object . hashMap id toJSON
537 {-# INLINE toJSON #-}
547 {-# INLINE toJSON #-}
538
548
539instance (FromJSON v) => FromJSON (H.HashMap Text v) where
549instance (FromJSON v) => FromJSON (H.HashMap Text v) where
540− parseJSON (Object o) = H.fromList <$> go (M.toList o)
550+ parseJSON (Object o) = H.fromList <$> mapM go (M.toList o)
541− where
542− go ((k,v):kvs) = ((:) . (,) k) <$> parseJSON v <*> go kvs
551+ where go (k,v) = ((,) k) <$> parseJSON v
543− go _ = pure []
544 parseJSON _ = empty
552 parseJSON _ = empty
545
553
546instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
554instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
@@ -555,6 +563,18 @@ instance (ToJSON v) => ToJSON (H.HashMap String v) where
555instance (FromJSON v) => FromJSON (H.HashMap String v) where
563instance (FromJSON v) => FromJSON (H.HashMap String v) where
556 parseJSON = fmap (mapHash unpack) . parseJSON
564 parseJSON = fmap (mapHash unpack) . parseJSON
557
565
566+instance (ToJSON v) => ToJSON (H.HashMap B.ByteString v) where
567+ toJSON = Object . hashMap decode toJSON
568+
569+instance (FromJSON v) => FromJSON (H.HashMap B.ByteString v) where
570+ parseJSON = fmap (mapHash encodeUtf8) . parseJSON
571+
572+instance (ToJSON v) => ToJSON (H.HashMap LB.ByteString v) where
573+ toJSON = Object . hashMap strict toJSON
574+
575+instance (FromJSON v) => FromJSON (H.HashMap LB.ByteString v) where
576+ parseJSON = fmap (mapHash lazy) . parseJSON
577+
558instance ToJSON Value where
578instance ToJSON Value where
559 toJSON a = a
579 toJSON a = a
560 {-# INLINE toJSON #-}
580 {-# INLINE toJSON #-}
@@ -565,8 +585,9 @@ instance FromJSON Value where
565
585
566-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
586-- | A newtype wrapper for 'UTCTime' that uses the same non-standard
567-- serialization format as Microsoft .NET.
587-- serialization format as Microsoft .NET.
568−newtype DotNetTime = DotNetTime UTCTime
588+newtype DotNetTime = DotNetTime {
589+ fromDotNetTime :: UTCTime
569− deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
590+ } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)
570
591
571instance ToJSON DotNetTime where
592instance ToJSON DotNetTime where
572 toJSON (DotNetTime t) =
593 toJSON (DotNetTime t) =
@@ -582,7 +603,8 @@ instance FromJSON DotNetTime where
582 {-# INLINE parseJSON #-}
603 {-# INLINE parseJSON #-}
583
604
584instance ToJSON UTCTime where
605instance ToJSON UTCTime where
606+ toJSON t = String (pack (take 23 str ++ "Z"))
585− toJSON t = String (pack (formatTime defaultTimeLocale "%FT%X%QZ" t))
607+ where str = formatTime defaultTimeLocale "%FT%T%Q" t
586 {-# INLINE toJSON #-}
608 {-# INLINE toJSON #-}
587
609
588instance FromJSON UTCTime where
610instance FromJSON UTCTime where
@@ -627,9 +649,3 @@ instance ToJSON a => ToJSON (Last a) where
627instance FromJSON a => FromJSON (Last a) where
649instance FromJSON a => FromJSON (Last a) where
628 parseJSON = fmap Last . parseJSON
650 parseJSON = fmap Last . parseJSON
629 {-# INLINE parseJSON #-}
651 {-# INLINE parseJSON #-}
630−
631−mapA :: (Alternative m) => (t -> m a) -> [t] -> m [a]
632−mapA f = go
633− where
634− go (a:as) = (:) <$> f a <*> go as
635− go _ = pure []
aeson.cabal+2−2
@@ -1,5 +1,5 @@
1name: aeson
1name: aeson
2−version: 0.2.0.0
2+version: 0.3.0.0
3license: BSD3
3license: BSD3
4license-file: LICENSE
4license-file: LICENSE
5category: Text, Web, JSON
5category: Text, Web, JSON
@@ -99,7 +99,7 @@ library
99 syb,
99 syb,
100 text >= 0.11.0.2,
100 text >= 0.11.0.2,
101 time,
101 time,
102− unordered-containers,
102+ unordered-containers >= 0.1.2.0,
103 vector >= 0.7
103 vector >= 0.7
104
104
105 if flag(developer)
105 if flag(developer)