On 03/11/11 11:16, Bas van Dijk wrote:
... 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 {-# INLINE gParseSum #-}
notFound :: String -> Parser a notFound key = fail $ "The key \"" ++ key ++ "\" was not found" {-# INLINE notFound #-}
Perhaps relying on Attoparsec backtracking for picking out the right alternative from the sum is the problem. You could try it with Maybe: class GFromSum f where gParseSum :: Pair -> Maybe (Parser (f a)) instance (Constructor c, GFromJSON a, ConsFromJSON a) => GFromSum (C1 c a) where gParseSum (key, value) | key == pack (conName (undefined :: t c a p)) = Just (gParseJSON value) | otherwise = Nothing instance (GFromSum a, GFromSum b) => GFromSum (a :+: b) where gParseSum keyVal = (fmap L1 <$> gParseSum keyVal) <|> (fmap R1 <$> gParseSum keyVal) {-# INLINE gParseSum #-} instance (GFromSum a, GFromSum b) => GFromJSON (a :+: b) where gParseJSON (Object (M.toList -> [keyVal])) | Just p <- gParseSum keyVal -> p gParseJSON v = typeMismatch "sum (:+:)" v Twan