What options are available for making typeclasses that have instances for types with varying numbers of type parameters? I have found two possible ways to do this (details below), neither seems particularly clean, so I’m wondering if there are other options to consider.
Example code
I have several types that collectively define an AST (for this example, a very trimmed down and simplified AST), where all the types have a type parameter ann :: * -> *
that lets me wrap each layer of the AST in a functor:
newtype Expr ann var = FixExpr { unFixExpr :: ann (ExprF var (Type ann) (Expr ann var)) }
newtype Type ann = FixType { unFixType :: ann (TypeF (Type ann)) }
newtype Decl ann doc var = Decl (ann (Maybe doc, Maybe (Type ann), Expr ann var))
newtype Module ann = Module [Decl ann String String]
Then I have some functions that can change the ann
type:
{-# LANGUAGE Rank2Types #-}
convertExpr :: Functor ann1 => (forall x. ann1 x -> ann2 x) -> Expr ann1 var -> Expr ann2 var
convertType :: Functor ann1 => (forall x. ann1 x -> ann2 x) -> Type ann1 -> Type ann2
convertDecl :: Functor ann1 => (forall x. ann1 x -> ann2 x) -> Decl ann1 doc var -> Decl ann2 doc var
convertModule :: Functor ann1 => (forall x. ann1 x -> ann2 x) -> Module ann1 -> Module ann2
(full compiling code: https://repl.it/repls/SuperficialNauticalPortablesoftware)
Goal
I’d like to have a single convert
function to replace the 4 separate convert*
functions.
Solution 1 (ugly typeclass)
I was able to define a typeclass like this:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
class Convert ann1 ann2 v1 v2 where
convert :: (forall x. ann1 x -> ann2 x) -> v1 -> v2
with instances like this:
instance Functor ann1 => Convert ann1 ann2 (Expr ann1 var) (Expr ann2 var)
(full compiling code: https://repl.it/repls/WarmQuintessentialKeygen)
Solution 2 (too restrictive)
If I reorder the parameters of all my AST types so that the ann
parameter is last, I can define what seems to me to be a more normal typeclass:
class Convert t where
convert :: Functor ann1 => (forall x. ann1 x -> ann2 x) -> t ann1 -> t ann2
with instances like this:
instance Convert (Expr var)
(full compiling code: https://repl.it/repls/ExcitingSlimApplicationsuite)
Questions
- “Solution 1” (above) seems unfortunate in that the typeclass requires four parameters – is there a simpler way to do this? (Also when I’ve made typeclasses like this in the past, I’ve tended to run into a lot of confusing issues with “ambiguous type variable”, making me think that this is a path best avoided – is this actually a good path to pursue?)
- “Solution 2” (above) restricts all my types to having
ann
be the last type parameter, meaning if I wanted some other typeclass that, say, changed thevar
type of the AST, I’d have to choose whether to use this approach forann
or forvar
and use a different solution for the other. Is there a way to avoid this restriction? - I tried playing around with 1) newtype, 2) type families (specifically, associated type synonyms), and 3) PolyKinds, but wasn’t able to come up with any alternate solutions using those features. Are there any useful approaches to this problem beyond the two solutions I described above?
Any pointers on what my best options are would be appreciated, thanks!