Как я могу написать экземпляры aeson ToJSON для типов с видом (* -> *) -> * - PullRequest
0 голосов
/ 24 июня 2018

Мотивация

У меня есть тип, MyType, который параметризуется функтором, f.

Я хочу использовать MyType Identity для представления "моего взгляда" наданные и MyType Maybe для представления типа обновлений к данным.

Задача

Можно ли написать экземпляр aeson ToJSON для MyType?Я пытался использовать класс ToJSON, но я получаю сообщение об ошибке (см. Нижнюю часть поста).

{-# 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")

Как я могу получить экземпляр ToJSON для 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.

1 Ответ

0 голосов
/ 24 июня 2018

Используя мою идею в комментарии об использовании класса 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 - это синтаксис приложения типа .
  • Я использовал genericToJSON defaultOptions, просматривая реализацию по умолчанию для toJSON. Нам просто нужно было вручную ввести некоторые экземпляры в область действия с помощью lifting.

Надеюсь, это поможет.

...