Requiring type constraints for concrete types when working with higher-kinded data types and Barbies

Given the following data type:

data FormInputH f = FormInputH
  { formNameH :: f Text,
    formEmailH :: f Text,
    formAgeH :: f Int
  }
  deriving stock (Generic)
  deriving anyclass (ApplicativeB, ConstraintsB, FunctorB, TraversableB)

(ApplicativeB etc. come from the barbies library)

I'd like to write an instance for the FromForm type class from http-api-data. It's relatively straightforward to write an instance directly for all f that have an Applicative instance:

instance (Applicative f) => FromForm (FormInputH f) where
  fromForm f = FormInputH
   <$> (pure <$> parseUnique "name" f)
   <*> (pure <$> parseUnique "email" f)
   <*> (pure <$> parseUnique "age" f)

What I'd like to achieve is an equivalent implementation that uses less duplication int he code. For that purpose, I created a value that defines the names of the fields in the form:

formFieldNames :: FormInputH (Const Text)
formFieldNames =
  FormInputH
    (Const "name")
    (Const "email")
    (Const "age")

so that I can write more generic code in the FromForm instance:

instance (Applicative f) => FromForm (FormInputH f) where
  fromForm f = btraverse (\(Const name) -> pure <$> parseUnique name f) formFieldNames

Which doesn't work because

    • Could not deduce (FromHttpApiData a)
        arising from a use of ‘parseUnique’
      from the context: Applicative f
        bound by the instance declaration at src/FormInput.hs:41:10-51
      Possible fix:
        add (FromHttpApiData a) to the context of
          a type expected by the context:
            forall a. Const Text a -> Either Text (f a)

Is it possible to fix that? I kinda feel it's not, mainly because the forall a. in the signature of btraverse seems to not allow this flexibility here.

I tried adding AllBF constraint, but that didn't help

Solution

You can use baddDicts (from the class ConstraintsH).

The function argument of btraverse has type forall a. f a -> e (g a), where f a is the type of each field. You need a FromHttpApiData a constraint, which can only come from f, and this is indeed possible by choosing f to be Product (Dict FromHttpApiData) (Const Text), which you can obtain from baddDicts (provided each field of the record does implement FromHttpApiData).

instance Applicative f => FromForm (FormInputH f) where
  fromForm f = btraverse (\(Pair Dict (Const field)) -> pure <$> parseUnique field f)
    (baddDicts @_ @_ @FromHttpApiData formFieldNames)

Minimal compilable snippet:

{-# LANGUAGE DerivingStrategies, DeriveAnyClass, DeriveGeneric, TypeApplications, FlexibleInstances #-}

module M where

import GHC.Generics
import Barbies
import Data.Functor.Const
import Data.Functor.Product
import Data.Barbie.Constraints

type Text = String

data Form

class FromHttpApiData a where
  parseUnique :: Text -> Form -> Either Text a

instance FromHttpApiData Text
instance FromHttpApiData Int

class FromForm a where
  fromForm :: Form -> Either Text a

data FormInputH f = FormInputH
  { formNameH :: f Text,
    formEmailH :: f Text,
    formAgeH :: f Int
  }
  deriving stock (Generic)
  deriving anyclass (ApplicativeB, ConstraintsB, FunctorB, TraversableB)

formFieldNames :: FormInputH (Const Text)
formFieldNames = FormInputH
  (Const "name")
  (Const "email")
  (Const "age")

instance Applicative f => FromForm (FormInputH f) where
  fromForm f = btraverse (\(Pair Dict (Const field)) -> pure <$> parseUnique field f)
    (baddDicts @_ @_ @FromHttpApiData formFieldNames)