Bryan O'Sullivan avatar Bryan O'Sullivan committed 55abf9a

Add support for HashMap from the unordered-containers package.

Comments (0)

Files changed (4)

Data/Aeson/Functions.hs

 module Data.Aeson.Functions
     (
-      transformMap
+      hashMap
+    , mapHash
+    , transformMap
     ) where
 
-import Control.Arrow ((***))
+import Control.Arrow ((***), first)
+import Data.Hashable (Hashable)
+import qualified Data.HashMap.Strict as H
 import qualified Data.Map as M
 
 -- | Transform one map into another.  The ordering of keys must be
--- preserved.
+-- preserved by the key transformation function.
 transformMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)
              -> M.Map k1 v1 -> M.Map k2 v2
 transformMap fk fv = M.fromAscList . map (fk *** fv) . M.toAscList
+{-# INLINE transformMap #-}
+
+-- | Transform a 'H.HashMap' into a 'M.Map'.
+hashMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)
+        -> H.HashMap k1 v1 -> M.Map k2 v2
+hashMap fk kv = M.fromList . map (fk *** kv) . H.toList
+{-# INLINE hashMap #-}
+
+-- | Transform a 'M.Map' into a 'H.HashMap'.
+mapHash :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.Map k1 v -> H.HashMap k2 v
+mapHash fk = H.fromList . map (first fk) . M.toList
+{-# INLINE mapHash #-}

Data/Aeson/Generic.hs

 import Control.Applicative ((<$>))
 import Control.Arrow (first)
 import Control.Monad.State.Strict
-import Data.Aeson.Functions (transformMap)
+import Data.Aeson.Functions (hashMap, transformMap)
 import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
 import Data.Attoparsec.Number (Number)
 import Data.Generics
 import qualified Data.Aeson.Types as T
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
+import qualified Data.HashMap.Strict as H
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as DT
          `ext1Q` vector
          `ext1Q` set
          `ext2Q'` mapAny
+         `ext2Q'` hashMapAny
          -- Use the standard encoding for all base types.
          `extQ` (T.toJSON :: T Integer)
          `extQ` (T.toJSON :: T Int)
       | tyrep == typeOf LT.empty = remap LT.toStrict
       | otherwise = modError "toJSON" $
                              "cannot convert map keyed by type " ++ show tyrep
-      where tyrep = typeOf $ head $ Map.keys m
+      where tyrep = typeOf . head . Map.keys $ m
             remap f = Object . transformMap (f . fromJust . cast) toJSON $ m
 
+    hashMapAny m
+      | tyrep == typeOf ""       = remap pack
+      | tyrep == typeOf DT.empty = remap id
+      | tyrep == typeOf LT.empty = remap LT.toStrict
+      | otherwise = modError "toJSON" $
+                             "cannot convert map keyed by type " ++ show tyrep
+      where tyrep = typeOf . head . H.keys $ m
+            remap f = Object . hashMap (f . fromJust . cast) toJSON $ m
+
 
 toJSON_generic :: (Data a) => a -> Value
 toJSON_generic = generic
              `ext1R` list
              `ext1R` vector
              `ext2R'` mapAny
+             -- Don't know how to support parsing HashMaps :-(
              -- Use the standard encoding for all base types.
              `extR` (value :: F Integer)
              `extR` (value :: F Int)
         | otherwise = myFail
       where res = case j of
                 Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js
-                _ -> myFail
+                _         -> myFail
             trans
                | tyrep == typeOf DT.empty = fromJust . cast . id
                | tyrep == typeOf LT.empty = fromJust . cast . LT.fromStrict

Data/Aeson/Types.hs

     ) where
 
 import Control.Applicative
+import Control.DeepSeq (NFData(..))
 import Control.Monad (MonadPlus(..))
-import Data.Monoid (Monoid(..))
-import Control.DeepSeq (NFData(..))
+import Data.Aeson.Functions (hashMap, mapHash, transformMap)
+import Data.Attoparsec.Char8 (Number(..))
 import Data.Data (Data)
 import Data.Int (Int8, Int16, Int32, Int64)
-import qualified Data.IntSet as IntSet
 import Data.Map (Map)
 import Data.Monoid (Dual(..), First(..), Last(..))
+import Data.Monoid (Monoid(..))
 import Data.Ratio (Ratio)
 import Data.Text (Text, pack, unpack)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Format (FormatTime, formatTime, parseTime)
-import Data.Attoparsec.Char8 (Number(..))
 import Data.Typeable (Typeable)
 import Data.Vector (Vector)
 import Data.Word (Word, Word8, Word16, Word32, Word64)
 import System.Locale (defaultTimeLocale)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as LB
+import qualified Data.HashMap.Strict as H
+import qualified Data.IntSet as IntSet
 import qualified Data.Map as M
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
 import qualified Data.Vector as V
-import Data.Aeson.Functions
 
 -- | The result of running a 'Parser'.
 data Result a = Error String
 instance (FromJSON v) => FromJSON (M.Map String v) where
     parseJSON = fmap (M.mapKeysMonotonic unpack) . parseJSON
 
+instance (ToJSON v) => ToJSON (H.HashMap Text v) where
+    toJSON = Object . hashMap id toJSON
+    {-# INLINE toJSON #-}
+
+instance (FromJSON v) => FromJSON (H.HashMap Text v) where
+    parseJSON (Object o) = H.fromList <$> go (M.toList o)
+      where
+        go ((k,v):kvs)   = ((:) . (,) k) <$> parseJSON v <*> go kvs
+        go _             = pure []
+    parseJSON _          = empty
+
+instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where
+    toJSON = Object . M.fromList . H.foldrWithKey (\k v -> ((LT.toStrict k,toJSON v) :)) []
+
+instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where
+    parseJSON = fmap (mapHash LT.fromStrict) . parseJSON
+
+instance (ToJSON v) => ToJSON (H.HashMap String v) where
+    toJSON = Object . hashMap pack toJSON
+
+instance (FromJSON v) => FromJSON (H.HashMap String v) where
+    parseJSON = fmap (mapHash unpack) . parseJSON
+
 instance ToJSON Value where
     toJSON a = a
     {-# INLINE toJSON #-}
     bytestring,
     containers,
     deepseq,
+    hashable,
     monads-fd,
     old-locale,
     syb,
     text >= 0.11.0.2,
     time,
+    unordered-containers,
     vector >= 0.7
 
   if flag(developer)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.