Transform a function with a typeclass constraint into a function taking an explicit typeclass dictionary

Question

It's well known that one way of implementing Haskell typeclasses is via 'typeclass dictionaries'. (This is of course the implementation in ghc, though I make the obligatory remark that Other Implementations are Possible.) To fix ideas, I'll briefly describe how this works. A class declaration like

class (MyClass t) where
  test1 :: t -> t -> t
  test2 :: t -> String
  test3 :: t

can be mechanically transformed into the definition of a datatype like:

data MyClass_ t = MyClass_ {
  test1_ :: t -> t -> t,
  test2_ :: t -> String,
  test3_ :: t,
  }

Then we can mechanically transform each instance declaration into an object of that type; for instance:

instance (MyClass Int) where
  test1 = (+)
  test2 = show
  test3 = 3

turns into

instance_MyClass_Int :: MyClass_ Int
instance_MyClass_Int =  MyClass_ (+) show 3

and similarly a function which has a typeclass constraint can be turned into a function that takes an extra argument; for instance:

my_function :: (MyClass t) => t -> String
my_function val = test2 . test1 test3

turns into

my_function_ :: MyClass_ t -> t -> String
my_function_ dict val = (test2_ dict) . (test1_ dict) (test3_ dict)

The point is that as long as the compiler knows how to fill in these hidden arguments (which is not totally trivial) then you can translate code that uses classes and instances into code that uses only more basic features of the language.

---

With that background, here's my question. I have a module M which defines a bunch of classes and functions with class constraints. M is 'opaque'; I can see what it exports (the equivalent of the .hi file) and I can import from it but I can't see its source code. I want to construct a new module N which basically exports the same things but with the transformation above applied. So for instance if M exported

class (Foo t) where
  example1 :: t -> t -> t
  example2 :: t             -- note names and type signatures visible here
                            -- because they form part of the interface...

instance (Foo String)       -- details of implementation invisible

instance (Foo Bool)         -- details of implementation invisible

my_fn :: (Foo t) => t -> t  -- exported polymorphic fn with class constraint
                            -- details of implementation invisible

N would start like

module N where

import M

data Foo_ t = Foo_ {example1_ :: t-> t -> t, example2_ :: t}

instance_Foo_String :: Foo_ String
instance_Foo_String = Foo_ example1 example2
instance_Foo_Bool   :: Foo_ Bool
instance_Foo_Bool   = Foo_ example1 example2

my_fn_ :: Foo_ t -> t -> t
my_fn_ = ???

And my question is what on earth I can put in place of the ???. In other words, what can I write to extract the 'explicit typeclass' version of the function my_fn from the original? It seems rather tricky, and it's infuriating because we all know that 'under the hood' the module M is basically already exporting something like the my_fn_ which I want to create. (Or at least, it is on GHC.)

Answer 1

For the record, I thought I would explain the 'hacky' solution to this which I already know of. I'll basically illustrate it using a series of examples. So let's imagine we're trying to reify the classes, instances and functions in the following (which consists mostly of pretty standard typeclasses, generally simplified somewhat for the exposition):

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module Src where

import Data.List (intercalate)

class SimpleShow a where
  sshow :: a -> String

class SimpleMonoid a where
  mempty  :: a
  mappend :: a -> a -> a

class SimpleFunctor f where
  sfmap :: (a -> b) -> f a -> f b

instance SimpleShow Int where
  sshow = show

instance SimpleMonoid [a] where
  mempty  = []
  mappend = (++)

instance SimpleMonoid ([a], [b]) where
  mempty  = ([], [])
  mappend (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2)

instance SimpleFunctor [] where
  sfmap = map

There's meant to be some generality in these examples: we have

• 'a' in positive position in the class member
• 'a' in negative position in the class member
• an instance requiring flexible instances
• a higher-kinded type

We leave multi-parameter type families as an exercise! Note that I do believe that what I'm presenting is a completely general, syntactic procedure; I just think it's easier to illustrate with examples than by describing the transformation formally. Anyway, let's suppose we've got the following functions to process:

show_2lists :: (SimpleShow a) => [a] -> [a] -> String
show_2lists as1 as2 = "[" ++ intercalate ", " (map sshow as1) ++ "]/["
                      ++ intercalate ", " (map sshow as2) ++ "]"

mconcat :: (SimpleMonoid a) => [a] -> a
mconcat = foldr mappend mempty

example :: (SimpleMonoid (x, y)) => [(x, y)] -> (x, y)
example = foldr mappend mempty

lift_all :: (SimpleFunctor f) => [a -> b] -> [f a -> f b]
lift_all = map sfmap

Then the actual reification looks like:

