type-class and subclasses

I have a general question: I would like to have a type-class C in which types that are instances of C have some type parameters and then a subclass S of C where some of the type parameters of an instance of S are more constrained in some way -- perhaps by being equal and/or being instances of some other class. I have an entirely artificial example (att.) that illustrates this situation and struggled (it's a while since I wrote much Haskell) to get it past the ghc type checker until stumbling across GADTs which do seem to do the trick, so I could leave it at that but... ...I am very far from sure that this is the correct way to look at the problem and am hoping for some illumination. regards Lloyd. -- No AI was used in composing this message.

Hi!
I am not doing too much type-fu, but I think you can pull the type
variables into the class definitions so you can access them for adding
constraints when defining the instances. Then, you do not need any
special extension (GHC2021). I hope this helps! (I also separated your
Pair class into the Pair and CombinablePair classes).
Dominik
import Prelude hiding (fst, snd)
class Pair pt u v where
fst :: pt u v -> u
snd :: pt u v -> v
class CombinablePair pt u v w where
f :: pt u v -> pt v w -> pt u w
class (Pair pt u v, Num u, u ~ v) => PairNum pt u v where
total :: pt u v -> u
--------
-- Ptype
data Ptype u v = ConsPtype !u !v deriving (Show)
instance Pair Ptype u v where
fst (ConsPtype x _) = x
snd (ConsPtype _ y) = y
instance CombinablePair Ptype u v w where
f (ConsPtype a _) (ConsPtype _ d) = ConsPtype a d
fromPairNum :: (Pair pt u v) => pt u v -> Ptype u v
fromPairNum pn = ConsPtype (fst pn) (snd pn)
---------
-- PNtype
data PNtype u v = (Num u, Num v) => ConsPNtype !u !v
instance Pair PNtype u v where
fst (ConsPNtype x _) = x
snd (ConsPNtype _ y) = y
instance (u ~ v, v ~ w) => CombinablePair PNtype u v w where
f (ConsPNtype a b) (ConsPNtype c d) = ConsPNtype (a + c) (b + d)
instance (Num u, u ~ v) => PairNum PNtype u v where
total (ConsPNtype x y) = x + y
lloyd allison
I have a general question: I would like to have a type-class C in which types that are instances of C have some type parameters and then a subclass S of C where some of the type parameters of an instance of S are more constrained in some way -- perhaps by being equal and/or being instances of some other class.
I have an entirely artificial example (att.) that illustrates this situation and struggled (it's a while since I wrote much Haskell) to get it past the ghc type checker until stumbling across GADTs which do seem to do the trick, so I could leave it at that but... ...I am very far from sure that this is the correct way to look at the problem and am hoping for some illumination.
regards Lloyd.

GADTs does indeed resolve the issue in this specific case, as in that case the constructor carries the evidence of the equality constraint. However if we for example wanted to add a constructor method to your pair class: class Pair pt where -- … mkPair :: u -> v -> pt u v then it would no longer work, as you no longer have a pt in the arguments that carries the equality proof between u and v. If you want it to work in that case, then one option is that you could add a constraint-kinded type parameter to your class, which lets instances specify custom constraints to the type variables: class Pair c pt where mkPair :: c u v => u -> v -> pt u v instance Pair (~) Ptype where -- … this can however lead to issues with ambiguous types, since users of the type class methods needs to know the constraint to decide which instance to use. We can resolve this either using functional dependencies or type families: class PairFunDep c pt | pt -> c where mkPair :: c u v => u -> v -> pt u v instance PairFunDep (~) Ptype where -- … class PairTypeFam pt where type PairConstraint pt :: u -> v -> Constraint mkPair :: PairConstraint pt u v => u -> v -> pt u v instance PairTypeFam Ptype where type PairConstraint Ptype u v = u ~ v -- … Regards, Anka
On 10 Apr 2025, at 04:33, lloyd allison
wrote: I have a general question: I would like to have a type-class C in which types that are instances of C have some type parameters and then a subclass S of C where some of the type parameters of an instance of S are more constrained in some way -- perhaps by being equal and/or being instances of some other class. I have an entirely artificial example (att.) that illustrates this situation and struggled (it's a while since I wrote much Haskell) to get it past the ghc type checker until stumbling across GADTs which do seem to do the trick, so I could leave it at that but... ...I am very far from sure that this is the correct way to look at the problem and am hoping for some illumination.
regards Lloyd. -- No AI was used in composing this message.
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
participants (3)
-
Andreas Källberg
-
Dominik Schrempf
-
lloyd allison