I have an enumeration type, e.g.
data MyType = A | B
And I want to be able to pass values of this type implicitly to my functions. I can do this using the ImplicitParams GHC extension like this:
type HasMyType = (?myType :: MyType)
myFun :: HasMyType => String
myFun = case ?myType of
A -> "Foo"
B -> "Bar"
But I've heard many times that it's better to use the Haskell package reflection for this task. Unfortunately, the reflection documentation doesn't explain how to write a similar code using the library. And it's not that straightforward to figure it out.
So, my question is, whether it's possible to use the reflection library to implement a similar code and to satisfy the following requirements?
Values of MyType should be passed implicitly.
If the HasMyType constraint is not specified, the default value of MyType should be taken.
It should be possible to override the value passed via the HasMyType constraint in a single place, e.g. at the beginning of the application.
Does something like this is possible? Or what would be the closest approximation of this using the reflection library?
This answers two ways of implementing question 1. using reflection.
Using Reifies:
type HasMyType :: forall k. k -> Constraint
type HasMyType name = Reifies name MyType
myFun :: HasMyType name => Proxy name -> String
myFun name = case reflect name of
A -> "Foo"
B -> "Bar"
-- reify :: MyType -> (forall name. HasMyType name => Proxy name -> res) -> res
>> reify A myFun
"Foo"
>> reify B myFun
"Bar"
>> reify A \name -> myFun name
"Foo"
>> reify B \name -> myFun name
"Bar"
Haskell can't abstract over type variables yet \#name -> .. so it uses \(Proxy :: Proxy name) -> ...
The Proxy can be removed from myFun where name is supplied with visible type applications, but reify still generates a Proxy whose name must be "extracted"
{-# Language ScopedTypeVariables #-}
{-# Language TypeApplications #-} ..
myFun :: forall name. HasMyType name => String
myFun = case reflect #name Proxy of
A -> "Foo"
B -> "Bar"
>> reify A \(_ :: _ name) -> myFun #name
"Foo"
>> reify B \(_ :: _ name) -> myFun #name
"Bar"
A simpler option (Given) doesn't rely on type-level "names" to distinguish between different dictionaries, therefore it is more dangerous with the following warning:
You should only give a single value for each type. If multiple instances are in scope, then the behavior is implementation defined.
type HasMyType :: Constraint
type HasMyType = Given MyType
myFun :: HasMyType => String
myFun = case given of
A -> "Foo"
B -> "Bar"
-- give :: MyType -> (HasMyType => res) -> res
>> give A myFun
"Foo"
>> give B myFun
"Bar"
Related
Haskell Noob here.
An oversimplified case of what I'm trying to do here:
test :: Int -> a
test i = i -- Couldn't match expected type ‘a’ with actual type ‘Int’. ‘a’ is a rigid type variable bound by ...
I don't quite understand why this wouldn't work. I mean, Int is surely included in something of type a.
What I was really trying to achieve is this:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
data EnumType = Enum1 | Enum2 | Enum3
data MyType (a :: EnumType) where
Type1 :: Int -> MyType 'Enum1
Type2 :: String -> MyType 'Enum2
Type3 :: Bool -> MyType 'Enum3
myFunc :: EnumType -> MyType 'Enum1 -> MyType any
myFunc Enum1 t = t -- Can't match type `any` with `Enum1`. any is a rigid type variable bound by ...
myFunc Enum2 _ = Type2 "hi"
myFunc Enum3 _ = Type3 True
What is going on here? Is there a way to work around this or is it just something you can't do?
For the GADT function you want to write, the standard technique is to use singletons. The problem is that values of type EnumType are value-level things, but you want to inform the type system of something. So you need a way to connect types of kind EnumType with values of type EnumType (which itself has kind Type). That's impossible, so we cheat: we connect types x of kind EnumType with values of a new type, SEnumType x, such that the value uniquely determines x. Here's how it looks:
data SEnumType a where
SEnum1 :: SEnumType Enum1
SEnum2 :: SEnumType Enum2
SEnum3 :: SEnumType Enum3
myFunc :: SEnumType a -> MyType Enum1 -> MyType a
myFunc SEnum1 t = t
myFunc SEnum2 _ = Type2 "hi"
myFunc SEnum3 _ = Type3 True
Now the a in the return type MyType a isn't just fabricated out of thin air; it is constrained to be equal to the incoming a from SEnumType, and pattern matching on which SEnumType it is lets you observe whether a is Enum1, Enum2, or Enum3.
Is there a way to work around this or is it just something you can't do?
I'm afraid that it's just "something you can't do". The reason is simple to explain.
When you write a type signature like (to take your first, simpler example)
test :: Int -> a
or, to write it the more literal, expanded form
test :: forall a. Int -> a
You are saying that literally, "for all a", this function can take an Int and return a value of type a. This is important, because calling code has to believe this type signature and therefore be able to do something like this (this isn't realistic code, but imagine a case where you feed the result of test 2 to a function that requires a Char or one of those other types):
test 2 :: Char
test 2 :: [Int]
test 2 :: (Double, [Char])
and so on. Clearly your function can't work with any of these examples - but it has to be able to work with any of them if you give it this type signature. Your code, quite simply, does not fit that type signature. (And nor could any, unless you "cheat" by having eg test x = undefined.)
This shouldn't be a problem though - the compiler is simply protecting you from a mistake, because I'm sure you realise that your code cannot satisfy this type signature. To take your "real" example:
myFunc :: EnumType -> MyType Enum1 -> MyType any
although this produces a compilation error, your code in the function is likely correct, and the problem is the type signature. If you replace it with
myFunc :: EnumType -> MyType Enum1 -> MyType Enum1
then it will compile (barring any further errors, which I've not checked it for), and presumably do what you want. It doesn't look like you actually want to be able to call myFunc and have it produce, say, a MyType Int. (If by any chance you do, I'd suggest you ask a separate question where you elaborate on what you actually need here.)
As was already said, your signature expresses a universal type
myFunc :: ∀ a . EnumType -> MyType 'Enum1 -> MyType a
whereas what you're actually trying to express is an existential type
myFunc :: EnumType -> MyType 'Enum1 -> (∃ a . MyType a)
Haskell doesn't have a feature quite like that, but it does have some way to achieve essentially the same thing.
Both GADTs and the ExistentialTypes extension allow expressing existentials, but you need to define a separate type for them.
data MyDynType where
MyDynWrap :: MyType a -> MyDynType
myFunc :: EnumType -> MyType 'Enum1 -> MyDynType
myFunc Enum1 t = MyDynWrap t
myFunc Enum2 _ = MyDynWrap $ Type2 "hi"
myFunc Enum3 _ = MyDynWrap $ Type3 True
Maybe you don't even need a separate type, but can simply modify MyType to be “dynamic” in the first place.
data MyType = Type1 Int | Type2 String | Type3 Bool
myFunc :: EnumType -> MyType -> MyType
myFunc Enum1 (Type1 i) = Type1 i
myFunc Enum2 _ = Type2 "hi"
myFunc Enum3 _ = Type3 True
existentials can be emulated at the spot, anonymously, by unwrapping a layer of continuation-passing style and then using the dual universal quantifier via the RankNTypes extension.
{-# LANGUAGE RankNTypes #-}
data MyType (a :: EnumType) where ... -- as original
myFunc :: EnumType -> MyType 'Enum1 -> (∀ a . MyType a -> r) -> r
myFunc Enum1 t q = q t
myFunc Enum2 _ q = q (Type2 "hi")
myFunc Enum3 _ q = q (Type3 True)
the GADT function you want to write, the standard technique is to use singletons. The problem is that values of type EnumType are ...
I'm trying to define a function that detects whether the type of an input satisfies a given constraint:
satisfies :: (c a => a -> b) -> a -> Maybe b
-- or the more general
claim :: (c => a) -> Maybe a
So the desired behaviour would be:
>>> :t satisfies #Show show
satisfies #Show show :: a -> Maybe String
>>> satisfies #Show show (0 :: Int)
Just "0"
>>> satisfies #Show show (id :: Int -> Int)
Nothing
The goal is to make it easy to define fully polymorphic functions that take
advantage of specializations when possible:
showAny :: a -> String
showAny (satisfies #Show show -> Just str) = str
showAny (satisfies #Typeable showType -> Just str) = "_ :: " ++ str
showAny _ = "_"
As the easiest thing I could try, my first attempt tried using -fdefer-to-runtime
{-# OPTIONS_GHC -fdefer-type-errors -Wno-deferred-type-errors #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
module Claim where
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Error (catchIOError)
satisfies :: (c a => a -> b) -> a -> Maybe b
satisfies f a = unsafePerformIO $
(return . Just $! f a) `catchIOError` \_ -> return Nothing
This failed because -fdefer-type-errors doesn't defer the checking to
runtime, or allow further checking to be done in the context which it is
actually used (as I had hoped), but instead at compile time replaces found
type errors with the equivalent of error "MESSAGE".
Now I'm out of ideas. Is implementing satisfies even possible?
You can't dispatch on instance availability at runtime. Remember, a constraint is translated by the compiler into a type class dictionary - a record of functions that is passed around explicitly and accessed explicitly at runtime. The "fat arrow" => is represented at runtime by a "thin arrow" ->, so the elaborator needs to know at compile time which dictionary to pass around.
That is, the following crude example:
class Show a where
show :: a -> String
instance Show String where
show = id
showTwice :: Show a => a -> String
showTwice x = show x ++ show x
main = putStrLn $ showTwice "foo"
generates Core code which looks approximately like:
data Show_ a = Show_ { show :: a -> String }
showString_ :: Show_ String
showString_ = Show_ { show = id }
showTwice :: Show_ a -> a -> String
showTwice show_ x = show show_ x ++ show show_ x
main = putStrLn $ showTwice showString_ "foo"
When generating code for main, the compiler needs to know where to find showString_.
You can imagine a system wherein you can look up a type class dictionary at runtime with some sort of introspection mechanism, but this would produce weird behaviour from a language design perspective. The problem is orphan instances. If I write a function which attempts to look up a given instance in module A, and define such an instance in an unrelated module B, then the behaviour of that function when called from some client module C depends on whether B was imported by some other part of the program. Pretty strange!
A more usual way of doing "fully polymorphic functions that take advantage of specializations when possible" would be to put the function in question into a type class itself and give it a default implementation (perhaps with a default signature if the default implementation depends on some superclass). Your showAny would then look like this:
{-# LANGUAGE DefaultSignatures #-}
import Data.Typeable
class ShowAny a where
showAny :: a -> String
default showAny :: Typeable a => a -> String
showAny x = "_ :: " ++ show (typeOf x)
You'd need to implement ShowAny for all of the types with which you want to use showAny, but that's usually a single line of code,
instance (Typeable a, Typeable b) => ShowAny (a -> b)
and you can specialise an implementation for a given type just by overriding showAny.
instance ShowAny String where
showAny = id
You see this approach quite frequently in libraries which do generic programming. aeson, for example, can use GHC.Generics to serialise a given type to and from JSON (all you have to do is derive Generic and write two lines instance ToJSON MyType; instance FromJSON MyType), but you can also write your own instances of ToJSON and FromJSON if the generic code isn't fast enough or you need to customise the output.
An alternate workaround to the accepted answer is to pass the dictionaries around manually.
That is, given:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
module Claim where
data Proof c where QED :: c => Proof c
type Claim c = Maybe (Proof c)
type c ? a = Maybe (Proof (c a))
One can write:
showAny :: (Show? a, Typeable? a) -> a -> String
showAny (Just QED, _) a = show a
showAny (_, Just QED) a = "_ :: " ++ showType a
showAny _ _ = "_"
Which works accepably well:
>>> showAny (Nothing, Just QED) (id :: Int -> Int)
"_ :: Int -> Int"
>>> showAny (Just QED, Just QED) (0 :: Int)
"0"
>>> showAny (Nothing, Nothing) undefined
"_"
I'd like to write a program that prints out some metadata of a Haskell type. Although I know this isn't valid code, the idea is something like:
data Person = Person { name :: String, age :: Int }
metadata :: Type -> String
metadata t = ???
metadata Person -- returns "Person (name,age)"
The important restriction being I don't have an instance of Person, just the type.
I've started looking into Generics & Typeable/Data, but without an instance I'm not sure they'll do what I need. Can anyone point me in the right direction?
Reflection in Haskell works using the Typeable class, which is defined in Data.Typeable and includes the typeOf* method to get a run-time representation of a value's type.
ghci> :m +Data.Typeable
ghci> :t typeOf 'a'
typeOf 'a' :: TypeRep
ghci> typeOf 'a' -- We could use any value of type Char and get the same result
Char -- the `Show` instance of `TypeRep` just returns the name of the type
If you want Typeable to work for your own types, you can have the compiler generate an instance for you with the DeriveDataTypeable extension.
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Typeable
data Person = Person { name :: String, age :: Int } deriving Typeable
You can also write your own instance, but really, no one has the time for that. Apparently you can't - see the comments
You can now use typeOf to grab a run-time representation of your type. We can query information about the type constructor (abbreviated to TyCon) and its type arguments:
-- (undefined :: Person) stands for "some value of type Person".
-- If you have a real Person you can use that too.
-- typeOf does not use the value, only the type
-- (which is known at compile-time; typeOf is dispatched using the normal instance selection rules)
ghci> typeOf (undefined :: Person)
Person
ghci> tyConName $ typeRepTyCon $ typeOf (undefined :: Person)
"Person"
ghci> tyConModule $ typeRepTyCon $ typeOf (undefined :: Person)
"Main"
Data.Typeable also provides a type-safe cast operation which allows you to branch on a value's runtime type, somewhat like C#'s as operator.
f :: Typeable a => a -> String
f x = case (cast x :: Maybe Int) of
Just i -> "I can treat i as an int in this branch " ++ show (i * i)
Nothing -> case (cast x :: Maybe Bool) of
Just b -> "I can treat b as a bool in this branch " ++ if b then "yes" else "no"
Nothing -> "x was of some type other than Int or Bool"
ghci> f True
"I can treat b as a bool in this branch yes"
ghci> f (3 :: Int)
"I can treat i as an int in this branch 9"
Incidentally, a nicer way to write f is to use a GADT enumerating the set of types you expect your function to be called with. This allows us to lose the Maybe (f can never fail!), does a better job of documenting our assumptions, and gives compile-time feedback when we need to change the set of admissible argument types for f. (You can write a class to make Admissible implicit if you like.)
data Admissible a where
AdInt :: Admissible Int
AdBool :: Admissible Bool
f :: Admissible a -> a -> String
f AdInt i = "I can treat i as an int in this branch " ++ show (i * i)
f AdBool b = "I can treat b as a bool in this branch " ++ if b then "yes" else "no"
In reality I probably wouldn't do either of these - I'd just stick f in a class and define instances for Int and Bool.
If you want run-time information about the right-hand side of a type definition, you need to use the entertainingly-named Data.Data, which defines a subclass of Typeable called Data.** GHC can derive Data for you too, with the same extension:
{-# LANGUAGE DeriveDataTypeable #-}
import Data.Typeable
import Data.Data
data Person = Person { name :: String, age :: Int } deriving (Typeable, Data)
Now we can grab a run-time representation of the values of a type, not just the type itself:
ghci> dataTypeOf (undefined :: Person)
DataType {tycon = "Main.Person", datarep = AlgRep [Person]}
ghci> dataTypeConstrs $ dataTypeOf (undefined :: Person)
[Person] -- Person only defines one constructor, called Person
ghci> constrFields $ head $ dataTypeConstrs $ dataTypeOf (undefined :: Person)
["name","age"]
Data.Data is the API for generic programming; if you ever hear people talking about "Scrap Your Boilerplate", this (along with Data.Generics, which builds on Data.Data) is what they mean. For example, you can write a function which converts record types to JSON using reflection on the type's fields.
toJSON :: Data a => a -> String
-- Implementation omitted because it is boring.
-- But you only have to write the boring code once,
-- and it'll be able to serialise any instance of `Data`.
-- It's a good exercise to try to write this function yourself!
* In recent versions of GHC, this API has changed somewhat. Consult the docs.
** Yes, the fully-qualified name of that class is Data.Data.Data.
I'm trying to make a variadic function with a monadic return type, whose parameters also require the monadic context. (I'm not sure how to describe that second point: e.g. printf can return IO () but it's different in that its parameters are treated the same whether it ends up being IO () or String.)
Basically, I've got a data constructor that takes, say, two Char parameters. I want to provide two pointer style ID Char arguments instead, which can be automagically decoded from an enclosing State monad via a type class instance. So, instead of doing get >>= \s -> foo1adic (Constructor (idGet s id1) (idGet s id2)), I want to do fooVariadic Constructor id1 id2.
What follows is what I've got so far, Literate Haskell style in case somebody wants to copy it and mess with it.
First, the basic environment:
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> import Control.Monad.Trans.State
> data Foo = Foo0
> | Foo1 Char
> | Foo2 Bool Char
> | Foo3 Char Bool Char
> deriving Show
> type Env = (String,[Bool])
> newtype ID a = ID {unID :: Int}
> deriving Show
> class InEnv a where envGet :: Env -> ID a -> a
> instance InEnv Char where envGet (s,_) i = s !! unID i
> instance InEnv Bool where envGet (_,b) i = b !! unID i
Some test data for convenience:
> cid :: ID Char
> cid = ID 1
> bid :: ID Bool
> bid = ID 2
> env :: Env
> env = ("xy", map (==1) [0,0,1])
I've got this non-monadic version, which simply takes the environment as the first parameter. This works fine but it's not quite what I'm after. Examples:
$ mkFoo env Foo0 :: Foo
Foo0
$ mkFoo env Foo3 cid bid cid :: Foo
Foo3 'y' True 'y'
(I could use functional dependencies or type families to get rid of the need for the :: Foo type annotations. For now I'm not fussed about it, since this isn't what I'm interested in anyway.)
> mkFoo :: VarC a b => Env -> a -> b
> mkFoo = variadic
>
> class VarC r1 r2 where
> variadic :: Env -> r1 -> r2
>
> -- Take the partially applied constructor, turn it into one that takes an ID
> -- by using the given state.
> instance (InEnv a, VarC r1 r2) => VarC (a -> r1) (ID a -> r2) where
> variadic e f = \aid -> variadic e (f (envGet e aid))
>
> instance VarC Foo Foo where
> variadic _ = id
Now, I want a variadic function that runs in the following monad.
> type MyState = State Env
And basically, I have no idea how I should proceed. I've tried expressing the type class in different ways (variadicM :: r1 -> r2 and variadicM :: r1 -> MyState r2) but I haven't succeeded in writing the instances. I've also tried adapting the non-monadic solution above so that I somehow "end up" with an Env -> Foo which I could then easily turn into a MyState Foo, but no luck there either.
What follows is my best attempt thus far.
> mkFooM :: VarMC r1 r2 => r1 -> r2
> mkFooM = variadicM
>
> class VarMC r1 r2 where
> variadicM :: r1 -> r2
>
> -- I don't like this instance because it requires doing a "get" at each
> -- stage. I'd like to do it only once, at the start of the whole computation
> -- chain (ideally in mkFooM), but I don't know how to tie it all together.
> instance (InEnv a, VarMC r1 r2) => VarMC (a -> r1) (ID a -> MyState r2) where
> variadicM f = \aid -> get >>= \e -> return$ variadicM (f (envGet e aid))
>
> instance VarMC Foo Foo where
> variadicM = id
>
> instance VarMC Foo (MyState Foo) where
> variadicM = return
It works for Foo0 and Foo1, but not beyond that:
$ flip evalState env (variadicM Foo1 cid :: MyState Foo)
Foo1 'y'
$ flip evalState env (variadicM Foo2 cid bid :: MyState Foo)
No instance for (VarMC (Bool -> Char -> Foo)
(ID Bool -> ID Char -> MyState Foo))
(Here I would like to get rid of the need for the annotation, but the fact that this formulation needs two instances for Foo makes that problematic.)
I understand the complaint: I only have an instance that goes from Bool ->
Char -> Foo to ID Bool -> MyState (ID Char -> Foo). But I can't make the
instance it wants because I need MyState in there somewhere so that I can
turn the ID Bool into a Bool.
I don't know if I'm completely off track or what. I know that I could solve my basic issue (I don't want to pollute my code with the idGet s equivalents all over the place) in different ways, such as creating liftA/liftM-style functions for different numbers of ID parameters, with types like (a -> b -> ... -> z -> ret) -> ID a -> ID b -> ... -> ID z -> MyState ret, but I've spent too much time thinking about this. :-) I want to know what this variadic solution should look like.
WARNING
Preferably don't use variadic functions for this type of work. You only have a finite number of constructors, so smart constructors don't seem to be a big deal. The ~10-20 lines you would need are a lot simpler and more maintainable than a variadic solution. Also an applicative solution is much less work.
WARNING
The monad/applicative in combination with variadic functions is the problem. The 'problem' is the argument addition step used for the variadic class. The basic class would look like
class Variadic f where
func :: f
-- possibly with extra stuff
where you make it variadic by having instances of the form
instance Variadic BaseType where ...
instance Variadic f => Variadic (arg -> f) where ...
Which would break when you would start to use monads. Adding the monad in the class definition would prevent argument expansion (you would get :: M (arg -> f), for some monad M). Adding it to the base case would prevent using the monad in the expansion, as it's not possible (as far as I know) to add the monadic constraint to the expansion instance. For a hint to a complex solution see the P.S..
The solution direction of using a function which results in (Env -> Foo) is more promising. The following code still requires a :: Foo type constraint and uses a simplified version of the Env/ID for brevity.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
module Test where
data Env = Env
data ID a = ID
data Foo
= Foo0
| Foo1 Char
| Foo2 Char Bool
| Foo3 Char Bool Char
deriving (Eq, Ord, Show)
class InEnv a where
resolve :: Env -> ID a -> a
instance InEnv Char where
resolve _ _ = 'a'
instance InEnv Bool where
resolve _ _ = True
The Type families extension is used to make the matching stricter/better. Now the variadic function class.
class MApp f r where
app :: Env -> f -> r
instance MApp Foo Foo where
app _ = id
instance (MApp r' r, InEnv a, a ~ b) => MApp (a -> r') (ID b -> r) where
app env f i = app env . f $ resolve env i
-- using a ~ b makes this instance to match more easily and
-- then forces a and b to be the same. This prevents ambiguous
-- ID instances when not specifying there type. When using type
-- signatures on all the ID's you can use
-- (MApp r' r, InEnv a) => MApp (a -> r') (ID a -> r)
-- as constraint.
The environment Env is explicitly passed, in essence the Reader monad is unpacked preventing the problems between monads and variadic functions (for the State monad the resolve function should return a new environment). Testing with app Env Foo1 ID :: Foo results in the expected Foo1 'a'.
P.S.
You can get monadic variadic functions to work (to some extent) but it requires bending your functions (and mind) in some very strange ways. The way I've got such things to work is to 'fold' all the variadic arguments into a heterogeneous list. The unwrapping can then be done monadic-ally. Though I've done some things like that, I strongly discourage you from using such things in actual (used) code as it quickly gets incomprehensible and unmaintainable (not to speak of the type errors you would get).
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.