Constraining the argument of a constraint

Question

I have a first typeclass which accepts lists of lists of lists of … of leaf:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
class ListTree leaf t where
  lmap :: (leaf -> leaf) -> t -> t
instance ListTree leaf leaf where lmap f v = f v
instance ListTree leaf t => ListTree leaf [t] where lmap f v = map (lmap f) v

I have a second typeclass which accepts 2-tuples and 3-tuples of a:

class Tups a t where
  tmap :: (a -> a) -> t -> t
instance Tups a (a,a) where tmap f (x,y) = (f x, f y)
instance Tups a (a,a,a) where tmap f (x,y,z) = (f x, f y, f z)

I would like to combine them to describe nested lists ending with 2- or 3-tuples of some leaf type:

class LTTree leaf t where
  ltmap :: (a -> a) -> t -> t
instance (Tups leaf x, ListTree x t) => LTTree leaf t where ltmap f v = lmap (tmap f) v

However, this last piece of code gives me several errors:

Could not deduce (LTTree leaf0 t)
  from the context: LTTree leaf t

In the ambiguity check for ‘ltmap’
  To defer the ambiguity check to use sites, enable AllowAmbiguousTypes

Could not deduce (Tups leaf x0)
  from the context: (Tups leaf x, ListTree x t)

In the ambiguity check for an instance declaration
  To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
  In the instance declaration for ‘LTTree leaf t’

If I add AllowAmbiguousTypes, I still get similar errors.

I can define the LTTree class just fine by inlining the code of the other two typeclasses, though:

class LTTree leaf t where
  ltmap :: (leaf -> leaf) -> t -> t
instance LTTree leaf (leaf,leaf) where ltmap f (x,y) = (f x, f y)
instance LTTree leaf (leaf,leaf,leaf) where ltmap f (x,y,z) = (f x, f y, f z)
instance LTTree leaf t => LTTree leaf [t] where ltmap f v = map (ltmap f)

How can I combine the ListTree leaf t class with the Tups a t class so that the leaves of the tree of lists are 2- or 3-tuples of a? I don't mind adding extra GHC extensions if that can help.

If it matters, my real use case is to model trees of lists where the leaves are row-polymorphic record (using CTRex), where each field in the record is an instance of some typeclass (e.g. Show, to print the trees).

Answer 1

You have another issue. Your ListTree class is useless!

> lmap id [5 :: Integer]
error: blah blah
> lmap id (5 :: Integer)
error: blah blah
> lmap (+2) [[5::Integer], [], [2,3]]
error: blah blah

Add some dark magic to fix this first:

{-# LANGUAGE FunctionalDependencies, GADTs #-}
class ListTree leaf tree where lmap :: (leaf -> leaf) -> (tree -> tree)
instance {-# OVERLAPPABLE #-} (leaf ~ tree) => ListTree leaf tree where -- 1
  lmap = id
instance ListTree leaf tree => ListTree leaf [tree] where -- 2
  lmap = map . lmap

((a ~ b) is an equality constraint; it holds when a and b are the same type. It needs GADTs or TypeFamilies to be used.)

According to the rules of instance resolution, when checking lmap id [5 :: Integer], GHC will come across both instances and find they can both be instantiated: 1 with leaf = [Integer] and tree = [Integer], 2 with leaf = Integer and tree = [Integer]. To pick one, it checks whether the instantiation of 2 is valid for 1. That is: is leaf = Integer, tree = [Integer] a valid instantiation for 1? The answer is yes, because the context with the equality contraint isn't checked until later. Then, it checks for OVERLAPPABLE/OVERLAPPING/OVERLAPS pragmas. OVERLAPPABLE instances get thrown away if there is some better instance around. In this case, 1 is thrown away and only 2 remains. It is used, so lmap id [5 :: Integer] == [5]. The other examples also work.

In LTTree, you have a typo. It should be:

class LTTree leaf tree where ltmap :: (leaf -> leaf) -> tree -> tree

with leaf, not a. You've got another problem: the inferencer is very mad at you for making it do all this work:

> instance (Tups leaf x, ListTree x t) => LTTree leaf t where ltmap f v = lmap (tmap f) v
error: blah blah

Enable ScopedTypeVariables and TypeApplications to help it along:

{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}
instance (Tups leaf x, ListTree x t) => LTTree leaf t where ltmap f v = lmap @x @t (tmap @leaf @x f) v

(or just give types explicitly with ::, but that's painful)

But the better idea is to enable FunctionalDependencies and start spraying them about, because they represent the very idea of type level computation: some subset of the parameters of a typeclass can uniquely determine the others. This produces the final version:

{-# LANGUAGE FlexibleInstances
           , FunctionalDependencies
           , GADTs
           , UndecidableInstances #-}
class ListTree leaf tree | tree -> leaf where lmap :: (leaf -> leaf) -> tree -> tree
instance {-# OVERLAPPABLE #-} (leaf ~ tree) => ListTree leaf tree where lmap = id
instance ListTree leaf tree => ListTree leaf [tree] where lmap = map . lmap
-- The tree determines the leaf

class Tups leaf tree | tree -> leaf where tmap :: (leaf -> leaf) -> tree -> tree
-- Change instances to help type inference along:
instance (a ~ b) => Tups a (a, b) where tmap f (x, y) = (f x, f y)
instance (a ~ b, b ~ c) => Tups a (a, b, c) where tmap f (x, y, z) = (f x, f y, f z)
-- tmap (+2) (5 :: Integer, 3, 2) now works because the type info from 5 spreads out
-- via the equality constraints

class LTTree leaf tree | tree -> leaf where ltmap :: (leaf -> leaf) -> tree -> tree
instance (Tups leaf mid, ListTree mid tree) => LTTree leaf tree where ltmap = lmap . tmap
-- mid can be deduced from tree via ListTree's fundep
-- leaf can be deduced from mid via Tups' fundep
-- leaf can be deduced from tree

And it works!

> ltmap (+(2 :: Integer)) [[[(5, 2)]], [], [[(2, 8), (4, 5)]]]
[[[(7,4)]],[],[[(4,10),(6,7)]]]