How to model mixins / multiple interfaces in Haskell?

Question

I came across this question on modeling inheritance in Haskell and it reminded me that I have a little more complicated version of the same problem. I\'ll adopt the example from

Answer 1

Perhaps we could take a cue from the underappreciated mtl package, and combine the two previously suggested approaches: declare two type constructors (and make them functors) and declare corresponding typeclasses/instances.

But here's the trick: we will compose the functors using Data.Functor.Compose from transformers, and then define additional "pass-through" instances to make methods from the inner layers available in the outer layer. Just like mtl does for monad transformers!

First, some preliminaries:

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}

import Data.Functor.Compose

data Camera = Camera
data Light = SpotLight | DirectionalLight 
data Object = Monster | Player | NPC

data Vec3 = Vec3C -- dummy type 
data Colour = ColourC -- dummy type

The data definitions:

data Physical a = Physical a Vec3 Vec3 deriving Functor
data Coloured a = Coloured a Colour deriving Functor

The corresponding typeclasses:

class Functor g => FunctorPhysical g where
    vecs :: g a -> (Vec3,Vec3)  

class Functor g => FunctorColoured g where
    colour :: g a -> Colour

The base instances:

instance FunctorPhysical Physical where
    vecs (Physical _ v1 v2) = (v1,v2) 

instance FunctorColoured Coloured where
    colour (Coloured _ c) = c

And now the mtl-inspired trick. Passthrough instances!

instance Functor f => FunctorPhysical (Compose Physical f) where
    vecs (Compose f) = vecs f

instance Functor f => FunctorColoured (Compose Coloured f) where
    colour (Compose f) = colour f

instance FunctorPhysical f => FunctorPhysical (Compose Coloured f) where
    vecs (Compose (Coloured a _)) = vecs a

instance FunctorColoured f => FunctorColoured (Compose Physical f) where
    colour (Compose (Physical a _ _)) = colour a

An example value:

exampleLight :: Compose Physical Coloured Light
exampleLight = Compose (Physical (Coloured SpotLight ColourC) Vec3C Vec3C) 

You should be able to use both vecs and colour with the above value.

EDIT: The above solution has the problem that accessing the original wrapped value is cumbersome. Here is an alternate version using comonads that lets you use extract to get the wrapped value back.

import Control.Comonad
import Control.Comonad.Trans.Class
import Control.Comonad.Trans.Env
import Data.Functor.Identity

data PhysicalT w a = PhysicalT { unPhy :: EnvT (Vec3,Vec3) w a } 

instance Functor w => Functor (PhysicalT w) where
  fmap g (PhysicalT wa) = PhysicalT (fmap g wa)

instance Comonad w => Comonad (PhysicalT w) where
  duplicate (PhysicalT wa) = PhysicalT (extend PhysicalT wa)
  extract (PhysicalT wa) = extract wa

instance ComonadTrans PhysicalT where
  lower = lower . unPhy

--
data ColouredT w a = ColouredT { unCol :: EnvT Colour w a } 

instance Functor w => Functor (ColouredT w) where
  fmap g (ColouredT wa) = ColouredT (fmap g wa)

instance Comonad w => Comonad (ColouredT w) where
  duplicate (ColouredT wa) = ColouredT (extend ColouredT wa)
  extract (ColouredT wa) = extract wa

instance ComonadTrans ColouredT where
  lower = lower . unCol

class Functor g => FunctorPhysical g where
    vecs :: g a -> (Vec3,Vec3)  

class Functor g => FunctorColoured g where
    colour :: g a -> Colour

instance Comonad c => FunctorPhysical (PhysicalT c) where
    vecs = ask . unPhy

instance Comonad c => FunctorColoured (ColouredT c) where
    colour = ask . unCol

-- passthrough instances    
instance (Comonad c, FunctorPhysical c) => FunctorPhysical (ColouredT c) where
    vecs = vecs . lower

instance (Comonad c, FunctorColoured c) => FunctorColoured (PhysicalT c) where
    colour = colour . lower

-- example value
exampleLight :: PhysicalT (ColouredT Identity) Light
exampleLight = PhysicalT . EnvT (Vec3C,Vec3C) $ 
               ColouredT . EnvT ColourC       $ Identity SpotLight

Sadly, it requires even more boilerplate. Personally, I would just use nested EnvT transformers at the cost of less uniform access.