CODEWITHSUNDEEP
haskellaeson
statusfailed
statusfailed

Reputation: 900

How do I write aeson ToJSON instances for types with kind (* -> *) -> *

Motivation

I have a type, MyType, which is parametrised by a functor, f.

I want to use MyType Identity to represent "my view" of the data, and MyType Maybe to represent the type of updates to the data.

Problem

Is it possible to write an aeson ToJSON instance for MyType? I tried to use the ToJSON class, but I get an error (see bottom of 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")

How can I get a ToJSON instance for MyType f, for an arbitrary f?

Compilation error

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.

Upvotes: 3

Views: 552

Answers (1)

luqui
luqui

Reputation: 60463

Using my idea in the comment of exploiting the Lifting class, and after some tinkering I arrived at this

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

Notes:

  • Dict converts back and forth between constraints (such as ToJSON Int) and values. Sub is just the constructor for constraint entailment.
  • lifting @ToJSON @f @Int is type application syntax.
  • I used genericToJSON defaultOptions by looking up the default implementation for toJSON. We just needed to manually bring some instances into scope with lifting first.

I hope this helps.

Upvotes: 2

Related Questions