2b64dbf · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #41 from basvandijk/hashmap

2b64dbfBryan O'Sullivan15 years ago

Data/Aeson/Encode.hs+2−2

compare with master

unifiedsplit

@@ -25,7 +25,7 @@ import Data.Monoid (mappend)

25import Numeric (showHex)

26import Blaze.Text (double, integral)

27import qualified Data.ByteString.Lazy.Char8 as L

28−import qualified Data.Map as M

28+import qualified Data.HashMap.Strict as H

29import qualified Data.Text as T

30import qualified Data.Vector as V

@@ -42,7 +42,7 @@ fromValue (Array v)

42 V.foldr f (fromChar ']') (V.unsafeTail v)

43 where f a z = fromChar ',' `mappend` fromValue a `mappend` z

44fromValue (Object m) =

45− case M.toList m of

45+ case H.toList m of

46 (x:xs) -> fromChar '{' `mappend`

47 one x `mappend`

48 foldr f (fromChar '}') xs

Data/Aeson/Functions.hs+26−22

@@ -1,15 +1,14 @@

1module Data.Aeson.Functions

2− (

2+ ( mapHashKeyVal

3− hashMap

3+ , hashMapKey

4− , mapHash

4+ , mapKeyVal

5− , transformMap

5+ , mapKey

6 -- * String conversions

7 , decode

8 , strict

9 , lazy

10 ) where

12−import Control.Arrow ((***), first)

13import Data.Hashable (Hashable)

12import Data.Hashable (Hashable)

14import Data.Text (Text)

13import Data.Text (Text)

15import Data.Text.Encoding (decodeUtf8, encodeUtf8)

14import Data.Text.Encoding (decodeUtf8, encodeUtf8)

@@ -18,23 +17,28 @@ import qualified Data.ByteString.Lazy as L

18import qualified Data.HashMap.Strict as H

17import qualified Data.HashMap.Strict as H

19import qualified Data.Map as M

18import qualified Data.Map as M

21−-- | Transform one map into another. The ordering of keys must be

20+-- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.

22−-- preserved by the key transformation function.

21+mapHashKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)

23−transformMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)

24− -> M.Map k1 v1 -> M.Map k2 v2

22+ -> M.Map k1 v1 -> H.HashMap k2 v2

25−transformMap fk fv = M.fromAscList . map (fk *** fv) . M.toAscList

23+mapHashKeyVal fk kv = M.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty

