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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
