如何为类型(* -> *) -> *编写aeson ->实例？

Question

动机

我有一个类型，MyType，它是由函子f参数化的。

我希望使用MyType Identity来表示数据的“我的视图”，使用MyType Maybe来表示数据的更新类型。

问题

是否有可能为ToJSON编写一个伊索MyType实例？我试着使用ToJSON类，但是我得到了一个错误(参见post的底部)。

{-# LANGUAGE DeriveGeneric #-}
module Main where

import GHC.Generics
import Data.Aeson

data MyType f = MyType
  { age  :: f Int
  , name :: f String
  } deriving(Generic)

instance ToJSON1 f => ToJSON (MyType f)

main :: IO ()
main = print . encode $ MyType (Just 1) (Just "hi")

如何获得MyType f的MyType f实例和任意f的实例

编译错误

Main.hs:12:10: error:
    • Could not deduce (ToJSON (f String))
        arising from a use of ‘aeson-1.2.4.0:Data.Aeson.Types.ToJSON.$dmtoJSON’
      from the context: ToJSON1 f
        bound by the instance declaration
        at Main.hs:12:10-39
    • In the expression:
        aeson-1.2.4.0:Data.Aeson.Types.ToJSON.$dmtoJSON @MyType f
      In an equation for ‘toJSON’:
          toJSON = aeson-1.2.4.0:Data.Aeson.Types.ToJSON.$dmtoJSON @MyType f
      In the instance declaration for ‘ToJSON (MyType f)’
   |
12 | instance ToJSON1 f => ToJSON (MyType f)
   |          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed, no modules loaded.

Answer 1

在使用Lifting类的评论中使用了我的想法，经过一些修改之后，我得出了以下结论

{-# LANGUAGE DeriveGeneric
           , FlexibleContexts   
           , MultiParamTypeClasses
           , ScopedTypeVariables
           , TypeApplications
           , UndecidableInstances 
           #-}
module Main where

import GHC.Generics
import Data.Aeson
import Data.Constraint
import Data.Constraint.Lifting

data MyType f = MyType
  { age  :: f Int
  , name :: f String
  } deriving(Generic)

instance (Lifting ToJSON f) => ToJSON (MyType f) where
    toJSON mt
        | Sub Dict <- lifting @ToJSON @f @Int
        , Sub Dict <- lifting @ToJSON @f @String
            = genericToJSON defaultOptions mt

instance Lifting ToJSON Maybe where
    lifting = Sub Dict

main :: IO ()
main = print . encode $ MyType (Just 1) (Just "hi")

备注：

• Dict在约束(如ToJSON Int)和值之间来回转换。Sub只是约束包含的构造函数。
• lifting @ToJSON @f @Int是类型应用程序语法。
• 我通过查找默认实现 for toJSON来使用toJSON。我们只需要首先用lifting手动地将一些实例放到范围内。

我希望这能帮到你。