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).
Related
I'd like to be able to derive Eq and Show for an ADT that contains multiple fields. One of them is a function field. When doing Show, I'd like it to display something bogus, like e.g. "<function>"; when doing Eq, I'd like it to ignore that field. How can I best do this without hand-writing a full instance for Show and Eq?
I don't want to wrap the function field inside a newtype and write my own Eq and Show for that - it would be too bothersome to use like that.
One way you can get proper Eq and Show instances is to, instead of hard-coding that function field, make it a type parameter and provide a function that just “erases” that field. I.e., if you have
data Foo = Foo
{ fooI :: Int
, fooF :: Int -> Int }
you change it to
data Foo' f = Foo
{ _fooI :: Int
, _fooF :: f }
deriving (Eq, Show)
type Foo = Foo' (Int -> Int)
eraseFn :: Foo -> Foo' ()
eraseFn foo = foo{ fooF = () }
Then, Foo will still not be Eq- or Showable (which after all it shouldn't be), but to make a Foo value showable you can just wrap it in eraseFn.
Typically what I do in this circumstance is exactly what you say you don’t want to do, namely, wrap the function in a newtype and provide a Show for that:
data T1
{ f :: X -> Y
, xs :: [String]
, ys :: [Bool]
}
data T2
{ f :: OpaqueFunction X Y
, xs :: [String]
, ys :: [Bool]
}
deriving (Show)
newtype OpaqueFunction a b = OpaqueFunction (a -> b)
instance Show (OpaqueFunction a b) where
show = const "<function>"
If you don’t want to do that, you can instead make the function a type parameter, and substitute it out when Showing the type:
data T3' a
{ f :: a
, xs :: [String]
, ys :: [Bool]
}
deriving (Functor, Show)
newtype T3 = T3 (T3' (X -> Y))
data Opaque = Opaque
instance Show Opaque where
show = const "..."
instance Show T3 where
show (T3 t) = show (Opaque <$ t)
Or I’ll refactor my data type to derive Show only for the parts I want to be Showable by default, and override the other parts:
data T4 = T4
{ f :: X -> Y
, xys :: T4' -- Move the other fields into another type.
}
instance Show T4 where
show (T4 f xys) = "T4 <function> " <> show xys
data T4' = T4'
{ xs :: [String]
, ys :: [Bool]
}
deriving (Show) -- Derive ‘Show’ for the showable fields.
Or if my type is small, I’ll use a newtype instead of data, and derive Show via something like OpaqueFunction:
{-# LANGUAGE DerivingVia #-}
newtype T5 = T5 (X -> Y, [String], [Bool])
deriving (Show) via (OpaqueFunction X Y, [String], [Bool])
You can use the iso-deriving package to do this for data types using lenses if you care about keeping the field names / record accessors.
As for Eq (or Ord), it’s not a good idea to have an instance that equates values that can be observably distinguished in some way, since some code will treat them as identical and other code will not, and now you’re forced to care about stability: in some circumstance where I have a == b, should I pick a or b? This is why substitutability is a law for Eq: forall x y f. (x == y) ==> (f x == f y) if f is a “public” function that upholds the invariants of the type of x and y (although floating-point also violates this). A better choice is something like T4 above, having equality only for the parts of a type that can satisfy the laws, or explicitly using comparison modulo some function at use sites, e.g., comparing someField.
The module Text.Show.Functions in base provides a show instance for functions that displays <function>. To use it, just:
import Text.Show.Functions
It just defines an instance something like:
instance Show (a -> b) where
show _ = "<function>"
Similarly, you can define your own Eq instance:
import Text.Show.Functions
instance Eq (a -> b) where
-- all functions are equal...
-- ...though some are more equal than others
_ == _ = True
data Foo = Foo Int Double (Int -> Int) deriving (Show, Eq)
main = do
print $ Foo 1 2.0 (+1)
print $ Foo 1 2.0 (+1) == Foo 1 2.0 (+2) -- is True
This will be an orphan instance, so you'll get a warning with -Wall.
Obviously, these instances will apply to all functions. You can write instances for a more specialized function type (e.g., only for Int -> String, if that's the type of the function field in your data type), but there is no way to simultaneously (1) use the built-in Eq and Show deriving mechanisms to derive instances for your datatype, (2) not introduce a newtype wrapper for the function field (or some other type polymorphism as mentioned in the other answers), and (3) only have the function instances apply to the function field of your data type and not other function values of the same type.
If you really want to limit applicability of the custom function instances without a newtype wrapper, you'd probably need to build your own generics-based solution, which wouldn't make much sense unless you wanted to do this for a lot of data types. If you go this route, then the Generics.Deriving.Show and Generics.Deriving.Eq modules in generic-deriving provide templates for these instances which could be modified to treat functions specially, allowing you to derive per-datatype instances using some stub instances something like:
instance Show Foo where showsPrec = myGenericShowsPrec
instance Eq Foo where (==) = myGenericEquality
I proposed an idea for adding annotations to fields via fields, that allows operating on behaviour of individual fields.
data A = A
{ a :: Int
, b :: Int
, c :: Int -> Int via Ignore (Int->Int)
}
deriving
stock GHC.Generic
deriving (Eq, Show)
via Generically A -- assuming Eq (Generically A)
-- Show (Generically A)
But this is already possible with the "microsurgery" library, but you might have to write some boilerplate to get it going. Another solution is to write separate behaviour in "sums-of-products style"
data A = A Int Int (Int->Int)
deriving
stock GHC.Generic
deriving
anyclass SOP.Generic
deriving (Eq, Show)
via A <-𝈖-> '[ '[ Int, Int, Ignore (Int->Int) ] ]
I was wondering if there was a known pattern for writing generic unit test code whose purpose it is to check (as a black box) the various instance (implementation of) a type class. For example:
import Test.HUnit
class M a where
foo :: a -> String
cons :: Int -> a -- some constructor
data A = A Int
data B = B Int
instance M A where
foo _ = "foo"
cons = A
instance M B where
foo _ = "bar" -- implementation error
cons = B
I would like to write a function tests returning a Test with some way of specifying to tests the particular instance to which the code applies. I was thinking adding teststo the definition of the class with a default implementation (ignoring the coupling issue between testing code and actual code for now), but I can't simply have tests :: Test, and even if I try tests:: a -> Test (so having to artificially pass a concrete element of the given type to call the function), I cannot figure out how to refer to cons and foo inside the code (type annotations like (cons 0) :: a won't do).
Assuming I have class (Eq a) => M a where ... instead, with types A and B deriving Eq, I could trick the compiler with something like (added to the definition of M):
tests :: a -> Test
tests x = let
y = (cons 0)
z = (x == y) -- compiler now knows y :: a
in
TestCase (assertEqual "foo" (foo y) "foo")
main = do
runTestTT $ TestList
[ tests (A 0)
, tests (B 0)
]
But this is all very ugly to me. Any suggestion is warmly welcome
Proxy
The current most common way of making a function polymorphic in an "internal" type is to pass a Proxy. Proxy has a single nullary constructor like (), but its type carries a phantom type. This avoids having to pass undefined or dummy values. Data.Proxy.asProxyTypeOf can then be used as an annotation.
tests :: M a => Proxy a -> Test
tests a = TestCase (assertEqual "foo" (foo (cons 0 `asProxyTypeOf` a)) "foo")
proxy
We can also generalize that type, as the Proxy is not actually being needed as a value. It's just a way of making a type variable non-ambiguous. You need to redefine asProxyTypeOf though. This is mostly a matter of style compared to the previous one. Being able to use more values as potential proxies can make some code more concise, sometimes at the cost of readability.
-- proxy is a type variable of kind * -> *
tests :: M a => proxy a -> Test
tests a = TestCase (assertEqual "foo" (foo (cons 0 `asProxyTypeOf` a)) "foo")
where
asProxyTypeOf :: a -> proxy a -> a
asProxyTypeOf = const
Scoped type variables
The function asProxyTypeOf, or your (==) trick are really a product of the inability to refer to a type variable from a signature. This is in fact allowed by the ScopedTypeVariables+RankNTypes extensions.
Explicit quantification brings the variable a into scope in the body of the function.
tests :: forall a proxy. M a => proxy a -> Test
tests _ = TestCase (assertEqual "foo" (foo (cons 0 :: a)) "foo") -- the "a" bound by the top-level signature.
Without the ScopedTypeVariables extension, cons 0 :: a would be interpreted as cons 0 :: forall a. a instead.
Here's how you use these functions:
main = runTestTT $ TestList
[ tests (Proxy :: Proxy A)
, tests (Proxy :: Proxy B)
]
Type applications
Since GHC 8, the AllowAmbiguousTypes+TypeApplications extensions make the Proxy argument unnecessary.
tests :: forall a. M a => Test
tests = TestCase (assertEqual "foo" (foo (cons 0 :: a)) "foo") -- the "a" bound by the top-level signature.
main = runTestTT $ TestList
[ tests #A
, tests #B
]
Say, I have a data type
data FooBar a = Foo String Char [a]
| Bar String Int [a]
I need to create values of this type and give empty list as the second field:
Foo "hello" 'a' []
or
Bar "world" 1 []
1) I do this everywhere in my code and I think it would be nice if I could omit the empty list part somehow and have the empty list assigned implicitly. Is this possible? Something similar to default function arguments in other languages.
2) Because of this [] "default" value, I often need to have a partial constructor application that results in a function that takes the first two values:
mkFoo x y = Foo x y []
mkBar x y = Bar x y []
Is there a "better" (more idiomatic, etc) way to do it? to avoid defining new functions?
3) I need a way to add things to the list:
add (Foo u v xs) x = Foo u v (x:xs)
add (Bar u v xs) x = Bar u v (x:xs)
Is this how it is done idiomatically? Just a general purpose function?
As you see I am a beginner, so maybe these questions make little sense. Hope not.
I'll address your questions one by one.
Default arguments do not exist in Haskell. They are simply not worth the added complexity and loss of compositionally. Being a functional language, you do a lot more function manipulation in Haskell, so funkiness like default arguments would be tough to handle.
One thing I didn't realize when I started Haskell is that data constructors are functions just like everything else. In your example,
Foo :: String -> Char -> [a] -> FooBar a
Thus you can write functions for filling in various arguments of other functions, and then those functions will work with Foo or Bar or whatever.
fill1 :: a -> (a -> b) -> b
fill1 a f = f a
--Note that fill1 = flip ($)
fill2 :: b -> (a -> b -> c) -> (a -> c)
--Equivalently, fill2 :: b -> (a -> b -> c) -> a -> c
fill2 b f = \a -> f a b
fill3 :: c -> (a -> b -> c -> d) -> (a -> b -> d)
fill3 c f = \a b -> f a b c
fill3Empty :: (a -> b -> [c] -> d) -> (a -> b -> d)
fill3Empty f = fill3 [] f
--Now, we can write
> fill3Empty Foo x y
Foo x y []
The lens package provides elegant solutions to questions like this. However, you can tell at a glance that this package is enormously complicated. Here is the net result of how you would call the lens package:
_list :: Lens (FooBar a) (FooBar b) [a] [b]
_list = lens getter setter
where getter (Foo _ _ as) = as
getter (Bar _ _ as) = as
setter (Foo s c _) bs = Foo s c bs
setter (Bar s i _) bs = Bar s i bs
Now we can do
> over _list (3:) (Foo "ab" 'c' [2,1])
Foo "ab" 'c' [3,2,1]
Some explanation: the lens function produces a Lens type when given a getter and a setter for some type. Lens s t a b is a type that says "s holds an a and t holds a b. Thus, if you give me a function a -> b, I can give you a function s -> t". That is exactly what over does: you provide it a lens and a function (in our case, (3:) was a function that adds 3 to the front of a List) and it applies the function "where the lens indicates". This is very similar to a functor, however, we have significantly more freedom (in this example, the functor instance would be obligated to change every element of the lists, not operate on the lists themselves).
Note that our new _list lens is very generic: it works equally well over Foo and Bar and the lens package provides many functions other than over for doing magical things.
The idiomatic thing is to take those parameters of a function or constructor that you commonly want to partially apply, and move them toward the beginning:
data FooBar a = Foo [a] String Char
| Bar [a] String Int
foo :: String -> Char -> FooBar a
foo = Foo []
bar :: String -> Int -> FooBar a
bar = Bar []
Similarly, reordering the parameters to add lets you partially apply add to get functions of type FooBar a -> FooBar a, which can be easily composed:
add :: a -> FooBar a -> FooBar a
add x (Foo xs u v) = Foo (x:xs) u v
add123 :: FooBar Int -> FooBar Int
add123 = add 1 . add 2 . add 3
add123 (foo "bar" 42) == Foo [1, 2, 3] "bar" 42
(2) and (3) are perfectly normal and idiomatic ways of doing such things. About (2) in particular, one expression you will occasionally hear is "smart constructor". That just means a function like your mkFoo/mkBar that produces a FooBar a (or a Maybe (FooBar a) etc.) with some extra logic to ensure only reasonable values can be constructed.
Here are some additional tricks that might (or might not!) make sense, depending on what you are trying to do with FooBar.
If you use Foo values and Barvalues in similar ways most of the time (i.e. the difference between having the Char field and the Int one is a minor detail), it makes sense to factor out the similarities and use a single constructor:
data FooBar a = FooBar String FooBarTag [a]
data FooBarTag = Foo Char | Bar Int
Beyond avoiding case analysis when you don't care about the FooBarTag, that allows you to safely use record syntax (records and types with multiple constructors do not mix well).
data FooBar a = FooBar
{ fooBarName :: String
, fooBarTag :: FooBarTag
, fooBarList :: [a]
}
Records allow you to use the fields without having to pattern match the whole thing.
If there are sensible defaults for all fields in a FooBar, you can go one step beyond mkFoo-like constructors and define a default value.
defaultFooBar :: FooBar a
defaultFooBar = FooBar
{ fooBarName = ""
, fooBarTag = Bar 0
, fooBarList = []
}
You don't need records to use a default, but they allow overriding default fields conveniently.
myFooBar = defaultFooBar
{ fooBarTag = Foo 'x'
}
If you ever get tired of typing long names for the defaults over and over, consider the data-default package:
instance Default (FooBar a) where
def = defaultFooBar
myFooBar = def { fooBarTag = Foo 'x' }
Do note that a significant number of people do not like the Default class, and not without reason. Still, for types which are very specific to your application (e.g. configuration settings) Default is perfectly fine IMO.
Finally, updating record fields can be messy. If you end up annoyed by that, you will find lens very useful. Note that it is a big library, and it might be a little overwhelming to a beginner, so take a deep breath beforehand. Here is a small sample:
{-# LANGUAGE TemplateHaskell #-} -- At the top of the file. Needed for makeLenses.
import Control.Lens
-- Note the underscores.
-- If you are going to use lenses, it is sensible not to export the field names.
data FooBar a = FooBar
{ _fooBarName :: String
, _fooBarTag :: FooBarTag
, _fooBarList :: [a]
}
makeLenses ''FooBar -- Defines lenses for the fields automatically.
defaultFooBar :: FooBar a
defaultFooBar = FooBar
{ _fooBarName = ""
, _fooBarTag = Bar 0
, _fooBarList = []
}
-- Using a lens (fooBarTag) to set a field without record syntax.
-- Note the lack of underscores in the name of the lens.
myFooBar = set fooBarTag (Foo 'x') defaultFooBar
-- Using a lens to access a field.
myTag = view fooBarTag myFooBar -- Results in Foo 'x'
-- Using a lens (fooBarList) to modify a field.
add :: a -> FooBar a -> FooBar a
add x fb = over fooBarList (x :) fb
-- set, view and over have operator equivalents, (.~). (^.) and (%~) respectively.
-- Note that (^.) is flipped with respect to view.
Here is a gentle introduction to lens which focuses on aspects I have not demonstrated here, specially in how nicely lenses can be composed.
Given a datatype
data Foo = IFoo Int | SFoo String deriving (Data, Typeable)
what is a simple definition of
gconstr :: (Typeable a, Data t) => a -> t
such that
gconstr (5 :: Int) :: Foo == IFoo 5
gconstr "asdf" :: Foo == SFoo "asdf"
gconstr True :: Foo == _|_
It would be essentially the opposite of syb's gfindtype.
Or does such a thing exist already? I've tried hoogle-ing the type and haven't found much, but the syb types are kind of hard to interpret. A function returning Nothing on error is also acceptable.
This seems to be possible, though it's not completely trivial.
Preliminaries:
{-# LANGUAGE DeriveDataTypeable #-}
import Control.Monad ( msum )
import Data.Data
import Data.Maybe
First a helper function gconstrn, which tries to do the same thing as required of gconstr, but for a specific constructor only:
gconstrn :: (Typeable a, Data t) => Constr -> a -> Maybe t
gconstrn constr arg = gunfold addArg Just constr
where
addArg :: Data b => Maybe (b -> r) -> Maybe r
addArg Nothing = Nothing
addArg (Just f) =
case cast arg of
Just v -> Just (f v)
Nothing -> Nothing
The key part is that the addArg function will use arg as an argument to the constructor, if the types match.
Essentially gunfold starts unfolding with Just IFoo or Just SFoo, and then the next step is to try addArg to provide it with its argument.
For multi-argument constructors this would be called repeatedly, so if you defined an IIFoo constructor that took two Ints, it would also get successfully filled in by gconstrn. Obviously with a bit more work you could do something more sophisticated like providing a list of arguments.
Then it's just a question of trying this with all possible constructors. The recursive definition between result and dt is just to get the right type argument for dataTypeOf, the actual value being passed in doesn't matter at all. ScopedTypeVariables would be an alternative for achieving this.
gconstr :: (Typeable a, Data t) => a -> Maybe t
gconstr arg = result
where result = msum [gconstrn constr arg | constr <- dataTypeConstrs dt]
dt = dataTypeOf (fromJust result)
As discussed in the comments, both functions can be simplified with <*> from Control.Applicative to the following, though it's a bit harder to see what's going on in the gunfold:
gconstr :: (Typeable a, Data t) => a -> Maybe t
gconstr arg = result
where
result = msum $ map (gunfold (<*> cast arg) Just) (dataTypeConstrs dt)
dt = dataTypeOf (fromJust result)
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.