Is the dispatch of a Haskell TypeClass dynamic? - haskell

Given the following Haskell code snapshot:
class Foo a where
bar :: a -> ...
quux :: a -> ...
...
Where the value of a is determined at runtime - the class dispatches on this value.
I'm assuming that the compiler can statically check the types at compile-time, and ensure that no invalid types can dispatch on it.
Now if we compare this to a dynamic dispatch in Java:
interface Flippable {
Flippable flip();
}
class Left implements Flippable {
Right flip();
}
class Right implements Flippable {
Left flip();
}
class Demo {
public static void main(String args[]) {
Flippable flippable = new Right();
System.out.println(flippable.flip);
}
}
Assumptions:
Haskell can dispatch on return type as well as multiple arguments making dispatch different to other languages.
My question is: Is the dispatch of a Haskell TypeClass dynamic?

If your code is Haskell 2010, with no language extensions turned on, Haskell actually doesn't support run-time polymorphism at all!
That's quite surprising. Haskell feels like a very polymorphic language. But in fact, all the types can in principle be decided purely at compile-time. (GHC chooses not to, but that's an implementation detail.)
This is exactly the same situation as C++ templates. When you write something like std::vector<int>, the compiler knows, at compile-time, all the times involved. The really surprising thing is just how rarely you actually need true run-time polymorphism!
Now, there are scenarios where you want to run different code based on run-time circumstances. But in Haskell, you can do that just by passing a function as an argument; you don't need to create a "class" (in the OOP sense) merely to achieve this.
Now, if you turn on some language extensions (most conspicuously ExistentialQuantification) then you get true, run-time polymorphism.
Note that the main reason people seem to do this is so you can do
class Foo f where
bar :: f -> Int
baz :: f -> Bool
data AnyFoo = forall f. Foo => AnyFoo f
my_list :: [AnyFoo]
...
This is widely considered a Haskell anti-pattern. In particular, if you upcast stuff in Java to put it into a list, you then later downcast it again. But the code above offers no possibility to ever downcast. You also can't use run-time reflection (since Haskell doesn't have that either). So really, if you have a list of AnyFoo, the only thing you can do with it is call foo or bar on it. So... why not just store the result of foo and bar?
data AnyFoo = AnyFoo {foo :: Int, bar :: Bool}
It lets you do exactly the same stuff, but doesn't require any non-standard extensions. In fact, in some ways, it's actually a bit more flexible. You now don't even need a Foo class, you don't need to define a new type for every sort of Foo you might have, just a function that constructs the AnyFoo data structure for it.

