@@ -20,8 +20,9 @@ module Data.Aeson.Generic
2020 ) where
2121
2222import Control.Applicative ((<$>))
23−import Control.Arrow (first,(***))
23+import Control.Arrow (first)
2424import Control.Monad.State.Strict
25+import Data.Aeson.Functions (transformMap)
2526import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
2627import Data.Attoparsec.Number (Number)
2728import Data.Generics
@@ -84,11 +85,13 @@ toJSON = toJSON_generic
8485 set s = Array . V.fromList . map toJSON . Set.toList $ s
8586
8687 mapAny m
87− | tyrep == typeOf "" = Object . Map.fromAscList . map ((pack . fromJust . cast) *** toJSON) . Map.toList $ m
88− | tyrep == typeOf DT.empty = Object . Map.fromAscList . map ((fromJust . cast) *** toJSON) . Map.toList $ m
89− | tyrep == typeOf LT.empty = Object . Map.fromAscList . map ((LT.toStrict . fromJust . cast) *** toJSON) . Map.toList $ m
90− | otherwise = error $ "toJSON cannot convert map keyed by type: " ++ show tyrep
88+ | tyrep == typeOf "" = remap pack
89+ | tyrep == typeOf DT.empty = remap id
90+ | tyrep == typeOf LT.empty = remap LT.toStrict
91+ | otherwise = modError "toJSON" $
92+ "cannot convert map keyed by type " ++ show tyrep
9193 where tyrep = typeOf $ head $ Map.keys m
94+ remap f = Object . transformMap (f . fromJust . cast) toJSON $ m
9295
9396
9497toJSON_generic :: (Data a) => a -> Value
@@ -108,8 +111,8 @@ toJSON_generic = generic
108111 AlgRep _ -> encodeConstr (toConstr a) (gmapQ toJSON a)
109112 rep -> err (dataTypeOf a) rep
110113 where
111− err dt r = error $ "Data.Aeson.Generic.toJSON: not AlgRep " ++
112− show r ++ "(" ++ show dt ++ ")"
114+ err dt r = modError "toJSON" $ "not AlgRep " ++
115+ show r ++ "(" ++ show dt ++ ")"
113116 -- Encode nullary constructor as a string.
114117 -- Encode non-nullary constructors as an object with the constructor
115118 -- name as the single field and the arguments as the value.
@@ -187,8 +190,9 @@ parseJSON j = parseJSON_generic j
187190 trans
188191 | tyrep == typeOf DT.empty = fromJust . cast . id
189192 | tyrep == typeOf LT.empty = fromJust . cast . LT.fromStrict
190− | tyrep == typeOf "" = fromJust . cast . DT.unpack
191− | otherwise = error "parseJSON: mapAny -- should never happen"
193+ | tyrep == typeOf "" = fromJust . cast . DT.unpack
194+ | otherwise = modError "parseJSON"
195+ "mapAny -- should never happen"
192196 tyrep = typeOf (undefined :: f)
193197 myFail = modFail "parseJSON" $ "bad data: " ++ show j
194198
@@ -199,7 +203,7 @@ parseJSON_generic j = generic
199203 typ = dataTypeOf $ resType generic
200204 generic = case dataTypeRep typ of
201205 AlgRep [] -> case j of
202− Null -> return (error "Empty type")
206+ Null -> return (modError "parseJSON" "empty type")
203207 _ -> modFail "parseJSON" "no-constr bad data"
204208 AlgRep [_] -> decodeArgs (indexConstr typ 1) j
205209 AlgRep _ -> do (c, j') <- getConstr typ j; decodeArgs c j'
@@ -252,15 +256,16 @@ parseJSON_generic j = generic
252256 where f = do modify (+1); return undefined
253257
254258 resType :: MonadPlus m => m a -> a
255− resType _ = error "resType"
259+ resType _ = modError "parseJSON" "resType"
256260
257261modFail :: (Monad m) => String -> String -> m a
258262modFail func err = fail $ "Data.Aeson.Generic." ++ func ++ ": " ++ err
259263
264+modError :: String -> String -> a
265+modError func err = error $ "Data.Aeson.Generic." ++ func ++ ": " ++ err
260266
261−------------------------------------------------------------------------------
262−-- Type extension for binary type constructors
263−------------------------------------------------------------------------------
267+
268+-- Type extension for binary type constructors.
264269
265270-- | Flexible type extension
266271ext2' :: (Data a, Typeable2 t)