Aeson：具有默认值的仿制药

Question

今天我想解决下一个问题。

假设我们将类型类

DataWithDefault

定义为

class DataWithDefault a where
  defaultValue :: a

我们的数据

Example

定义为

data Example =
  Example { field1 :: Text
          , field2 :: Text
          } deriving (Show)

instance DataWithDefault Example where
  defaultValue = Example "Hello" "World"

instance FromJSON Example where
  parseJSON (Object v) =
    Example <$> v .:? "field1" .!= field1 defaultValue
            <*> v .:? "field2" .!= field2 defaultValue
  parseJSON _ = mzero

instance ToJSON Example where
 toJSON (Example f1 f2)  =
    object [ "field1" .= f1
           , "field2" .= f2
           ]

我知道 Aeson 使用 Generics 自动派生

FromJSON

和

ToJSON

实例，但我不知道如何让它派生

FromJSON

实例，其中未在给定 json 中表示的字段具有默认值。是否可以使用泛型来实现？实际上我不问你最终的解决方案，但也许有一些线索？

更新

让我添加有关该问题的更多信息。

假设现在您需要更新

Example

数据，现在它定义为

data Example =
  Example { field1 :: Text
          , field2 :: Text
          , field3 :: Int
          } deriving (Show)

所以你想更新

DataWithDefault

实例声明

instance DataWithDefault Example where
  defaultValue = Example "Hello" "World" 12

而我想做的不是写

instance FromJSON Example where
  parseJSON (Object v) =
    Example <$> v .:? "field1" .!= field1 defaultValue
            <*> v .:? "field2" .!= field2 defaultValue
            <*> v .:? "field3" .!= field3 defaultValue
  parseJSON _ = mzero

并且想要自动导出这样的实例定义。更重要的是，我不只是为了

Example

，而是为了

DataWithDefault a

。

更新2

组合

.:?

和

.!=

的目的是从给定的 json 中获取尽可能多的字段，并将每个缺失的字段设置为其默认值。所以当我们通过

{ "field1" : "space", "field2" : "ship" }

我希望我的新例子不是

field1 = Hello; field2 = World; field3 = 12

，而是

field1 = space; field2 = ship; field3 = 12

。

Answer 1

不要让 Aeson 这样做，只需使用新类型来实现其设计目的：

newtype DefaultJSON a = DefaultJSON { unDefaultJSON :: a }

instance (FromJSON a, DataWithDefault a) => FromJSON (DefaultJSON a) where
    parseJSON v = DefaultJSON <$> (parseJSON v <|> pure defaultValue)

那么你可以做

> decode "{}" :: Maybe (DefaultJSON Example)
Just (DefaultJSON {unDefaultJSON = (Example {field1 = "Hello", field2 = "World"}})

这与您要求的有点不同，它提供了一个默认值以防解析失败，但不是每个字段的默认值以防单个字段丢失。

Answer 2

使用新的 aeson 并使用一些类型家族魔法可以做到类似的事情：

data ParseStage = InsertDefaults | Final

instance KnownNat num => FromJSON (DefInt num) where
  omittedField = return (DefInt (fromIntegral $ natVal (Proxy :: Proxy num)))
  parseJSON AE.Null = return (DefInt (fromIntegral $ natVal (Proxy :: Proxy num)))
  parseJSON v = DefInt <$> AE.parseJSON v

newtype DefText (x :: Symbol) = DefText T.Text
instance KnownSymbol sym => FromJSON (DefText sym) where
  omittedField = return (DefText (fromString $ symbolVal (Proxy :: Proxy sym)))
  parseJSON AE.Null = return (DefText (fromString $ symbolVal (Proxy :: Proxy sym)))
  parseJSON v = DefText <$> AE.parseJSON v


type family DefJson (m :: ParseStage) a where
  DefJson InsertDefaults a = a
  DefJson Final a = DefToVal a

parserWithDefaults :: forall (o :: ParseStage -> Type) x0 x1. 
    (AE.GFromJSON Zero (Rep (o InsertDefaults))
    , Generic (o InsertDefaults), Generic (o Final)
    , Coercible (Rep (o InsertDefaults) x0) (Rep (o Final) x0)
    ) 
    => AE.Value -> Parser (o Final)
parserWithDefaults v = do
  (dx :: o InsertDefaults) <- AE.genericParseJSON AE.defaultOptions v
  return $ to @_ @x0(coerce (from @_ @x0 dx))

type family DefToVal a :: Type
type instance DefToVal (DefInt a) = Int
type instance DefToVal (DefText a) = T.Text

然后您可以使用默认值定义对象：

data TestObjectT f = TestObject {
    num :: DefJson f (DefInt 16)
  , text :: DefJson f (DefText "hello")
} deriving (Generic)
deriving instance (Show (TestObjectT Final))
type TestObject = TestObjectT Final

instance FromJSON TestObject where
  parseJSON v = parserWithDefaults

现在您甚至可以添加自己的默认值类型，只需添加“DefToVal”类型实例即可。当你测试它时：

ghci> let dstr1 = "{\"num\":20}"
ghci> AE.decode dstr1 :: Maybe TestObject
Just (TestObject {num = 20, text = "hello"})

ghci> let dstr2 = "{}"
ghci> AE.decode dstr2 :: Maybe TestObject
Just (TestObject {num = 16, text = "hello"})

有些事情我无法弄清楚：

• 由于通用表示之间存在往返，因此性能可能会受到一些影响；

  coerce

  似乎不接受直接接受

  Coercible (TestObject InsertDefaults)

  和

  Coercible (TestObject Final)

  ，尽管它们应该是强制的；不过，通过

  Generic

  的路线似乎可行