{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE FlexibleInstances #-}

module Main where

import Unsafe.Coerce
import Src

data Proxy k = Proxy

class Reifies s a | s -> a where
  reflect :: proxy s -> a

newtype Magic a r = Magic (forall (s :: *). Reifies s a => Proxy s -> r)

reify :: forall a r. a -> (forall (s :: *). Reifies s a => Proxy s -> r) -> r
reify a k = unsafeCoerce (Magic k :: Magic a r) (const a) Proxy
{-# INLINE reify #-}


data SimpleShow_    a = SimpleShow_    {sshow_  :: a -> String}
data SimpleMonoid_  a = SimpleMonoid_  {mempty_ :: a,
                                        mappend_ :: a -> a -> a}
data SimpleFunctor_ f = SimpleFunctor_ {
  sfmap_  :: forall a b. (a -> b) -> (f a -> f b)
  }

instance_SimpleShow_Int :: SimpleShow_ Int
instance_SimpleShow_Int = SimpleShow_ sshow

instance_SimpleMonoid_lista :: SimpleMonoid_ [a]
instance_SimpleMonoid_lista =  SimpleMonoid_ mempty mappend

instance_SimpleMonoid_listpair :: SimpleMonoid_ ([a], [b])
instance_SimpleMonoid_listpair =  SimpleMonoid_ mempty mappend

instance_SimpleFunctor_list :: SimpleFunctor_ []
instance_SimpleFunctor_list = SimpleFunctor_ sfmap

---------------------------------------------------------------------
--code to reify show_2lists :: (SimpleShow a) => [a] -> [a] -> String

-- for each type variable that occurs in the constraints, we must
-- create a newtype. Here there is only one tpye variable ('a') so we
-- create one newtype.
newtype Wrap_a a s  = Wrap_a { extract_a :: a }

-- for each constraint, we must create an instance of the
-- corresponding typeclass where the instance variables have been
-- replaced by the newtypes we just made, as follows.
instance Reifies s (SimpleShow_ a) => SimpleShow (Wrap_a a s) where
  --sshow :: (Wrap_ a s) -> String
  sshow = unsafeCoerce sshow__
    where sshow__ :: a -> String
          sshow__ = sshow_ $ reflect (undefined :: [] s)

-- now we can reify the main function
show_2lists_ :: forall a. SimpleShow_ a -> [a] -> [a] -> String
show_2lists_ dict = let
  magic :: forall s. ([Wrap_a a s] -> [Wrap_a a s] -> String)
           -> Proxy s -> ([a] -> [a] -> String)
  magic v _ arg1 arg2 = let
    w_arg1 :: [Wrap_a a s]
    w_arg1 =  unsafeCoerce (arg1 :: [a])

    w_arg2 :: [Wrap_a a s]
    w_arg2 =  unsafeCoerce (arg2 :: [a])

    w_ans :: String
    w_ans = v w_arg1 w_arg2

    ans   :: String
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic show_2lists)

---------------------------------------------------------------------
--code to reify mconcat :: (SimpleMonoid a) => [a] -> a

-- Here the newtypes begin with Wrap1 to avoid name collisions with
-- the ones above
newtype Wrap1_a a s  = Wrap1_a { extract1_a :: a }
instance Reifies s (SimpleMonoid_ a) => SimpleMonoid (Wrap1_a a s) where
  --mappend :: (Wrap1_a a s) -> (Wrap1_a a s) -> (Wrap1_a a s)
  mappend = unsafeCoerce mappend__
    where mappend__ :: a -> a -> a
          mappend__ =  (mappend_ $ reflect (undefined :: [] s))
  --mempty  :: (Wrap1_a a s)
  mempty = unsafeCoerce mempty__
    where mempty__  :: a
          mempty__  =  (mempty_  $ reflect (undefined :: [] s))

mconcat_ :: forall a. SimpleMonoid_ a -> [a] -> a
mconcat_ dict = let
  magic :: forall s. ([Wrap1_a a s] -> (Wrap1_a a s)) -> Proxy s -> ([a] -> a)
  magic v _ arg1 = let
    w_arg1 :: [Wrap1_a a s]
    w_arg1 =  unsafeCoerce (arg1 :: [a])

    w_ans :: Wrap1_a a s
    w_ans = v w_arg1

    ans   :: a
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic mconcat)

---------------------------------------------------------------------
--code to reify example :: (SimpleMonoid (x, y)) => [(x, y)] -> (x, y)

newtype Wrap2_x x s  = Wrap2_x { extract2_x :: x }
newtype Wrap2_y y s  = Wrap2_y { extract2_y :: y }
instance Reifies s (SimpleMonoid_ (x, y))
         => SimpleMonoid (Wrap2_x x s, Wrap2_y y s) where
  --mappend :: (Wrap2_x x s, Wrap2_y y s) -> (Wrap2_x x s, Wrap2_y y s)
  --                 -> (Wrap2_x x s, Wrap2_y y s)
  mappend = unsafeCoerce mappend__
    where mappend__ :: (x, y) -> (x, y) -> (x, y)
          mappend__ =  (mappend_ $ reflect (undefined :: [] s))
  --mempty  :: (Wrap2_x x s, Wrap2_y y s)
  mempty = unsafeCoerce mempty__
    where mempty__  :: (x, y)
          mempty__  =  (mempty_  $ reflect (undefined :: [] s))

