@@ -128,6 +128,8 @@ import qualified Data.Vector.Primitive as VP
128128import qualified Data.Vector.Storable as VS
129129import qualified Data.Vector.Unboxed as VU
130130
131+import Unsafe.Coerce (unsafeCoerce)
132+
131133#if MIN_VERSION_base(4,8,0)
132134#else
133135import Control.Applicative ((<$>), (<*>), pure)
@@ -720,6 +722,8 @@ instance (ToJSON v, ToJSONKey k) => ToJSON (M.Map k v) where
720722
721723instance (FromJSON v, FromJSONKey k, Ord k) => FromJSON (M.Map k v) where
722724 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)
723727 FromJSONKeyText f -> withObject "Map k v" $
724728 fmap (H.foldrWithKey (M.insert . f) M.empty) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
725729 FromJSONKeyTextParser f -> withObject "Map k v" $
@@ -744,6 +748,8 @@ instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
744748
745749instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k v) where
746750 parseJSON = case fromJSONKey of
751+ FromJSONKeyCoerce -> withObject "HashMap ~Text v" $
752+ uc . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
747753 FromJSONKeyText f -> withObject "HashMap k v" $
748754 fmap (mapKey f) . H.traverseWithKey (\k v -> parseJSON v <?> Key k)
749755 FromJSONKeyTextParser f -> withObject "HashMap k v" $
@@ -751,6 +757,9 @@ instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k
751757 FromJSONKeyValue f -> withArray "Map k v" $ \arr ->
752758 H.fromList <$> (Tr.sequence .
753759 zipWith (parseIndexedJSONPair f) [0..] . V.toList $ arr)
760+ where
761+ uc :: Parser (H.HashMap Text v) -> Parser (H.HashMap k v)
762+ uc = unsafeCoerce
754763 {-# INLINE parseJSON #-}
755764
756765instance (ToJSON v) => ToJSON (Tree.Tree v) where
@@ -1620,7 +1629,7 @@ instance ToJSONKey Text where
16201629 toJSONKey = ToJSONKeyText (id,toEncoding)
16211630
16221631instance FromJSONKey Text where
1623− fromJSONKey = FromJSONKeyText id
1632+ fromJSONKey = FromJSONKeyCoerce
16241633
16251634-- | TODO: where ToJSONKey instance
16261635instance FromJSONKey b => FromJSONKey (Tagged a b) where