26−{-# INLINE transformMap #-}

24+{-# INLINE mapHashKeyVal #-}

27−

25+

28−-- | Transform a 'H.HashMap' into a 'M.Map'.

26+-- | Transform a 'M.Map' into a 'H.HashMap' while transforming the keys.

29−hashMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)

27+hashMapKey :: (Ord k2) => (k1 -> k2)

28+ -> H.HashMap k1 v -> M.Map k2 v

29+hashMapKey kv = H.foldrWithKey (M.insert . kv) M.empty

30+{-# INLINE hashMapKey #-}

31+

32+-- | Transform the keys and values of a 'H.HashMap'.

33+mapKeyVal :: (Eq k2, Hashable k2) => (k1 -> k2) -> (v1 -> v2)

30− -> H.HashMap k1 v1 -> M.Map k2 v2

34+ -> H.HashMap k1 v1 -> H.HashMap k2 v2

31−hashMap fk kv = M.fromList . map (fk *** kv) . H.toList

35+mapKeyVal fk kv = H.foldrWithKey (\k v -> H.insert (fk k) (kv v)) H.empty

32−{-# INLINE hashMap #-}

36+{-# INLINE mapKeyVal #-}

33−

37+

34−-- | Transform a 'M.Map' into a 'H.HashMap'.

38+-- | Transform the keys of a 'H.HashMap'.

35−mapHash :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.Map k1 v -> H.HashMap k2 v

39+mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> H.HashMap k1 v -> H.HashMap k2 v

36−mapHash fk = H.fromList . map (first fk) . M.toList

40+mapKey fk = mapKeyVal fk id

37−{-# INLINE mapHash #-}

41+{-# INLINE mapKey #-}

39strict :: L.ByteString -> Text

43strict :: L.ByteString -> Text

40strict = decode . B.concat . L.toChunks

44strict = decode . B.concat . L.toChunks

Data/Aeson/Generic.hs+26−25

@@ -98,7 +98,7 @@ toJSON = toJSON_generic

98 | otherwise = modError "toJSON" $

99 "cannot convert map keyed by type " ++ show tyrep

100 where tyrep = typeOf . head . Map.keys $ m

101− remap f = Object . transformMap (f . fromJust . cast) toJSON $ m

101+ remap f = Object . mapHashKeyVal (f . fromJust . cast) toJSON $ m

102

103 hashMapAny m

104 | tyrep == typeOf DT.empty = remap id

@@ -109,7 +109,7 @@ toJSON = toJSON_generic

109 | otherwise = modError "toJSON" $

110 "cannot convert map keyed by type " ++ show tyrep

111 where tyrep = typeOf . head . H.keys $ m

112− remap f = Object . hashMap (f . fromJust . cast) toJSON $ m

112+ remap f = Object . mapKeyVal (f . fromJust . cast) toJSON $ m

113

114

115-- Skip leading '_' in field name so we can use keywords

@@ -202,40 +202,41 @@ parseJSON j = parseJSON_generic j

202 vector = case j of

203 Array js -> V.mapM parseJSON js

204 _ -> myFail

205+

205 mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)

206 mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)

206 mapAny

207 mapAny

207− | tyrep `elem` stringyTypes = res

208+ | tyrep == typeOf DT.empty = process id

209+ | tyrep == typeOf LT.empty = process LT.fromStrict

210+ | tyrep == typeOf "" = process DT.unpack

211+ | tyrep == typeOf B.empty = process encodeUtf8

212+ | tyrep == typeOf L.empty = process lazy

208 | otherwise = myFail

213 | otherwise = myFail

209− where res = case j of

214+ where

215+ process f = maybe myFail return . cast =<< parseWith f

216+ parseWith :: (Ord c) => (Text -> c) -> Parser (Map.Map c e)

217+ parseWith f = case j of

218+ Object js -> Map.fromList . map (first f) . H.toList <$>

210− Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js

219+ T.mapM parseJSON js

211− _ -> myFail

220+ _ -> myFail

212− trans

213− | tyrep == typeOf DT.empty = remap id

214− | tyrep == typeOf LT.empty = remap LT.fromStrict

215− | tyrep == typeOf "" = remap DT.unpack

216− | tyrep == typeOf B.empty = remap encodeUtf8

217− | tyrep == typeOf L.empty = remap lazy

218− | otherwise = modError "parseJSON"

219− "mapAny -- should never happen"

220− tyrep = typeOf (undefined :: f)

221+ tyrep = typeOf (undefined :: f)

221− remap f = fromJust . cast . f

222+

222 hashMapAny :: forall e f. (Data e, Data f) => Parser (H.HashMap f e)

223 hashMapAny :: forall e f. (Data e, Data f) => Parser (H.HashMap f e)

223 hashMapAny

224 hashMapAny

224− | tyrep == typeOf "" = process DT.unpack

225− | tyrep == typeOf LT.empty = process LT.fromStrict

226 | tyrep == typeOf DT.empty = process id

225 | tyrep == typeOf DT.empty = process id

226+ | tyrep == typeOf LT.empty = process LT.fromStrict

227+ | tyrep == typeOf "" = process DT.unpack

228+ | tyrep == typeOf B.empty = process encodeUtf8

229+ | tyrep == typeOf L.empty = process lazy

227 | otherwise = myFail

230 | otherwise = myFail

228 where

231 where

229 process f = maybe myFail return . cast =<< parseWith f

232 process f = maybe myFail return . cast =<< parseWith f

230 parseWith :: (Eq c, Hashable c) => (Text -> c) -> Parser (H.HashMap c e)

233 parseWith :: (Eq c, Hashable c) => (Text -> c) -> Parser (H.HashMap c e)

231 parseWith f = case j of

234 parseWith f = case j of

232− Object js -> H.fromList . map (first f) . Map.toList <$>

233− T.mapM parseJSON js

235+ Object js -> mapKey f <$> T.mapM parseJSON js

234− _ -> myFail

236+ _ -> myFail

235 tyrep = typeOf (undefined :: f)

237 tyrep = typeOf (undefined :: f)

238+

236 myFail = modFail "parseJSON" $ "bad data: " ++ show j

239 myFail = modFail "parseJSON" $ "bad data: " ++ show j

237− stringyTypes = [typeOf LT.empty, typeOf DT.empty, typeOf B.empty,

238− typeOf L.empty, typeOf ""]

239

240

240parseJSON_generic :: (Data a) => Value -> Parser a

241parseJSON_generic :: (Data a) => Value -> Parser a

241parseJSON_generic j = generic

242parseJSON_generic j = generic

@@ -274,7 +275,7 @@ parseJSON_generic j = generic

274 go _ c _ jd = modFail "parseJSON" $

275 go _ c _ jd = modFail "parseJSON" $

275 "bad decodeArgs data " ++ show (c, jd)

276 "bad decodeArgs data " ++ show (c, jd)

276

277

277− fromJSObject = map (first unpack) . Map.toList

278+ fromJSObject = map (first unpack) . H.toList

278

279

279 -- Build the value by stepping through the list of subparts.

280 -- Build the value by stepping through the list of subparts.

280 construct c = evalStateT $ fromConstrM f c

281 construct c = evalStateT $ fromConstrM f c

@@ -287,7 +288,7 @@ parseJSON_generic j = generic

287 -- Select the named fields from a JSON object.

288 -- Select the named fields from a JSON object.

288 selectFields fjs = mapM sel

289 selectFields fjs = mapM sel

289 where sel f = maybe (modFail "parseJSON" $ "field does not exist " ++

290 where sel f = maybe (modFail "parseJSON" $ "field does not exist " ++

290− f) return $ Map.lookup (mungeField f) fjs

291+ f) return $ H.lookup (mungeField f) fjs

291

292

292 -- Count how many arguments a constructor has. The value x is

293 -- Count how many arguments a constructor has. The value x is

293 -- used to determine what type the constructor returns.

294 -- used to determine what type the constructor returns.

Data/Aeson/Parser.hs+2−2

@@ -27,7 +27,6 @@ import Data.Attoparsec.Char8

27import Data.Bits ((.|.), shiftL)

28import Data.ByteString as B

29import Data.Char (chr)

30−import Data.Map as Map

31import Data.Monoid (mappend, mempty)

30import Data.Monoid (mappend, mempty)

32import Data.Text as T

31import Data.Text as T

33import Data.Text.Encoding (decodeUtf8)

32import Data.Text.Encoding (decodeUtf8)

@@ -37,6 +36,7 @@ import qualified Data.Attoparsec as A

37import qualified Data.Attoparsec.Zepto as Z

36import qualified Data.Attoparsec.Zepto as Z

38import qualified Data.ByteString.Char8 as B8

37import qualified Data.ByteString.Char8 as B8

39import qualified Data.ByteString.Unsafe as B

38import qualified Data.ByteString.Unsafe as B

39+import qualified Data.HashMap.Strict as H

41-- | Parse a top-level JSON value. This must be either an object or

42-- an array.

@@ -55,7 +55,7 @@ object_ = {-# SCC "object_" #-} do

55 b <- char ':' *> skipSpace *> value

56 return (a,b)

57 vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'

58− return . Object $ Map.fromList vals

58+ return . Object $ H.fromList vals

60array_ :: Parser Value

61array_ = {-# SCC "array_" #-} do

Data/Aeson/TH.hs+10−10

@@ -38,8 +38,8 @@ import Control.Applicative

38import Control.Monad

39import Data.Aeson

40import Data.Aeson.TH

41−import qualified Data.Map as M

41+import qualified Data.HashMap.Strict as H

42−import qualified Data.Text as T

42+import qualified Data.Text as T

43import qualified Data.Vector as V

45instance 'ToJSON' a => 'ToJSON' (D a) where

@@ -72,7 +72,7 @@ instance 'FromJSON' a => 'FromJSON' (D a) where

72 \value ->

73 case value of

74 'Object' obj ->

75− case M.toList obj of

75+ case H.toList obj of

76 [(conKey, conVal)] ->

77 case conKey of

78 _ | conKey == T.pack \"Nullary\" ->

@@ -97,7 +97,7 @@ instance 'FromJSON' a => 'FromJSON' (D a) where

97 | conKey == T.pack \"Record\" ->

98 case conVal of

99 'Object' recObj ->

100− if M.size recObj == 3

100+ if H.size recObj == 3

101 then Record \<$\> recObj '.:' T.pack \"One\"

102 \<*\> recObj '.:' T.pack \"Two\"

103 \<*\> recObj '.:' T.pack \"Three\"

@@ -171,8 +171,8 @@ import Text.Show ( show )

171import Control.Monad ( (>>=) )

172import Prelude ( fromInteger )

173#endif

174−-- from containers:

174+-- from unordered-containers:

175−import qualified Data.Map as M ( lookup, toList, size )

175+import qualified Data.HashMap.Strict as H ( lookup, toList, size )

176-- from template-haskell:

177import Language.Haskell.TH

178-- from text:

@@ -465,7 +465,7 @@ consFromJSON tName withField cons = do

465 let -- Convert the Data.Map inside the Object to a list and pattern match

466 -- against it. It must contain a single element otherwise the parse will

467 -- fail.

468− caseLst = caseE ([e|M.toList|] `appE` varE obj)

468+ caseLst = caseE ([e|H.toList|] `appE` varE obj)

469 [ match (listP [tupP [varP conKey, varP conVal]])

470 (normalB caseKey)

471 []

@@ -563,7 +563,7 @@ parseArgs tName withField (RecC conName ts) =

563 | (field, _, _) <- ts

564 ]

565 match (conP 'Object [varP obj])

566− ( normalB $ condE ( infixApp ([|M.size|] `appE` varE obj)

566+ ( normalB $ condE ( infixApp ([|H.size|] `appE` varE obj)

567 [|(==)|]

568 (litE $ integerL $ genericLength ts)

569 )

@@ -576,7 +576,7 @@ parseArgs tName withField (RecC conName ts) =

576 ++ show (length ts)

577 ++ " name/value pairs"

578 )

579− ( infixApp ([|show . M.size|] `appE` varE obj)

579+ ( infixApp ([|show . H.size|] `appE` varE obj)

580 [|(++)|]

581 (litE $ stringL $ " name/value pairs")

582 )

@@ -656,7 +656,7 @@ parseTypeMismatch tName conName expected actual =

656

657lookupField :: (FromJSON a) => String -> String -> Object -> T.Text -> Parser a

658lookupField tName rec obj key =

659− case M.lookup key obj of

659+ case H.lookup key obj of

660 Nothing -> unknownFieldFail tName rec (T.unpack key)

661 Just v -> parseJSON v

662

Data/Aeson/Types/Class.hs+24−25

@@ -49,6 +49,7 @@ import Data.Text (Text, pack, unpack)

49import Data.Text.Encoding (encodeUtf8)

50import Data.Time.Clock (UTCTime)

51import Data.Time.Format (FormatTime, formatTime, parseTime)

52+import Data.Traversable (traverse)

52import Data.Typeable (Typeable)

53import Data.Typeable (Typeable)

53import Data.Vector (Vector)

54import Data.Vector (Vector)

54import Data.Word (Word, Word8, Word16, Word32, Word64)

55import Data.Word (Word, Word8, Word16, Word32, Word64)

@@ -208,7 +209,7 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where

208 {-# INLINE toJSON #-}

209 {-# INLINE toJSON #-}

209

210

210instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where

211instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where

211− parseJSON (Object (M.toList -> [(key, value)]))

212+ parseJSON (Object (H.toList -> [(key, value)]))

212 | key == left = Left <$> parseJSON value

213 | key == left = Left <$> parseJSON value

213 | key == right = Right <$> parseJSON value

214 | key == right = Right <$> parseJSON value

214 parseJSON _ = fail ""

215 parseJSON _ = fail ""

@@ -507,70 +508,68 @@ instance FromJSON a => FromJSON (IntMap.IntMap a) where

507 {-# INLINE parseJSON #-}

508 {-# INLINE parseJSON #-}

508

509

509instance (ToJSON v) => ToJSON (M.Map Text v) where

510instance (ToJSON v) => ToJSON (M.Map Text v) where

510− toJSON = Object . M.map toJSON

511+ toJSON = Object . M.foldrWithKey (\k -> H.insert k . toJSON) H.empty

511 {-# INLINE toJSON #-}

512 {-# INLINE toJSON #-}

512

513

513instance (FromJSON v) => FromJSON (M.Map Text v) where

514instance (FromJSON v) => FromJSON (M.Map Text v) where

514− parseJSON (Object o) = M.fromAscList <$> mapM go (M.toAscList o)

515+ parseJSON (Object o) = H.foldrWithKey M.insert M.empty <$> traverse parseJSON o

515− where go (k,v) = ((,) k) <$> parseJSON v

516 parseJSON v = typeMismatch "Map Text a" v

517

518instance (ToJSON v) => ToJSON (M.Map LT.Text v) where

519− toJSON = Object . transformMap LT.toStrict toJSON

519+ toJSON = Object . mapHashKeyVal LT.toStrict toJSON

520

521instance (FromJSON v) => FromJSON (M.Map LT.Text v) where

522− parseJSON = fmap (M.mapKeysMonotonic LT.fromStrict) . parseJSON

522+ parseJSON = fmap (hashMapKey LT.fromStrict) . parseJSON

523

524instance (ToJSON v) => ToJSON (M.Map String v) where

525− toJSON = Object . transformMap pack toJSON

525+ toJSON = Object . mapHashKeyVal pack toJSON

526

527instance (FromJSON v) => FromJSON (M.Map String v) where

528− parseJSON = fmap (M.mapKeysMonotonic unpack) . parseJSON

528+ parseJSON = fmap (hashMapKey unpack) . parseJSON

529

530instance (ToJSON v) => ToJSON (M.Map B.ByteString v) where

531− toJSON = Object . transformMap decode toJSON

531+ toJSON = Object . mapHashKeyVal decode toJSON

532

533instance (FromJSON v) => FromJSON (M.Map B.ByteString v) where

534− parseJSON = fmap (M.mapKeysMonotonic encodeUtf8) . parseJSON

534+ parseJSON = fmap (hashMapKey encodeUtf8) . parseJSON

535

536instance (ToJSON v) => ToJSON (M.Map LB.ByteString v) where

537− toJSON = Object . transformMap strict toJSON

537+ toJSON = Object . mapHashKeyVal strict toJSON

538

539instance (FromJSON v) => FromJSON (M.Map LB.ByteString v) where

540− parseJSON = fmap (M.mapKeysMonotonic lazy) . parseJSON

540+ parseJSON = fmap (hashMapKey lazy) . parseJSON

541

542instance (ToJSON v) => ToJSON (H.HashMap Text v) where

543− toJSON = Object . hashMap id toJSON

543+ toJSON = Object . H.map toJSON

544 {-# INLINE toJSON #-}

545

546instance (FromJSON v) => FromJSON (H.HashMap Text v) where

547− parseJSON (Object o) = H.fromList <$> mapM go (M.toList o)

547+ parseJSON (Object o) = traverse parseJSON o

548− where go (k,v) = ((,) k) <$> parseJSON v

549 parseJSON v = typeMismatch "HashMap Text a" v

548 parseJSON v = typeMismatch "HashMap Text a" v

550

549

551instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

550instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

552− toJSON = Object . M.fromList . H.foldrWithKey (\k v -> ((LT.toStrict k,toJSON v) :)) []

551+ toJSON = Object . mapKeyVal LT.toStrict toJSON

553

552

554instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where

553instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where

555− parseJSON = fmap (mapHash LT.fromStrict) . parseJSON

554+ parseJSON = fmap (mapKey LT.fromStrict) . parseJSON

556

555

557instance (ToJSON v) => ToJSON (H.HashMap String v) where

556instance (ToJSON v) => ToJSON (H.HashMap String v) where

558− toJSON = Object . hashMap pack toJSON

557+ toJSON = Object . mapKeyVal pack toJSON

559

558

560instance (FromJSON v) => FromJSON (H.HashMap String v) where

559instance (FromJSON v) => FromJSON (H.HashMap String v) where

561− parseJSON = fmap (mapHash unpack) . parseJSON

560+ parseJSON = fmap (mapKey unpack) . parseJSON

562

561

563instance (ToJSON v) => ToJSON (H.HashMap B.ByteString v) where

562instance (ToJSON v) => ToJSON (H.HashMap B.ByteString v) where

564− toJSON = Object . hashMap decode toJSON

563+ toJSON = Object . mapKeyVal decode toJSON

565

564

566instance (FromJSON v) => FromJSON (H.HashMap B.ByteString v) where

565instance (FromJSON v) => FromJSON (H.HashMap B.ByteString v) where

567− parseJSON = fmap (mapHash encodeUtf8) . parseJSON

566+ parseJSON = fmap (mapKey encodeUtf8) . parseJSON

568

567

569instance (ToJSON v) => ToJSON (H.HashMap LB.ByteString v) where

568instance (ToJSON v) => ToJSON (H.HashMap LB.ByteString v) where

570− toJSON = Object . hashMap strict toJSON

569+ toJSON = Object . mapKeyVal strict toJSON

571

570

572instance (FromJSON v) => FromJSON (H.HashMap LB.ByteString v) where

571instance (FromJSON v) => FromJSON (H.HashMap LB.ByteString v) where

573− parseJSON = fmap (mapHash lazy) . parseJSON

572+ parseJSON = fmap (mapKey lazy) . parseJSON

574

573

575instance ToJSON Value where

574instance ToJSON Value where

576 toJSON a = a

575 toJSON a = a

@@ -689,7 +688,7 @@ fromJSON = parse parseJSON

689-- in an object for it to be valid. If the key and value are

688-- in an object for it to be valid. If the key and value are

690-- optional, use '(.:?)' instead.

689-- optional, use '(.:?)' instead.

691(.:) :: (FromJSON a) => Object -> Text -> Parser a

690(.:) :: (FromJSON a) => Object -> Text -> Parser a

692−obj .: key = case M.lookup key obj of

691+obj .: key = case H.lookup key obj of

693 Nothing -> fail $ "key " ++ show key ++ " not present"

692 Nothing -> fail $ "key " ++ show key ++ " not present"

694 Just v -> parseJSON v

693 Just v -> parseJSON v

695{-# INLINE (.:) #-}

694{-# INLINE (.:) #-}

@@ -702,7 +701,7 @@ obj .: key = case M.lookup key obj of

702-- from an object without affecting its validity. If the key and

701-- from an object without affecting its validity. If the key and

703-- value are mandatory, use '(.:)' instead.

702-- value are mandatory, use '(.:)' instead.

704(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

703(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)

705−obj .:? key = case M.lookup key obj of

704+obj .:? key = case H.lookup key obj of

706 Nothing -> pure Nothing

705 Nothing -> pure Nothing

707 Just v -> parseJSON v

706 Just v -> parseJSON v

708{-# INLINE (.:?) #-}

707{-# INLINE (.:?) #-}

Data/Aeson/Types/Generic.hs+4−4

@@ -31,7 +31,7 @@ import Data.Aeson.Types.Class

31import Data.Aeson.Types.Internal

32import Data.Text (pack, unpack)

33import GHC.Generics

34−import qualified Data.Map as M

34+import qualified Data.HashMap.Strict as H

35import qualified Data.Text as T

36import qualified Data.Vector as V

@@ -119,7 +119,7 @@ instance (GObject a, GObject b) => GObject (a :+: b) where

119 {-# INLINE gObject #-}

120

121instance (Constructor c, GToJSON a, ConsToJSON a) => GObject (C1 c a) where

122− gObject = M.singleton (pack $ conName (undefined :: t c a p)) . gToJSON

122+ gObject = H.singleton (pack $ conName (undefined :: t c a p)) . gToJSON

123 {-# INLINE gObject #-}

124

125--------------------------------------------------------------------------------

@@ -159,7 +159,7 @@ instance ( GFromProduct a, GFromProduct b

159 {-# INLINE gParseJSON #-}

160

161instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where

162− gParseJSON (Object (M.toList -> [keyVal@(key, _)])) =

162+ gParseJSON (Object (H.toList -> [keyVal@(key, _)])) =

163 case gParseSum keyVal of

164 Nothing -> notFound $ unpack key

165 Just p -> p

@@ -200,7 +200,7 @@ instance (GFromRecord a, GFromRecord b) => GFromRecord (a :*: b) where

200 {-# INLINE gParseRecord #-}

201

202instance (Selector s, GFromJSON a) => GFromRecord (S1 s a) where

203− gParseRecord = maybe (notFound key) gParseJSON . M.lookup (T.pack key)

203+ gParseRecord = maybe (notFound key) gParseJSON . H.lookup (T.pack key)

204 where

205 key = selName (undefined :: t s a p)

206 {-# INLINE gParseRecord #-}

Data/Aeson/Types/Internal.hs+8−19

@@ -33,16 +33,14 @@ import Control.Applicative

33import Control.DeepSeq (NFData(..))

34import Control.Monad.State.Strict

35import Data.Attoparsec.Char8 (Number(..))

36−import Data.Data (Data)

37import Data.Hashable (Hashable(..))

36import Data.Hashable (Hashable(..))

38−import Data.List (foldl')

37+import Data.HashMap.Strict (HashMap)

39−import Data.Map (Map)

40import Data.Monoid (Monoid(..))

38import Data.Monoid (Monoid(..))

41import Data.String (IsString(..))

39import Data.String (IsString(..))

42import Data.Text (Text, pack)

40import Data.Text (Text, pack)

43import Data.Typeable (Typeable)

41import Data.Typeable (Typeable)

44import Data.Vector (Vector)

42import Data.Vector (Vector)

45−import qualified Data.Map as M

43+import qualified Data.HashMap.Strict as H

46import qualified Data.Vector as V

44import qualified Data.Vector as V

48-- | The result of running a 'Parser'.

46-- | The result of running a 'Parser'.

@@ -151,7 +149,7 @@ apP d e = do

151{-# INLINE apP #-}

149{-# INLINE apP #-}

152

150

153-- | A JSON \"object\" (key\/value map).

151-- | A JSON \"object\" (key\/value map).

154−type Object = Map Text Value

152+type Object = HashMap Text Value

155

153

156-- | A JSON \"array\" (sequence).

154-- | A JSON \"array\" (sequence).

157type Array = Vector Value

155type Array = Vector Value

@@ -163,31 +161,22 @@ data Value = Object !Object

163 | Number !Number

161 | Number !Number

164 | Bool !Bool

162 | Bool !Bool

165 | Null

163 | Null

166− deriving (Eq, Show, Typeable, Data)

164+ deriving (Eq, Show, Typeable)

167

165

168instance NFData Value where

166instance NFData Value where

169− rnf (Object o) = obj_rnf o

167+ rnf (Object o) = rnf o

170 rnf (Array a) = V.foldl' (\x y -> rnf y `seq` x) () a

168 rnf (Array a) = V.foldl' (\x y -> rnf y `seq` x) () a

171 rnf (String s) = rnf s

169 rnf (String s) = rnf s

172 rnf (Number n) = case n of I i -> rnf i; D d -> rnf d

170 rnf (Number n) = case n of I i -> rnf i; D d -> rnf d

173 rnf (Bool b) = rnf b

171 rnf (Bool b) = rnf b

174 rnf Null = ()

172 rnf Null = ()

175

173

176−obj_rnf :: (NFData k, NFData v) => Map k v -> ()

177−#if MIN_VERSION_containers(0,4,2)

178−obj_rnf = rnf

179−#elif MIN_VERSION_containers(0,4,1)

180−obj_rnf = M.foldlWithKey' (\_ k v -> rnf k `seq` rnf v) ()

181−#else

182−obj_rnf = rnf . M.toList

183−#endif

184−

185instance IsString Value where

174instance IsString Value where

186 fromString = String . pack

175 fromString = String . pack

187 {-# INLINE fromString #-}

176 {-# INLINE fromString #-}

188

177

189instance Hashable Value where

178instance Hashable Value where

190− hash (Object o) = foldl' hashWithSalt 0 . M.toList $ o

179+ hash (Object o) = H.foldl' hashWithSalt 0 o

191 hash (Array a) = V.foldl' hashWithSalt 1 a

180 hash (Array a) = V.foldl' hashWithSalt 1 a

192 hash (String s) = 2 `hashWithSalt` s

181 hash (String s) = 2 `hashWithSalt` s

193 hash (Number n) = 3 `hashWithSalt` case n of I i -> hash i; D d -> hash d

182 hash (Number n) = 3 `hashWithSalt` case n of I i -> hash i; D d -> hash d

@@ -206,7 +195,7 @@ isEmptyArray _ = False

206

195

207-- | The empty object.

196-- | The empty object.

208emptyObject :: Value

197emptyObject :: Value

209−emptyObject = Object M.empty

198+emptyObject = Object H.empty

210

199

211-- | Run a 'Parser'.

200-- | Run a 'Parser'.

212parse :: (a -> Parser b) -> a -> Result b

201parse :: (a -> Parser b) -> a -> Result b

@@ -229,5 +218,5 @@ type Pair = (Text, Value)

229-- | Create a 'Value' from a list of name\/value 'Pair's. If duplicate

218-- | Create a 'Value' from a list of name\/value 'Pair's. If duplicate

230-- keys arise, earlier keys and their associated values win.

219-- keys arise, earlier keys and their associated values win.

231object :: [Pair] -> Value

220object :: [Pair] -> Value

232−object = Object . M.fromList

221+object = Object . H.fromList

233{-# INLINE object #-}

222{-# INLINE object #-}