example_ :: forall x y. SimpleMonoid_ (x, y) -> [(x, y)] -> (x, y)
example_ dict = let
  magic :: forall s. ([(Wrap2_x x s, Wrap2_y y s)] -> (Wrap2_x x s, Wrap2_y y s))
           -> Proxy s -> ([(x, y)] -> (x, y))
  magic v _ arg1 = let
    w_arg1 :: [(Wrap2_x x s, Wrap2_y y s)]
    w_arg1 =  unsafeCoerce (arg1 :: [(x, y)])

    w_ans :: (Wrap2_x x s, Wrap2_y y s)
    w_ans = v w_arg1

    ans   :: a
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic mconcat)

---------------------------------------------------------------------
--code to reify lift_all :: (SimpleFunctor f) => [a -> b] -> [f a -> f b]

newtype Wrap_f f s d = Wrap_f { extract_fd :: f d}
instance Reifies s (SimpleFunctor_ f) => SimpleFunctor (Wrap_f f s) where
  --sfmap :: (a -> b) -> (Wrap_f f s a -> Wrap_f f s b)
  sfmap = unsafeCoerce sfmap__
    where sfmap__ :: (a -> b) -> (f a -> f b)
          sfmap__ = sfmap_ $ reflect (undefined :: [] s)

lift_all_ :: forall a b f. SimpleFunctor_ f -> [a -> b] -> [f a -> f b]
lift_all_ dict = let
  magic :: forall s. ([a -> b] -> [Wrap_f f s a -> Wrap_f f s b])
           -> Proxy s -> ([a -> b] -> [f a -> f b])
  magic v _ arg1 = let
    w_arg1 :: [a -> b]
    w_arg1 =  unsafeCoerce (arg1 :: [a -> b])

    w_ans :: [Wrap_f f s a -> Wrap_f f s b]
    w_ans = v w_arg1

    ans   :: [f a -> f b]
    ans   = unsafeCoerce w_ans
    in ans

  in (reify dict $ magic lift_all)

main :: IO ()
main = do
  print (show_2lists_ instance_SimpleShow_Int     [3, 4] [6, 9])
  print (mconcat_     instance_SimpleMonoid_lista [[1, 2], [3], [4, 5]])
  print (example_     instance_SimpleMonoid_listpair
                                     [([1, 2], ["a", "b"]), ([4], ["q"])])
  let fns' :: [[Int] -> [Int]]
      fns' = lift_all_ instance_SimpleFunctor_list [\ x -> x+1, \x -> x - 1]
  print (map ($ [5, 7]) fns')


{- output:

"[3, 4]/[6, 9]"
[1,2,3,4,5]
([1,2,4],["a","b","q"])
[[6,8],[4,6]]

-}

Note that we use a lot of unsafeCoerce, but always relating two types that differ only in the presence of a newtype. Since the run time representations are identical, this is ok.

Answer 2

What you seem to be asking for is known as "local instances". This would mean that you could write something like:

my_fn_ :: forall t. Foo_ t -> t -> t
my_fn_ fooDict = let instance fooDict :: Foo t
                 in my_fn

Local instances are a natural extension of type classes. They were even standard in the formalism of Wadler and Blott's paper "How to make ad hoc polymorphism less ad hoc". However, they are problematic because they break a property known as principal types. Additionally, they may also break assumptions that there is only ever a single instance of a certain constraint for a specific type (like e.g. Data.Map's assumption about Ord instances). The first problem could be solved by requiring additional type annotations in a local instance and the latter is related to the controversial "orphan instances", which cause a similar problem.

Another relevant paper is Kiselyov and Shan's "Functional pearl: implicit configurations", which contains a variety of type system tricks to simulate local type instances although it doesn't really apply to your situation (pre-existing type class), IIRC.

Answer 3

This isn't a solution in general, but only for some special cases.

There is a hacky way to do this for class methods of a class C t that have the type parameter t appearing in a negative position in their type. e.g., example1 :: Foo t => t -> t -> t is ok, but not example2 :: Foo t => t.

The trick is to create a wrapper data type Wrapper t which comprises the explicit dictionary methods on t paired with a t value, and which has a Foo instance that exploits the appropriate wrapped dictionary methods, e.g.

 data Wrapper x = Wrap {example1__ :: (x -> x -> x), val :: x}

 instance Foo (Wrapper x) where
     example1 (Wrap example1__ x) (Wrap _ y) = Wrap example1__ (example1__ x y) 

 my_fn_ :: Foo_ t -> t -> t
 my_fn_ (Foo_ example1_ example2_) x = val $ my_fn (Wrap example1_ x)

Something tells me this is probably not the solution you are looking for though- it is not general purpose. In the example here, we cannot do anything with example2 because it has no negative occurrence of t with which to "sneak" functions inside. For your example, this means that my_fn in module M can use only example1.