Commits

basvandijk committed 7b31013

Slightly improved performance of generically parsing sums
The BigSum/fromJSON/generic benchmarks goes from 13.6 us to 11.3 us.
Thanks to Twan van Laarhoven for the idea of using Maybe
for the parse result instead of using the parser directly

Comments (0)

Files changed (1)

Data/Aeson/Types/Internal.hs

 --
 -- * 'Data.Aeson.Generic' provides a generic @toJSON@ function that accepts any
 -- type which is an instance of 'Data'.
--- 
+--
 -- * If your compiler has support for the @DeriveGeneric@ and
 -- @DefaultSignatures@ language extensions, @toJSON@ will have a default generic
 -- implementation.
 -- @{-\# LANGUAGE OverloadedStrings #-}
 --
 -- data Coord { x :: Double, y :: Double }
--- 
+--
 -- instance FromJSON Coord where
 --   parseJSON ('Object' v) = Coord    '<$>'
 --                          v '.:' \"x\" '<*>'
     {-# INLINE gParseJSON #-}
 
 instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where
-    gParseJSON (Object (M.toList -> [keyVal])) = gParseSum keyVal
+    gParseJSON (Object (M.toList -> [keyVal@(key, _)])) =
+        case gParseSum keyVal of
+          Nothing -> notFound $ unpack key
+          Just p  -> p
     gParseJSON v = typeMismatch "sum (:+:)" v
     {-# INLINE gParseJSON #-}
 
+notFound :: String -> Parser a
+notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
+{-# INLINE notFound #-}
+
 --------------------------------------------------------------------------------
 
 class ConsFromJSON    f where consParseJSON  ::           Value -> Parser (f a)
 --------------------------------------------------------------------------------
 
 class GFromSum f where
-    gParseSum :: Pair -> Parser (f a)
+    gParseSum :: Pair -> Maybe (Parser (f a))
 
 instance (GFromSum a, GFromSum b) => GFromSum (a :+: b) where
-    gParseSum keyVal = (L1 <$> gParseSum keyVal) <|> (R1 <$> gParseSum keyVal)
+    gParseSum keyVal = (fmap L1 <$> gParseSum keyVal) <|>
+                       (fmap R1 <$> gParseSum keyVal)
     {-# INLINE gParseSum #-}
 
 instance (Constructor c, GFromJSON a, ConsFromJSON a) => GFromSum (C1 c a) where
     gParseSum (key, value)
-        | key == pack (conName (undefined :: t c a p)) = gParseJSON value
-        | otherwise = notFound $ unpack key
+        | key == pack (conName (undefined :: t c a p)) = Just $ gParseJSON value
+        | otherwise = Nothing
     {-# INLINE gParseSum #-}
 
-notFound :: String -> Parser a
-notFound key = fail $ "The key \"" ++ key ++ "\" was not found"
-{-# INLINE notFound #-}
-
 --------------------------------------------------------------------------------
 
 class IsRecord (f :: * -> *) b | f -> b