c25614f · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

FromJSONKeyCoerce

c25614fOleg Grenrus10 years ago

Data/Aeson/Types/Class.hs+2−1

compare with master

unifiedsplit

@@ -262,7 +262,8 @@ data ToJSONKeyFunction a

262 | ToJSONKeyValue (a -> Value, a -> Encoding)

263

264data FromJSONKeyFunction a

265+ = FromJSONKeyCoerce

265− = FromJSONKeyText (Text -> a)

266+ | FromJSONKeyText (Text -> a)

266 | FromJSONKeyTextParser (Text -> Parser a)

267 | FromJSONKeyTextParser (Text -> Parser a)

267 | FromJSONKeyValue (Value -> Parser a)

268 | FromJSONKeyValue (Value -> Parser a)

268 deriving (Functor)

269 deriving (Functor)

Data/Aeson/Types/Instances.hs+10−1

@@ -128,6 +128,8 @@ import qualified Data.Vector.Primitive as VP

128import qualified Data.Vector.Storable as VS

129import qualified Data.Vector.Unboxed as VU

130

131+import Unsafe.Coerce (unsafeCoerce)

132+

131#if MIN_VERSION_base(4,8,0)

133#if MIN_VERSION_base(4,8,0)

132#else

134#else

133import Control.Applicative ((<$>), (<*>), pure)

135import Control.Applicative ((<$>), (<*>), pure)

@@ -720,6 +722,8 @@ instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where

720

722

721instance (FromJSON v, FromJSONKey k, Ord k) => FromJSON (M.Map k v) where

723instance (FromJSON v, FromJSONKey k, Ord k) => FromJSON (M.Map k v) where

722 parseJSON = case fromJSONKey of

724 parseJSON = case fromJSONKey of

725+ FromJSONKeyCoerce -> withObject "Map k v" $

726+ fmap (H.foldrWithKey (M.insert . unsafeCoerce) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

723 FromJSONKeyText f -> withObject "Map k v" $

727 FromJSONKeyText f -> withObject "Map k v" $

724 fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

728 fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

725 FromJSONKeyTextParser f -> withObject "Map k v" $

729 FromJSONKeyTextParser f -> withObject "Map k v" $

@@ -744,6 +748,8 @@ instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where

744

748

745instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where

749instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where

746 parseJSON = case fromJSONKey of

750 parseJSON = case fromJSONKey of

751+ FromJSONKeyCoerce -> withObject "HashMap ~Text v" $

752+ uc . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

747 FromJSONKeyText f -> withObject "HashMap k v" $

753 FromJSONKeyText f -> withObject "HashMap k v" $

748 fmap (mapKey f) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

754 fmap (mapKey f) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)

749 FromJSONKeyTextParser f -> withObject "HashMap k v" $

755 FromJSONKeyTextParser f -> withObject "HashMap k v" $

@@ -751,6 +757,9 @@ instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k

751 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->

757 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->

752 H.fromList <$> (Tr.sequence .

758 H.fromList <$> (Tr.sequence .

753 zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)

759 zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)

760+ where

761+ uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)

762+ uc = unsafeCoerce

754 {-# INLINE parseJSON #-}

763 {-# INLINE parseJSON #-}

755

764

756instance (ToJSON v) => ToJSON (Tree.Tree v) where

765instance (ToJSON v) => ToJSON (Tree.Tree v) where

@@ -1620,7 +1629,7 @@ instance ToJSONKey Text where

1620 toJSONKey = ToJSONKeyText (id,toEncoding)

1629 toJSONKey = ToJSONKeyText (id,toEncoding)

1621

1630

1622instance FromJSONKey Text where

1631instance FromJSONKey Text where

1623− fromJSONKey = FromJSONKeyText id

1632+ fromJSONKey = FromJSONKeyCoerce

1624

1633

1625-- | TODO: where ToJSONKey instance

1634-- | TODO: where ToJSONKey instance

1626instance FromJSONKey b => FromJSONKey (Tagged a b) where

1635instance FromJSONKey b => FromJSONKey (Tagged a b) where

benchmarks/AesonMap.hs+1−2

@@ -44,7 +44,6 @@ instance FromJSONKey T1 where

44-- Coerce

45-------------------------------------------------------------------------------

47−-- | TODO: same as T1 for now

48newtype T2 = T2 T.Text

47newtype T2 = T2 T.Text

49 deriving (Eq, Ord)

48 deriving (Eq, Ord)

@@ -55,7 +54,7 @@ instance Hashable T2 where

55instance FromJSON T2 where

54instance FromJSON T2 where

56 parseJSON = withText "T2" $ pure . T2

55 parseJSON = withText "T2" $ pure . T2

57instance FromJSONKey T2 where

56instance FromJSONKey T2 where

58− fromJSONKey = FromJSONKeyText T2

57+ fromJSONKey = FromJSONKeyCoerce

60-------------------------------------------------------------------------------

59-------------------------------------------------------------------------------

61-- TextParser

60-- TextParser