@@ -26,6 +26,7 @@ import Data.Aeson.Functions
2626import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
2727import Data.Attoparsec.Number (Number)
2828import Data.Generics
29+import Data.Hashable (Hashable)
2930import Data.Int (Int8, Int16, Int32, Int64)
3031import Data.IntSet (IntSet)
3132import Data.Maybe (fromJust)
@@ -159,7 +160,7 @@ parseJSON j = parseJSON_generic j
159160 `ext1R` list
160161 `ext1R` vector
161162 `ext2R'` mapAny
162− -- Don't know how to support parsing HashMaps :-(
163+ `ext2R'` hashMapAny
163164 -- Use the standard encoding for all base types.
164165 `extR` (value :: F Integer)
165166 `extR` (value :: F Int)
@@ -214,6 +215,20 @@ parseJSON j = parseJSON_generic j
214215 "mapAny -- should never happen"
215216 tyrep = typeOf (undefined :: f)
216217 remap f = fromJust . cast . f
218+ hashMapAny :: forall e f. (Data e, Data f) => Parser (H.HashMap f e)
219+ hashMapAny
220+ | tyrep == typeOf "" = process DT.unpack
221+ | tyrep == typeOf LT.empty = process LT.fromStrict
222+ | tyrep == typeOf DT.empty = process id
223+ | otherwise = myFail
224+ where
225+ process f = maybe myFail return . cast =<< parseWith f
226+ parseWith :: (Eq c, Hashable c) => (Text -> c) -> Parser (H.HashMap c e)
227+ parseWith f = case j of
228+ Object js -> H.fromList . map (first f) . Map.toList <$>
229+ T.mapM parseJSON js
230+ _ -> myFail
231+ tyrep = typeOf (undefined :: f)
217232 myFail = modFail "parseJSON" $ "bad data: " ++ show j
218233 stringyTypes = [typeOf LT.empty, typeOf DT.empty, typeOf B.empty,
219234 typeOf L.empty, typeOf ""]