How to establish an ordering between types in Haskell

Question

I need to establish ordering between * -> * types based on that each member of one type can be represented by another. This is a homomorphism.

The problem is that I can define the transitivity of the !<=! relation, but the type checker cannot figure it out. It is also very ambiguous, Identity !<=! Maybe could be derived from Identity !<=! Maybe or Identity !<=! Identity !<=! Maybe, ... Each derivation comes with a different (but equivalent) definition for repr.

So I'm looking for other ways to create a reflexive and transitive relationship.

{-# LANGUAGE ScopedTypeVariables, TypeOperators, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances, AllowAmbiguousTypes, OverlappingInstances #-}

import Control.Monad.Identity
import Data.Maybe

class x !<=! y where
  repr :: x a -> y a

instance x !<=! x where
  repr = id

instance Identity !<=! Maybe where
  repr = return . runIdentity

instance Maybe !<=! [] where
  repr = maybeToList

instance (x !<=! y, y !<=! z) => x !<=! z where
  repr = r2 . r1
    where r1 :: x a -> y a
          r1 = repr
          r2 :: y a -> z a
          r2 = repr

note: I tried this on GHC 7.8. You may have to remove AllowAmbiguousTypes.

Edit: I would like to do something like repr (Identity 3 :: Identity Int) :: [Int]

Answer 1

The problem is that we can't get GHC to perform a general graph search for instances. In this particular case it would be even nice if GHC could perform a shortest path algorithm, since our function gets slower with each intermediate representation in the path.

However, we can make the search unambiguous at each graph node, by restricting the number of outgoing edges to one, and GHC can handle that. This means that each type has at most one direct representation:

{-# LANGUAGE FlexibleInstances, TypeOperators, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances, OverlappingInstances #-}

import Control.Monad.Identity
import Data.Maybe

class DirectRepr x y | x -> y where
    directRepr :: x a -> y a

We can build a graph with DirectRepr:

instance DirectRepr Identity Maybe where
    directRepr (Identity a) = Just a

instance DirectRepr Maybe [] where
    directRepr = maybeToList

and then walk it with a wrapper class <=:

class x <= y where
    repr :: x a -> y a

instance x <= x where
    repr = id

instance (DirectRepr x y, y <= z) => x <= z where
    repr = repr . directRepr

main = print (repr (Identity ()) :: [()]) -- [()]

It works with cyclic graphs, too, since the search stops when we hit the reflexivity case for <= (thanks to OverlappingInstances):

data A a
data B a
data C a

instance DirectRepr A B where directRepr = undefined 
instance DirectRepr B C where directRepr = undefined
instance DirectRepr C A where directRepr = undefined

foo :: A Int
foo = repr (undefined :: B Int)

If the starting type leads to a cycle, and we don't have the endpoint type in the cycle, the search gets stuck and we get a context overflow. This shouldn't bother us overmuch, since this makes the context overflow error equivalent to a plain "no instance" error.

bar :: Maybe Int -- context overflow
bar = repr (undefined :: A Int)

Answer 2

This may not be possible to do this only by inference. I made another solution using Template Haskell, generating all instances that can be derived from simpler ones. The usage of the library looks like the following:

$(makeMonadRepr ''Identity          ''Maybe                     [e| return . runIdentity |])
$(makeMonadRepr ''Identity          ''IO                        [e| return . runIdentity |])
$(makeMonadRepr ''Maybe             [t| MaybeT IO |]            [e| MaybeT . return |])
$(makeMonadRepr ''IO                [t| MaybeT IO |]            [e| MaybeT . liftM Just |])
$(makeMonadRepr ''Maybe             TH.ListT                    [e| maybeToList |])
$(makeMonadRepr TH.ListT            [t| Trans.ListT IO |]       [e| Trans.ListT . return |])
$(makeMonadRepr ''IO                [t| Trans.ListT IO |]       [e| Trans.ListT . liftM (:[]) |])
$(makeMonadRepr [t| MaybeT IO |]    [t| Trans.ListT IO |]       [e| Trans.ListT . liftM maybeToList . runMaybeT |])

This generates all instances that can be derived from reflexivity or transitivity. After inserting a new node with calling makeMonadRepr all the derivable edges are created, so a structure like this can be extended by the user.

This may not be the most elegant solution, so I'm open for other ideas.