Bryan O'Sullivan avatar Bryan O'Sullivan committed 82d9c6d

Improve generic support for maps.

Comments (0)

Files changed (1)

Data/Aeson/Generic.hs

 import Control.Applicative ((<$>))
 import Control.Arrow (first)
 import Control.Monad.State.Strict
-import Data.Aeson.Functions (hashMap, transformMap)
+import Data.Aeson.Functions
 import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
 import Data.Attoparsec.Number (Number)
 import Data.Generics
 import Data.IntSet (IntSet)
 import Data.Maybe (fromJust)
 import Data.Text (Text, pack, unpack)
+import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Word (Word, Word8, Word16, Word32, Word64)
 import qualified Data.Aeson.Types as T
     set s = Array . V.fromList . map toJSON . Set.toList $ s
 
     mapAny m
-      | tyrep == typeOf ""       = remap pack
       | tyrep == typeOf DT.empty = remap id
       | tyrep == typeOf LT.empty = remap LT.toStrict
+      | tyrep == typeOf ""       = remap pack
+      | tyrep == typeOf B.empty  = remap decode
+      | tyrep == typeOf L.empty  = remap strict
       | otherwise = modError "toJSON" $
                              "cannot convert map keyed by type " ++ show tyrep
       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
+      | tyrep == typeOf ""       = remap pack
+      | tyrep == typeOf B.empty  = remap decode
+      | tyrep == typeOf L.empty  = remap strict
       | otherwise = modError "toJSON" $
                              "cannot convert map keyed by type " ++ show tyrep
       where tyrep = typeOf . head . H.keys $ m
                _        -> myFail
     mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)
     mapAny
-        | tyrep `elem` [typeOf LT.empty, typeOf DT.empty, typeOf ""] = res
+        | tyrep `elem` stringyTypes = res
         | otherwise = myFail
       where res = case j of
                 Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js
                 _         -> myFail
             trans
-               | tyrep == typeOf DT.empty = fromJust . cast . id
-               | tyrep == typeOf LT.empty = fromJust . cast . LT.fromStrict
-               | tyrep == typeOf ""       = fromJust . cast . DT.unpack
+               | tyrep == typeOf DT.empty = remap id
+               | tyrep == typeOf LT.empty = remap LT.fromStrict
+               | tyrep == typeOf ""       = remap DT.unpack
+               | tyrep == typeOf B.empty  = remap encodeUtf8
+               | tyrep == typeOf L.empty  = remap lazy
                | otherwise = modError "parseJSON"
                                       "mapAny -- should never happen"
             tyrep = typeOf (undefined :: f)
+            remap f = fromJust . cast . f
     myFail = modFail "parseJSON" $ "bad data: " ++ show j
-
+    stringyTypes = [typeOf LT.empty, typeOf DT.empty, typeOf B.empty, 
+                    typeOf L.empty, typeOf ""]
 
 parseJSON_generic :: (Data a) => Value -> Parser a
 parseJSON_generic j = generic
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.