Hello,
I’m trying to create a GHC.Generics based parser for JSON objects to a record. The difference between mine and genericParseJSON
provided by Aeson is that I want to treat missing keys in an object different from keys that are null
. That is because in my case values that are absent represent an unchanged value and null
represents an optional (Maybe
) value.
For example, I have these types:
data Diff a = Changed a | Unchanged
data Person = Person { id :: Int, name :: Diff Text, age :: Diff (Maybe Int) }
The Diff
data type is used to represent the missing keys in the JSON object.
Reading up on GHC.Generics, and trying to decipher the code in Aeson.Types.FromJSON
(especially the type classes RecordFromJSON
and RecordFromJSON'
), I came up with the following but it gives me a compile error (see below):
#!/usr/bin/env stack
-- stack --resolver=lts-13.19 script
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
module GenericDiff where
import qualified Data.Text as T
import GHC.Generics
import Type.Reflection
import Data.Aeson (Value, Object, Options, FromArgs(..), fieldLabelModifier, gParseJSON, withObject)
import Data.Aeson.Types
import qualified Data.HashMap.Strict as H
data Diff a = Changed a | Unchanged
genericParseDiff :: (Generic a, ParseJSONDiff (Rep a)) => Options -> Value -> Parser a
genericParseDiff opts v = to <$> withObject "Object diff" (parseJSONDiff opts) v
class ParseJSONDiff f where
parseJSONDiff :: Options -> Object -> Parser (f a)
instance ParseJSONDiff f => ParseJSONDiff (D1 x f) where
parseJSONDiff opts obj = M1 <$> parseJSONDiff @f opts obj
instance ParseJSONDiff f => ParseJSONDiff (C1 x f) where
parseJSONDiff opts obj = M1 <$> parseJSONDiff @f opts obj
instance (ParseJSONDiff a, ParseJSONDiff b) => ParseJSONDiff (a :*: b) where
parseJSONDiff opts obj =
(:*:) <$> parseJSONDiff opts obj
<*> parseJSONDiff opts obj
instance (Selector s, FromJSON a) => ParseJSONDiff (S1 s (K1 i a)) where
parseJSONDiff opts obj = do
fv <- obj .: label
M1 . K1 <$> pure fv -- gParseJSON opts NoFromArgs fv -- <?> Key label
where
label = T.pack $ fieldLabelModifier opts sname
sname = selName (undefined :: M1 _i s _f _p)
instance {-# OVERLAPPING #-} (Selector s) => ParseJSONDiff (S1 s (K1 i (Diff a))) where
parseJSONDiff opts obj =
case H.lookup label obj of
Just fv -> M1 . K1 . Changed <$> gParseJSON opts NoFromArgs fv
Nothing -> M1 . K1 <$> pure Unchanged
where
label = T.pack $ fieldLabelModifier opts sname
sname = selName (undefined :: M1 _i s _f _p)
instance ParseJSONDiff U1 where
parseJSONDiff _ _ = pure U1
GHC’s gives me:
• Couldn't match type ‘a’ with ‘f0 a0’
‘a’ is a rigid type variable bound by
the instance declaration
at .../src/GenericDiff.hs:46:30-81
Expected type: Parser (S1 s (K1 i (Diff a)) a1)
Actual type: Parser (M1 S s (K1 i (Diff (f0 a0))) a1)
I believe that S1
is the same as M1 S
, so the only problem is that I need to get an f a
from my a
. I’m not really sure how to fix this. Any help is much appreciated!