It depends what you mean by "dynamic" dispatch. There aren't subtyping in haskell, so your Java example is hard to translate.
In situation when you have type class, say Show and want to put different elements into the list, you can use existential quantification:
{-# LANGUAGE ExistentialQuantification #-}
data Showable = forall a. Show a => Showable a
instance Show Showable where
show (Showable x) = show x
test :: main ()
test = let list = [Showable True, Showable "string"]
in print list
-- >>> test
-- [True,"string"]
Here you can say that dispatch happens "dynamically". It happens in the same way as in C++ or Java. The Show dictionary is carried with an object, like a vtable in C++ (or class definition ptr in Java, dunno how it's called).
Yet, as #MathematicalOrchid explained, this is an anti-pattern.
Yet if you want to flip from Left to Right and back, you can state that in type class definition.
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FunctionalDependencies #-}
class Flippable a b | a -> b where
flip' :: Flippable b a => a -> b
newtype INL = INL Int deriving Show
newtype INR = INR Int deriving Show
instance Flippable INL INR where
flip' (INL x) = INR x
instance Flippable INR INL where
flip' (INR x) = INL x
-- >>> flip' $ INL 1
-- INR 1
-- >>> flip' $ flip' $ INL 1
-- INL 1
In this case flip' calls are resolved already at compile-time.
You could have have class Flip a where flip' :: a -> Flippable using existential quantification too. Then consecutive calls will be dispatched dynamically. As always, it depends on your needs.
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE StandaloneDeriving #-}
class Flip a where
flip' :: a -> Flippable
-- Show is only for repl purposes
data Flippable = forall a. (Flip a, Show a) => Flippable a
deriving instance Show Flippable
instance Flip Flippable where
flip' (Flippable x) = flip' x
newtype INL = INL Int deriving Show
newtype INR = INR Int deriving Show
instance Flip INL where
flip' (INL x) = Flippable (INR x)
instance Flip INR where
flip' (INR x) = Flippable (INL x)
-- >>> flip' $ flip' $ flip' $ INL 1
-- Flippable (INR 1)
Hopefully this answers your question.

Related

How to 'show' unshowable types?

I am using data-reify and graphviz to transform an eDSL into a nice graphical representation, for introspection purposes.
As simple, contrived example, consider:
{-# LANGUAGE GADTs #-}
data Expr a where
Constant :: a -> Expr a
Map :: (other -> a) -> Expr a -> Expr a
Apply :: Expr (other -> a) -> Expr a -> Expr a
instance Functor Expr where
fmap fun val = Map fun val
instance Applicative Expr where
fun_expr <*> data_expr = Apply fun_expr data_expr
pure val = Constant val
-- And then some functions to optimize an Expr AST, evaluate Exprs, etc.
To make introspection nicer, I would like to print the values which are stored inside certain AST nodes of the DSL datatype.
However, in general any a might be stored in Constant, even those that do not implement Show. This is not necessarily a problem since we can constrain the instance of Expr like so:
instance Show a => Show (Expr a) where
...
This is not what I want however: I would still like to be able to print Expr even if a is not Show-able, by printing some placeholder value (such as just its type and a message that it is unprintable) instead.
So we want to do one thing if we have an a implementing Show, and another if a particular a does not.
Furthermore, the DSL also has the constructors Map and Apply which are even more problematic. The constructor is existential in other, and thus we cannot assume anything about other, a or (other -> a). Adding constraints to the type of other to the Map resp. Apply constructors would break the implementation of Functor resp. Applicative which forwards to them.
But here also I'd like to print for the functions:
a unique reference. This is always possible (even though it is not pretty as it requires unsafePerformIO) using System.Mem.StableName.
Its type, if possible (one technique is to use show (typeOf fun), but it requires that fun is Typeable).
Again we reach the issue where we want to do one thing if we have an f implementing Typeable and another if f does not.
How to do this?
Extra disclaimer: The goal here is not to create 'correct' Show instances for types that do not support it. There is no aspiration to be able to Read them later, or that print a != print b implies a != b.
The goal is to print any datastructure in a 'nice for human introspection' way.
The part I am stuck at, is that I want to use one implementation if extra constraints are holding for a resp. (other -> a), but a 'default' one if these do not exist.
Maybe type classes with FlexibleInstances, or maybe type families are needed here? I have not been able to figure it out (and maybe I am on the wrong track all together).
Not all problems have solutions. Not all constraint systems have a satisfying assignment.
So... relax the constraints. Store the data you need to make a sensible introspective function in your data structure, and use functions with type signatures like show, fmap, pure, and (<*>), but not exactly equal to them. If you need IO, use IO in your type signature. In short: free yourself from the expectation that your exceptional needs fit into the standard library.
To deal with things where you may either have an instance or not, store data saying whether you have an instance or not:
data InstanceOrNot c where
Instance :: c => InstanceOrNot c
Not :: InstanceOrNot c
(Perhaps a Constraint-kinded Either-alike, rather than Maybe-alike, would be more appropriate. I suspect as you start coding this you will discover what's needed.) Demand that clients that call notFmap and friends supply these as appropriate.
In the comments, I propose parameterizing your type by the constraints you demand, and giving a Functor instance for the no-constraints version. Here's a short example showing how that might look:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
import Data.Kind
type family All cs a :: Constraint where
All '[] a = ()
All (c:cs) a = (c a, All cs a)
data Lol cs a where
Leaf :: a -> Lol cs a
Fmap :: All cs b => (a -> b) -> Lol cs a -> Lol cs b
instance Functor (Lol '[]) where
fmap f (Leaf a) = Leaf (f a)
fmap f (Fmap g garg) = Fmap (f . g) garg
Great timing! Well-typed recently released a library which allows you to recover runtime information. They specifically have an example of showing arbitrary values. It's on github at https://github.com/well-typed/recover-rtti.
It turns out that this is a problem which has been recognized by multiple people in the past, known as the 'Constrained Monad Problem'. There is an elegant solution, explained in detail in the paper The Constrained-Monad Problem by Neil Sculthorpe and Jan Bracker and George Giorgidze and Andy Gill.
A brief summary of the technique: Monads (and other typeclasses) have a 'normal form'. We can 'lift' primitives (which are constrained any way we wish) into this 'normal form' construction, itself an existential datatype, and then use any of the operations available for the typeclass we have lifted into. These operations themselves are not constrained, and thus we can use all of Haskell's normal typeclass functions.
Finally, to turn this back into the concrete type (which again has all the constraints we are interested in) we 'lower' it, which is an operation that takes for each of the typeclass' operations a function which it will apply at the appropriate time.
This way, constraints from the outside (which are part of the functions supplied to the lowering) and constraints from the inside (which are part of the primitives we lifted) are able to be matched, and finally we end up with one big happy constrained datatype for which we have been able to use any of the normal Functor/Monoid/Monad/etc. operations.
Interestingly, while the intermediate operations are not constrained, to my knowledge it is impossible to write something which 'breaks' them as this would break the categorical laws that the typeclass under consideration should adhere to.
This is available in the constrained-normal Hackage package to use in your own code.
The example I struggled with, could be implemented as follows:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
module Example where
import Data.Dynamic
import Data.Kind
import Data.Typeable
import Control.Monad.ConstrainedNormal
-- | Required to have a simple constraint which we can use as argument to `Expr` / `Expr'`.
-- | This is definitely the part of the example with the roughest edges: I have yet to figure out
-- | how to make Haskell happy with constraints
class (Show a, Typeable a) => Introspectable a where {}
instance (Show a, Typeable a) => Introspectable a where {}
data Expr' (c :: * -> Constraint) a where
C :: a -> Expr' c a
-- M :: (a -> b) -> Expr' a -> Expr' b --^ NOTE: This one is actually never used as ConstrainedNormal will use the 'free' implementation based on A + C.
A :: c a => Expr' c (a -> b) -> Expr' c a -> Expr' c b
instance Introspectable a => Show (Expr' Introspectable a) where
show e = case e of
C x -> "(C " ++ show x ++ ")"
-- M f x = "(M " ++ show val ++ ")"
A fx x -> "(A " ++ show (typeOf fx) ++ " " ++ show x ++ ")"
-- | In user-facing code you'd not want to expose the guts of this construction
-- So let's introduce a 'wrapper type' which is what a user would normally interact with.
type Expr c a = NAF c (Expr' c) a
liftExpr :: c a => Expr' c a -> Expr c a
liftExpr expr = liftNAF expr
lowerExpr :: c a => Expr c a -> Expr' c a
lowerExpr lifted_expr = lowerNAF C A lifted_expr
constant :: Introspectable a => a -> Expr c a
constant val = pure val -- liftExpr (C val)
You could now for instance write
ghci> val = constant 10 :: Expr Introspectable Int
(C 10)
ghci> (+2) <$> val
(C 12)
ghci> (+) <$> constant 10 <*> constant 32 :: Expr Introspectable Int
And by using Data.Constraint.Trivial (part of the trivial-constrained library, although it is also possible to write your own 'empty constrained') one could instead write e.g.
ghci> val = constant 10 :: Expr Unconstrained Int
which will work just as before, but now val cannot be printed.
The one thing I have not yet figured out, is how to properly work with subsets of constraints (i.e. if I have a function that only requires Show, make it work with something that is Introspectable). Currently everything has to work with the 'big' set of constraints.
Another minor drawback is of course that you'll have to annotate the constraint type (e.g. if you do not want constraints, write Unconstrained manually), as GHC will otherwise complain that c0 is not known.
We've reached the goal of having a type which can be optionally be constrained to be printable, with all machinery that does not need printing to work also on all instances of the family of types including those that are not printable, and the types can be used as Monoids, Functors, Applicatives, etc just as you like.
I think it is a beautiful approach, and want to commend Neil Sculthorpe et al. for their work on the paper and the constrained-normal library that makes this possible. It's very cool!

How do the various "..Instances" pragma's work together, and is there a way around my current problem?

Consider the following code:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
class X a
class Y a
instance Y Bool
instance (Y a) => X a
instance {-# OVERLAPPING #-} X Int
f :: (X a) => a -> a
f x = x
These LANGUAGE pragma's are needed to write the above instances.
Now, say we want to write a function g:
g :: (Y a) => a -> a
g = f
Without IncoherentInstances or adding {-# INCOHERENT #-} to one of the instances, this doesn't typecheck.
But when we do add this, and ask ghci
ghci> :t f
f :: Y a => a -> a
Suddenly the type of 'f' changed?
With this small example, programs still typecheck when I give f an Int (indicating that the above would be merely a 'visual bug', but in a bigger example the same does not typecheck, giving me an error like:
Could not deduce (Y a) arising from a use of 'f
(...)
from the context: (..., X a, ...)
This also happens when we say
h = f
and try to call h with an Int
:type f does not report the type of the defined entity f. It reports the type of the expression f. GHC tries really hard to stamp polymorphism out of expressions. In particular, using f in an expression triggers simplification of the X a constraint (as does using any definition with a constraint). Without IncoherentInstances, GHC refrains from using instance Y a => X a, because there is another instance that overlaps it, so GHC needs to wait to see which one it should use. This ensures coherence; the only X Int instance that is ever used is the explicitly "specialized" one. With IncoherentInstances, you say that you don't care about coherence, so GHC goes ahead and simplifies X a to Y a using the polymorphic instance whenever f appears in an expression. The weird behavior you see where sometimes GHC is OK with using X Int and sometimes complains that there is no Y Int is a result of GHC making different internal decisions about when it wants to simplify constraints (you did ask for incoherence!). The command for seeing the type of a definition is :type +v. :type +v f should show the type of f "as declared". Hopefully, you can also see that IncoherentInstances is a bad idea. Don't use it.

Functions with higher kinds?

Suppose the following data types are defined:
data X a = X {getX :: a}
data Y a = Y {getY :: a}
data Z a = Z {getZ :: a}
Must there be three separate functions, getX, getY, and getZ? It seems to me that there could be a function defined something like this:
get :: forall (τ :: (* -> *)) (a :: *). τ a -> a
get (_ x) = x
Obviously this is not valid standard Haskell, but there are so many extensions to GHC that seem like they might have a solution (RankNTypes,ExistentialQuantification,DataKinds,etc.). Besides the simple reason of avoiding a tiny amount of typing, there is the benefit of avoiding the namespace pollution that the record solution creates. I suppose this is really just a more implicit solution than using a type class like this:
class Get f where
get :: f a -> a
However, it appears that defining a generic function would be more useful than a type class, because the fact that it is implicitly defined means it could be used in many more places, in the same way that ($) or (.) is used. So my question has three parts: is there a way to accomplish this, is it a good idea, and if not, what is a better way?
How about this type?
newtype Pred a = Pred (a -> Bool)
Or this one?
data Proxy a = Proxy
There's no way to get an a out of a Pred a. You can only put as in. Likewise, there's no way to get an a out of a Proxy a, because there aren't any as inside it.
So a function get :: forall f a. f a -> a can't exist in general. You need to use a type class to distinguish between those types f from which you can extract an a and those from which you can't.
Well, that unconstrained generic type of get certainly can't work. This would also allow you to extract, say, a Void value from Const () :: Const () Void.
You can however obtain a suitably constrained version of this function quite simply with generics. You still need a type class, but not need to define instances in the traditional sense. It ultimately looks like this:
{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass #-}
import GHC.Generics
class Get τ where
get :: τ a -> a
data X a = X a deriving (Generic1, Get)
data Y a = Y a deriving (Generic1, Get)
data Z a = Z a deriving (Generic1, Get)
To actually get this to work, we only need two weird representation-type instances:
instance Get f => Get (M1 i t f) where get = get . unM1
instance Get Par1 where get = unPar1
Now the actual implementation for X, Y and Z can just use a default signature and reduce the extraction to the underlying type-representation. To this end, define the class thus:
{-# LANGUAGE DefaultSignatures #-}
class Get τ where
get :: τ a -> a
default get :: (Generic1 τ, Get (Rep1 τ)) => τ a -> a
get = get . from1

Liberal coverage condition introduced in GHC 7.7 breaks code valid in GHC 7.6

The idea
I'm writing a DSL, which compiles to Haskell.
Users of this language can define own immutable data structures and associated functions. By associated function I mean a function, which belongs to a data structure.
For example, user can write (in "pythonic" pseudocode):
data Vector a:
x,y,z :: a
def method1(self, x):
return x
(which is equivalent to the following code, but shows also, that associated functions beheva like type classes with open world assumption):
data Vector a:
x,y,z :: a
def Vector.method1(self, x):
return x
In this example, method1 is a function associated with Vector data type, and can be used like v.testid(5) (where v is instance of Vector data type).
I'm translating such code to Haskell code, but I'm facing a problem, which I'm trying to solve for a long time.
The problem
I'm trying to move the code from GHC 7.6 over GHC 7.7 (which is pre-release of 7.8) (Newer versions can be compiled from sources). The code works perfectly under GHC 7.6, but does not under GHC 7.7.
I want to ask you how can I fix it to make it working in the new version of the compiler?
Example code
Lets see a simplified version of generated (by my compiler) Haskell code:
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
import Data.Tuple.OneTuple
------------------------------
-- data types
------------------------------
data Vector a = Vector {x :: a, y :: a, z :: a} deriving (Show)
-- the Vector_testid is used as wrapper over a function "testid".
newtype Vector_testid a = Vector_testid a
------------------------------
-- sample function, which is associated to data type Vector
------------------------------
testid (v :: Vector a) x = x
------------------------------
-- problematic function (described later)
------------------------------
testx x = call (method1 x) $ OneTuple "test"
------------------------------
-- type classes
------------------------------
-- type class used to access "method1" associated function
class Method1 cls m func | cls -> m, cls -> func where
method1 :: cls -> m func
-- simplified version of type class used to "evaluate" functions based on
-- their input. For example: passing empty tuple as first argument of `call`
-- indicates evaluating function with default arguments (in this example
-- the mechanism of getting default arguments is not available)
class Call a b where
call :: a -> b
------------------------------
-- type classes instances
------------------------------
instance (out ~ (t1->t1)) => Method1 (Vector a) Vector_testid out where
method1 = (Vector_testid . testid)
instance (base ~ (OneTuple t1 -> t2)) => Call (Vector_testid base) (OneTuple t1 -> t2) where
call (Vector_testid val) = val
------------------------------
-- example usage
------------------------------
main = do
let v = Vector (1::Int) (2::Int) (3::Int)
-- following lines equals to a pseudocode of ` v.method1 "test" `
-- OneTuple is used to indicate, that we are passing single element.
-- In case of more or less elements, ordinary tuples would be used.
print $ call (method1 v) $ OneTuple "test"
print $ testx v
The code compiles and works fine with GHC 7.6. When I'm trying to compile it with GHC 7.7, I'm getting following error:
debug.hs:61:10:
Illegal instance declaration for
‛Method1 (Vector a) Vector_testid out’
The liberal coverage condition fails in class ‛Method1’
for functional dependency: ‛cls -> func’
Reason: lhs type ‛Vector a’ does not determine rhs type ‛out’
In the instance declaration for
‛Method1 (Vector a) Vector_testid out’
The error is caused by new rules of checking what functional dependencies can do, namely liberal coverage condition (as far as I know, this is coverage condition relaxed by using -XUndecidableInstances)
Some attemps to fix the problem
I was trying to overcome this problem by changing the definition of Method1 to:
class Method1 cls m func | cls -> m where
method1 :: cls -> m func
Which resolves the problem with functional dependencies, but then the line:
testx x = call (method1 x) $ OneTuple "test"
is not allowed anymore, causing a compile error (in both 7.6 and 7.7 versions):
Could not deduce (Method1 cls m func0)
arising from the ambiguity check for ‛testx’
from the context (Method1 cls m func,
Call (m func) (OneTuple [Char] -> s))
bound by the inferred type for ‛testx’:
(Method1 cls m func, Call (m func) (OneTuple [Char] -> s)) =>
cls -> s
at debug.hs:50:1-44
The type variable ‛func0’ is ambiguous
When checking that ‛testx’
has the inferred type ‛forall cls (m :: * -> *) func s.
(Method1 cls m func, Call (m func) (OneTuple [Char] -> s)) =>
cls -> s’
Probable cause: the inferred type is ambiguous
EDIT:
It is also impossible to solve this issue using type families (as far as I know). If we replace Method1 type class and instances with following code (or simmilar):
class Method1 cls m | cls -> m where
type Func cls
method1 :: cls -> m (Func cls)
instance Method1 (Vector a) Vector_testid where
type Func (Vector a) = (t1->t1)
method1 = (Vector_testid . testid)
We would get obvious error Not in scope: type variable ‛t1’, because type families does not allow to use types, which does not appear on LHS of type expression.
The final question
How can I make this idea work under GHC 7.7? I know the new liberal coverage condition allows GHC devs make some progress with type checking, but it should somehow be doable to port idea working in GHC 7.6 over never compiler version.
(without forcing user of my DSL to introduce any further types - everything so far, like type class instances, I'm genarating using Template Haskell)
This is not a bug in GHC 7.7. It was a long-standing bug in GHC when it allowed instances
that violate functional dependencies. It seems, fortunately, that this problem is finally fixed. The error message emitted by GHC 7.7 is quite detailed, pointing out the problem with your instance Method1 (Vector a) Vector_testid out. Recall the meaning of functional
dependencies. Given
class C a b | a -> b
it follows that if the types a, b and b1 are such that C a b and C a b1
both hold, it must be true that b and b1 are the same. Let's look at your instance:
Method1 (Vector a) Vector_testid (t1->t1)
If we have types b and b1 that satisfy Method1 (Vector Int) Vector_testid (b->b)
and Method1 (Vector a) Vector_testid (b1->b1), nothing at all implies that b and b1 must be the same. Hence your instance is ill-formed. The fact that GHC 7.6 and before accepted the program was a well-known bug in GHC (discussed about every year).
What you seem to be trying is to define something like
Method1 (Vector a) Vector_testid (forall t. t -> t)
Alas, this syntax is not allowed, although many worksrounds exist. One, for example, involves the Apply class (see the HList paper, for example). A simpler way is as follows
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
-- import Data.Tuple.OneTuple
newtype OneTuple x = OneTuple x deriving Show
------------------------------
-- data types
------------------------------
data Vector a = Vector {x :: a, y :: a, z :: a} deriving (Show)
-- testx x = call (method1 x) $ OneTuple "test"
testx x = call x Method1 $ OneTuple "test"
-- associate methods to classes
class Methods cls m x y | cls m x -> y where
call :: cls -> m -> x -> y
instance Methods (Vector a) Method1 x x where
call self _ x = x
data Method1 = Method1 -- method label

Binary instance for an existential

Given an existential data type, for example:
data Foo = forall a . (Typeable a, Binary a) => Foo a
I'd like to write instance Binary Foo. I can write the serialisation (serialise the TypeRep then serialise the value), but I can't figure out how to write the deserialisation. The basic problem is that given a TypeRep you need to map back to the type dictionary for that type - and I don't know if that can be done.
This question has been asked before on the haskell mailing list http://www.haskell.org/pipermail/haskell/2006-September/018522.html, but no answers were given.
You need some way that each Binary instance can register itself (just as in your witness version). You can do this by bundling each instance declaration with an exported foreign symbol, where the symbol name is derived from the TypeRep. Then when you want to deserialize you get the name from the TypeRep and look up that symbol dynamically (with dlsym() or something similar). The value exported by the foreign export can, e.g., be the deserializer function.
It's crazy ugly, but it works.
This can be solved in GHC 7.10 and onwards using the Static Pointers Language extension:
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE InstanceSigs #-}
data Foo = forall a . (StaticFoo a, Binary a, Show a) => Foo a
class StaticFoo a where
staticFoo :: a -> StaticPtr (Get Foo)
instance StaticFoo String where
staticFoo _ = static (Foo <$> (get :: Get String))
instance Binary Foo where
put (Foo x) = do
put $ staticKey $ staticFoo x
put x
get = do
ptr <- get
case unsafePerformIO (unsafeLookupStaticPtr ptr) of
Just value -> deRefStaticPtr value :: Get Foo
Nothing -> error "Binary Foo: unknown static pointer"
A full description of the solution can be found on this blog post, and a complete snippet here.
If you could do that, you would also be able to implement:
isValidRead :: TypeRep -> String -> Bool
This would be a function that changes its behavior due to someone defining a new type! Not very pure-ish.. I think (and hope) that one can't implement this in Haskell..
I have an answer that slightly works in some situations (not enough for my purposes), but may be the best that can be done. You can add a witness function to witness any types that you have, and then the deserialisation can lookup in the witness table. The rough idea is (untested):
witnesses :: IORef [Foo]
witnesses = unsafePerformIO $ newIORef []
witness :: (Typeable a, Binary a) => a -> IO ()
witness x = modifyIORef (Foo x :)
instance Binary Foo where
put (Foo x) = put (typeOf x) >> put x
get = do
ty <- get
wits <- unsafePerformIO $ readIORef witnesses
case [Foo x | Foo x <- wits, typeOf x == ty] of
Foo x:_ -> fmap Foo $ get `asTypeOf` return x
[] -> error $ "Could not find a witness for the type: " ++ show ty
The idea is that as you go through, you call witness on values of every type that you may plausibly encounter when deserialising. When you deserialise you search this list. The obvious problem is that if you fail to call witness before deserialisation you get a crash.

Resources