haskellgenericstypeclassfunctional-dependencies

Why doesn't my type class satisfy the functional dependency?


I tried to create a method for stripping away the Meta information of a generic Rep. While creating a type class and writing instances for every used Rep type, I came across an error saying that two of the instances (:+:, M1) didn't satisfy the functional dependency. I don't understand this.

This is my code:

{-# LANGUAGE FunctionalDependencies #-}
module Generics where
import GHC.Generics

class WithoutMeta f f' | f -> f' where
  withoutMeta :: f p -> f' p

instance WithoutMeta V1 V1 where
  withoutMeta = id

instance WithoutMeta U1 U1 where
  withoutMeta = id

instance (WithoutMeta f f', WithoutMeta g g') => WithoutMeta (f :+: g) (f' :+: g') where
  withoutMeta (L1 l) = L1 $ withoutMeta l
  withoutMeta (R1 r) = R1 $ withoutMeta r

instance (WithoutMeta f f', WithoutMeta g g') => WithoutMeta (f :*: g) (f' :*: g') where
  withoutMeta (f :*: g) = withoutMeta f :*: withoutMeta g

instance WithoutMeta (K1 i a) (K1 i a) where
  withoutMeta = id

instance WithoutMeta f f' => WithoutMeta (M1 i c f) f' where
  withoutMeta (M1 f) = withoutMeta f

Solution

  • I tried to switch from fundeps to type families and it seems to compile. Type families are more readable to me.

    {-# LANGUAGE TypeFamilies #-}
    
    import GHC.Generics
    import Data.Kind
    
    class WithoutMeta f where
      type WM f :: Type -> Type
      withoutMeta :: f p -> WM f p
    
    instance WithoutMeta V1 where
      type WM V1 = V1
      withoutMeta = id
    
    instance WithoutMeta U1 where
      type WM U1 = U1
      withoutMeta = id
    
    instance (WithoutMeta f, WithoutMeta g) => WithoutMeta (f :+: g) where
      type WM (f :+: g) = (WM f :+: WM g)
      withoutMeta (L1 l) = L1 $ withoutMeta l
      withoutMeta (R1 r) = R1 $ withoutMeta r
    
    instance (WithoutMeta f, WithoutMeta g) => WithoutMeta (f :*: g) where
      type WM (f :*: g) = (WM f :*: WM g)
      withoutMeta (f :*: g) = withoutMeta f :*: withoutMeta g
    
    instance WithoutMeta (K1 i a) where
      type WM (K1 i a) = (K1 i a)
      withoutMeta = id
    
    instance WithoutMeta f => WithoutMeta (M1 i c f) where
      type WM (M1 i c f) = WM f
      withoutMeta (M1 f) = withoutMeta f
    

    If you want to keep fundeps, you can try turning on UndecidableInstances. Without that, it looks like your code does not satisfy the GHC coverage condition that ensures termination.