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.
Related
I suspect I have a fundamental misunderstanding to be corrected, so will start with the general concept and then zoom in on the particular instance that lead me to think this way.
Generally speaking, is it possible to write a function whose type signature has a parameterised type, and take different action depending on whether the type parameter belongs to a typeclass?
So for example if you had
data MyTree a = Node { val :: a, left :: Maybe (MyTree a), right :: Maybe (MyTree a) }
prettyPrint :: MyTree a -> String
prettyPrint (Show a => ...) t = show (val t)
prettyPrint t = show "?"
where prettyPrint $ Node 'x' Nothing Nothing would print x while prettyPrint $ Node id Nothing Nothing would print ?.
What lead me here is a few instances where I'm working on a complex, parameterised data type (eg. MyTree), which is progressing fine until I need to do some debugging. When I insert trace statements I find myself wishing my data type parameter derived Show when I use test (Showable) data. But I understand one should never add typeclass constraints in data declarations as the wonderfully enlightening LYAH puts it. That makes sense, I shouldn't have to artificially restrict my data type simply because I want to debug it.
So I end up adding the typeclass constraints to the code I'm debugging instead, but quickly discover they spread like a virus. Every function that calls the low level function I'm debugging also needs the constraint added, until I've basically just temporarily added the constraint to every function so I can get enough test coverage. Now my test code is polluting the code I'm trying to develop and steering it off course.
I thought it would be nice to pattern match instead and leave the constraint out of the signature, or use polymorphism and define debug versions of my function, or otherwise somehow wrap my debug traces in a conditional that only fires if the type parameter is an instance of Show. But in my meandering I couldn't find a way to do this or a sensible alternative.
A good mindset is that from the compiler's point of view, every type is potentially an instance of every class. When a type is not an instance of Show, it just means the instance has not been found yet, possibly not been written yet, but not that it doesn't exist.
Approach 1
...Therefore, trying to make a decision based on whether or not a type is an instance of a class is indeed quite fundamentally flawed. However, what you can do is to write a class that explicitly makes this distinction. For Show this could simply be
class MaybeShow a where
showIfPossible :: a -> Maybe a
A generalizable version is to wrap the following around the Show class:
{-# LANGUAGE GADTs #-}
data ShowDict a where
ShowDict :: Show a => ShowDict a
class MaybeShow a where
maybeShowDict :: Maybe (ShowDict a)
and then
{-# LANGUAGE TypeApplications, ScopedTypeVariables, UnicodeSyntax #-}
showIfPossible :: ∀ a . MaybeShow a => Maybe (a -> String)
showIfPossible = fmap (\ShowDict -> show) (maybeShowDict #a)
Either way, this would still mean you have the MaybeShow constraint polluting your codebase – which is in a sense better than Show as it doesn't preclude unshowable types, but in a sense also worse because it requires adding instance for all the types you need to use (even if they already have a Show instance).
Approach 2
You already seem to have considered adding the constraint to the data type instead. And although the old syntax data Show a => MyTree a = ... should indeed never be used, it is possible to encapsulate instances in data. In fact I already did it above with ShowDict. Rather than obtaining that implicitly via a MaybeShow constraint, you can also just add it optionally to your data type:
data MyTree a = Node { val :: a
, showable :: Maybe (ShowDict a)
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a) }
Of course, if all you're using the Show instance for is for showing the val of this specific node, then you could instead also just put the result right there:
data MyTree a = Node { val :: a
, valDescription :: Maybe (String)
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a) }
Now of course you're polluting your codebase in a different way: every function that generates a MyTree value needs to procure a Show instance, or decide it can't. This likely has less of an impact though, and especially not if MyTree is only an example and you have many more functions that just work on abstract containers instead.
Approach 3
At least for the specific case of debugging, but also some other use cases, it might be best use a separate means of turning the Show requirement on and off. The most brute-force way is a good old preprocessor flag:
{-# LANGUAGE CPP #-}
#define DEBUGMODE
-- (This could be controlled from your Cabal file)
prettyPrint ::
#ifdef DEBUGMODE
Show a =>
#endif
MyTree a -> String
#ifdef DEBUGMODE
prettyPrint (Show a => ...) t = show (val t)
#else
prettyPrint t = show "?"
#endif
A bit more refined is a constraint synonym and fitting debug function, that can be swapped out in just a single place:
{-# LANGUAGE ConstraintKinds #-}
#ifdef DEBUGMODE
type DebugShow a = Show a
debugShow :: DebugShow a => a -> String
debugShow = show
#else
type DebugShow a = ()
debugShow :: DebugShow a => a -> String
debugShow _ = "?"
#else
PrettyPrint :: DebugShow a => MyTree a -> String
PrettyPrint t = debugShow (val t)
The latter again pollutes the codebase with constraints, but you never need to write any new instances for these.
CPP is quite a blunt tool, in that it requires selecting globally during compilation whether or not you want to require Show. But it can also be done more confined, with a dedicated type-level flag:
{-# LANGUAGE TypeFamilies, DataKinds #-}
data DebugMode = NoDebug | DebugShowRequired
type family DebugShow mode a where
DebugShow 'NoDebug a = ()
DebugShow 'DebugShowRequired a = Show a
class KnownDebugMode (m :: DebugMode) where
debugShow :: DebugShow m a => a -> String
instance KnownDebugMode 'NoDebug where
debugShow _ = "?"
instance KnownDebugMode 'DebugShowRequired where
debugShow = show
{-# LANGUAGE AllowAmbiguousTypes #-}
prettyPrint :: ∀ m a . DebugShow m a => MyTree a -> String
prettyPrint t = debugShow (val t)
This looks a lot like approach 1, but the nice thing is that you don't need any new instances for individual a types.
The way to use prettyPrint now is to specify the debug mode with a type application. For example you could extract debug- and production-specific versions thus:
prettyPrintDebug :: Show a => MyTree a -> String
prettyPrintDebug = prettyPrint #('DebugShowRequired)
prettyPrintProduction :: MyTree a -> String
prettyPrintProduction = prettyPrint #('NoDebug)
I think the simplest approach is to explicitly define overlapping instances for the unshowable types you want. As #leftaroundabout pointed out this solution forces you to define instances for potencially many many types, for example a -> b, IO a, State s a, Maybe (a -> b), etc...
I am assuming that you mostly want to show a tree of type MyTree (a -> b). If that's the case this might do the trick
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
data MyTree a =
Node { val :: a
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a)
} deriving (Show, Functor) -- The functor instance is just a easy way to map every val to "?", but is not strictly necessary for this problem
-- Create a class for pretty printing. The is a package which already provides it
class Pretty a where
prettyprint :: a -> String
-- Define an instance when the inner type is showable. (here is simply show, but that's up to you)
instance Show a => Pretty (MyTree a) where
prettyprint = show
-- Define an instance for the function type.
-- Notice that this isn't an instance for "non-showable" types,
-- but only for the function type.
-- The overlapping is necessary to distinguish from the previous instance
instance {-# OVERLAPPING #-} Pretty (MyTree (a -> b)) where
prettyprint = show . fmap (const "?")
main = do
putStrLn
$ prettyprint
$ Node (1 :: Int)
(Just $ Node 2 Nothing Nothing)
Nothing
putStrLn
$ prettyprint
$ Node id
(Just $ Node (+ 1) Nothing Nothing)
Nothing
-- outputs
> Node {val = 1, left = Just (Node {val = 2, left = Nothing, right = Nothing}), right = Nothing}
> Node {val = "?", left = Just (Node {val = "?", left = Nothing, right = Nothing}), right = Nothing}
See the plugin if-instance: https://www.reddit.com/r/haskell/comments/x9k5fl/branching_on_constraints_ifinstance_applications/
{-# Options_GHC -fplugin=IfSat.Plugin #-}
import Data.Constraint.If (IfSat, ifSat)
prettyPrint :: IfSat (Show a) => a -> String
prettyPrint x = ifSat #(Show a) (show x) "?"
This is rarely what you want and if used incorrectly can be used to write unsafeCoerce, but this plugin is a recent development and it's good to keep in your back pocket. Previous solutions required a lot more boilerplate.
OP here. The other answers resoundingly answer the question I asked. After quite some time digesting them and experimenting, I've arrived at a particular solution to my particular fundamental goal, which satisfies me.
It certainly not general or sophisticated. But for me it's a great workaround, so I wanted to leave some breadcrumbs for others:
First I use the CPP trick to define two different trace wrappers, so I don't need to use show in the non-debug code:
{-# LANGUAGE CPP #-}
#define DEBUG
#ifdef DEBUG
import Debug.Trace ( trace )
type Traceable = Char
dTrace :: (Show a) => a -> b -> b
dTrace traceable expr = trace (show traceable) expr
#else
dTrace :: a -> b -> b
dTrace _ expr = expr
#endif
Similarly, I then define two different data types. Both are deriving (Show) but only the debug version actually results in something that will satisfy show.
data MyTree a = Node {
#ifdef DEBUG
val :: Traceable
#else
val :: a
#endif
, left :: Maybe (MyTree a)
, right :: Maybe (MyTree a)
} deriving (Show)
And that's it, the pollution stops there. Everything is controlled by the DEBUG define and the rest of the code remains unperturbed:
workOnTree :: MyTree a -> MyTree a
workOnTree t = dTrace t $ t{left=Just t}
go = workOnTree $ Node 'x' Nothing Nothing
main :: IO ()
main = putStrLn [val go]
If I combine the three code sections and compile with #define DEBUG, it outputs:
Node {val = 'x', left = Nothing, right = Nothing}
x
And with #define DEBUG commented out (and no other changes!), I get:
x
and Node will happily accept non-showable values for val.
Even without the CPP stuff (which, even as a long time fan of the C preprocessor, I can understand is not to all tastes), this is pretty manageable. At the least you could just manually swap a few lines to switch between testing and production.
I'm writing a compiler where I'm using GADTs for my IR but standard data types for my everything else. I'm having trouble during the conversion from the old data type to the GADT. I've attempted to recreate the situation with a smaller/simplified language below.
To start with, I have the following data types:
data OldLVal = VarOL Int -- The nth variable. Can be used to construct a Temp later.
| LDeref OldLVal
data Exp = Var Int -- See above
| IntT Int32
| Deref Exp
data Statement = AssignStmt OldLVal Exp
| ...
I want to convert these into this intermediate form:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
-- Note: this is a Phantom type
data Temp a = Temp Int
data Type = IntT
| PtrT Type
data Command where
Assign :: NewLVal a -> Pure a -> Command
...
data NewLVal :: Type -> * where
VarNL :: Temp a -> NewLVal a
DerefNL :: NewLVal ('PtrT ('Just a)) -> NewLVal a
data Pure :: Type -> * where
ConstP :: Int32 -> Pure 'IntT
ConstPtrP :: Int32 -> Pure ('PtrT a)
VarP :: Temp a -> Pure a
At this point, I just want to write a conversion from the old data type to the new GADT. For right now, I have something that looks like this.
convert :: Statement -> Either String Command
convert (AssignStmt oldLval exp) = do
newLval <- convertLVal oldLval -- Either String (NewLVal a)
pure <- convertPure exp -- Either String (Pure b)
-- return $ Assign newLval pure -- Obvious failure. Can't ensure a ~ b.
pure' <- matchType newLval pure -- Either String (Pure a)
return $ Assign newLval pure'
-- Converts Pure b into Pure a. Should essentially be a noop, but simply
-- proves that it is possible.
matchType :: NewLVal a -> Pure b -> Either String (Pure a)
matchType = undefined
I realized that I couldn't write convert trivially, so I attempted to solve the problem using this idea of matchType which acts as a proof that these two types are indeed equal. The question is: how do I actually write matchType? This would be much easier if I had fully dependent types (or so I'm told), but can I finish this code here?
An alternative to this would be to somehow provide newLval as an argument to convertPure, but I think that essentially is just attempting to use dependent types.
Any other suggestions are welcome.
If it helps, I also have a function that can convert an Exp or OldLVal to its type:
class Typed a where
typeOf :: a -> Type
instance Typed Exp where
...
instance Typed OldLVal where
...
EDIT:
Thanks to the excellent answers below, I've been able to finish writing this module.
I ended up using the singletons package mentioned below. It was a little strange at first, but I found it pretty reasonable to use after I started understanding what I was doing. However, I did run into one pitfall: The type of convertLVal and convertPure requires an existential to express.
data WrappedPure = forall a. WrappedPure (Pure a, SType a)
data WrappedLVal = forall a. WrappedLVal (NewLVal a, SType a)
convertPure :: Exp -> Either String WrappedPure
convertLVal :: OldLVal -> Either String WrappedLVal
This means that you'll have to unwrap that existential in convert, but otherwise, the answers below show you the way. Thanks so much once again.
You want to perform a comparison at runtime on some type level data (namely the Types by which your values are indexed). But by the time you run your code, and the values start to interact, the types are long gone. They're erased by the compiler, in the name of producing efficient code. So you need to manually reconstruct the type level data that was erased, using a value which reminds you of the type you'd forgotten you were looking at. You need a singleton copy of Type.
data SType t where
SIntT :: SType IntT
SPtrT :: SType t -> SType (PtrT t)
Members of SType look like members of Type - compare the structure of a value like SPtrT (SPtrT SIntT) with that of PtrT (PtrT IntT) - but they're indexed by the (type-level) Types that they resemble. For each t :: Type there's precisely one SType t (hence the name singleton), and because SType is a GADT, pattern matching on an SType t tells the type checker about the t. Singletons span the otherwise strictly-enforced separation between types and values.
So when you're constructing your typed tree, you need to track the runtime STypes of your values and compare them when necessary. (This basically amounts to writing a partially verified type checker.) There's a class in Data.Type.Equality containing a function which compares two singletons and tells you whether their indexes match or not.
instance TestEquality SType where
-- testEquality :: SType t1 -> SType t2 -> Maybe (t1 :~: t2)
testEquality SIntT SIntT = Just Refl
testEquality (SPtrT t1) (SPtrT t2)
| Just Refl <- testEquality t1 t2 = Just Refl
testEquality _ _ = Nothing
Applying this in your convert function looks roughly like this:
convert :: Statement -> Either String Command
convert (AssignStmt oldLval exp) = do
(newLval, newLValSType) <- convertLVal oldLval
(pure, pureSType) <- convertPure exp
case testEquality newLValSType pureSType of
Just Refl -> return $ Assign newLval pure'
Nothing -> Left "type mismatch"
There actually aren't a whole lot of dependently typed programs you can't fake up with TypeInType and singletons (are there any?), but it's a real hassle to duplicate all of your datatypes in both "normal" and "singleton" form. (The duplication gets even worse if you want to pass singletons around implicitly - see Hasochism for the details.) The singletons package can generate much of the boilerplate for you, but it doesn't really alleviate the pain caused by duplicating the concepts themselves. That's why people want to add real dependent types to Haskell, but we're a good few years away from that yet.
The new Type.Reflection module contains a rewritten Typeable class. Its TypeRep is GADT-like and can act as a sort of "universal singleton". But programming with it is even more awkward than programming with singletons, in my opinion.
matchType as written is not possible to implement, but the idea you are going for is definitely possible. Do you know about Data.Typeable? Typeable is a class that provides some basic reflective operations for inspecting types. To use it, you need a Typeable a constraint in scope for any type variable a you want to know about. So for matchType you would have
matchType :: (Typeable a, Typeable b) => NewLVal a -> Pure b -> Either String (Pure a)
It needs also to infect your GADTs any time you want to hide a type variable:
data Command where
Assign :: (Typeable a) => NewLVal a -> Pure a -> Command
...
But if you have the appropriate constraints in scope, you can use eqT to make type-safe runtime type comparisons. For example
-- using ScopedTypeVariables and TypeApplications
matchType :: forall a b. (Typeable a, Typeable b) => NewLVal a -> Pure b -> Either String (Pure b)
matchType = case eqT #a #b of
Nothing -> Left "types are not equal"
Just Refl -> {- in this scope the compiler knows that
a and b are the same type -}
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 love Lens library and I love how it works, but sometimes it introduces so many problems, that I regret I ever started using it. Lets look at this simple example:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data Data = A { _x :: String, _y :: String }
| B { _x :: String }
makeLenses ''Data
main = do
let b = B "x"
print $ view y b
it outputs:
""
And now imagine - we've got a datatype and we refactor it - by changing some names. Instead of getting error (in runtime, like with normal accessors) that this name does not longer apply to particular data constructor, lenses use mempty from Monoid to create default object, so we get strange results instead of error. Debugging something like this is almost impossible.
Is there any way to fix this behaviour? I know there are some special operators to get the behaviour I want, but all "normal" looking functions from lenses are just horrible. Should I just override them with my custom module or is there any nicer method?
As a sidenote: I want to be able to read and set the arguments using lens syntax, but just remove the behaviour of automatic result creating when field is missing.
It sounds like you just want to recover the exception behavior. I vaguely recall that this is how view once worked. If so, I expect a reasonable choice was made with the change.
Normally I end up working with (^?) in the cases you are talking about:
> b ^? y
Nothing
If you want the exception behavior you can use ^?!
> b ^?! y
"*** Exception: (^?!): empty Fold
I prefer to use ^? to avoid partial functions and exceptions, similar to how it is commonly advised to stay away from head, last, !! and other partial functions.
Yes, I too have found it a bit odd that view works for Traversals by concatenating the targets. I think this is because of the instance Monoid m => Applicative (Const m). You can write your own view equivalent that doesn't have this behaviour by writing your own Const equivalent that doesn't have this instance.
Perhaps one workaround would be to provide a type signature for y, so know know exactly what it is. If you had this then your "pathological" use of view wouldn't compile.
data Data = A { _x :: String, _y' :: String }
| B { _x :: String }
makeLenses ''Data
y :: Lens' Data String
y = y'
You can do this by defining your own view1 operator. It doesn't exist in the lens package, but it's easy to define locally.
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
data Data = A { _x :: String, _y :: String }
| B { _x :: String }
makeLenses ''Data
newtype Get a b = Get { unGet :: a }
instance Functor (Get a) where
fmap _ (Get x) = Get x
view1 :: LensLike' (Get a) s a -> s -> a
view1 l = unGet . l Get
works :: Data -> String
works = view1 x
-- fails :: Data -> String
-- fails = view1 y
-- Bug.hs:23:15:
-- No instance for (Control.Applicative.Applicative (Get String))
-- arising from a use of ‘y’
Let's start with the following
data A = A String deriving Show
data B = B String deriving Show
class X a where
spooge :: a -> Q
[ Some implementations of X for A and B ]
Now let's say we have custom implementations of show and read, named show' and read' respectively which utilize Show as a serialization mechanism. I want show' and read' to have types
show' :: X a => a -> String
read' :: X a => String -> a
So I can do things like
f :: String -> [Q]
f d = map (\x -> spooge $ read' x) d
Where data could have been
[show' (A "foo"), show' (B "bar")]
In summary, I wanna serialize stuff of various types which share a common typeclass so I can call their separate implementations on the deserialized stuff automatically.
Now, I realize you could write some template haskell which would generate a wrapper type, like
data XWrap = AWrap A | BWrap B deriving (Show)
and serialize the wrapped type which would guarantee that the type info would be stored with it, and that we'd be able to get ourselves back at least an XWrap... but is there a better way using haskell ninja-ery?
EDIT
Okay I need to be more application specific. This is an API. Users will define their As, and Bs and fs as they see fit. I don't ever want them hacking through the rest of the code updating their XWraps, or switches or anything. The most i'm willing to compromise is one list somewhere of all the A, B, etc. in some format. Why?
Here's the application. A is "Download a file from an FTP server." B is "convert from flac to mp3". A contains username, password, port, etc. information. B contains file path information. There could be MANY As and Bs. Hundreds. As many as people are willing to compile into the program. Two was just an example. A and B are Xs, and Xs shall be called "Tickets." Q is IO (). Spooge is runTicket. I want to read the tickets off into their relevant data types and then write generic code that will runTicket on the stuff read' from the stuff on disk. At some point I have to jam type information into the serialized data.
I'd first like to stress for all our happy listeners out there that XWrap is a very good way, and a lot of the time you can write one yourself faster than writing it using Template Haskell.
You say you can get back "at least an XWrap", as if that meant you couldn't recover the types A and B from XWrap or you couldn't use your typeclass on them. Not true! You can even define
separateAB :: [XWrap] -> ([A],[B])
If you didn't want them mixed together, you should serialise them seperately!
This is nicer than haskell ninja-ery; maybe you don't need to handle arbitrary instances, maybe just the ones you made.
Do you really need your original types back? If you feel like using existential types because you just want to spooge your deserialised data, why not either serialise the Q itself, or have some intermediate data type PoisedToSpooge that you serialise, which can deserialise to give you all the data you need for a really good spooging. Why not make it an instance of X too?
You could add a method to your X class that converts to PoisedToSpooge.
You could call it something fun like toPoisedToSpooge, which trips nicely off the tongue, don't you think? :)
Anyway this would remove your typesystem complexity at the same time as resolving the annoying ambiguous type in
f d = map (\x -> spooge $ read' x) d -- oops, the type of read' x depends on the String
You can replace read' with
stringToPoisedToSpoogeToDeserialise :: String -> PoisedToSpooge -- use to deserialise
and define
f d = map (\x -> spooge $ stringToPoisedToSpoogeToDeserialise x) -- no ambiguous type
which we could of course write more succincly as
f = map (spooge.stringToPoisedToSpoogeToDeserialise)
although I recognise the irony here in suggesting making your code more succinct. :)
If what you really want is a heterogeneous list then use existential types. If you want serialization then use Cereal + ByteString. If you want dynamic typing, which is what I think your actual goal is, then use Data.Dynamic. If none of this is what you want, or you want me to expand please press the pound key.
Based on your edit, I don't see any reason a list of thunks won't work. In what way does IO () fail to represent both the operations of "Download a file from an FTP server" and "convert from flac to MP3"?
I'll assume you want to do more things with deserialised Tickets
than run them, because if not you may as well ask the user to supply a bunch of String -> IO()
or similar, nothing clever needed at all.
If so, hooray! It's not often I feel it's appropriate to recommend advanced language features like this.
class Ticketable a where
show' :: a -> String
read' :: String -> Maybe a
runTicket :: a -> IO ()
-- other useful things to do with tickets
This all hinges on the type of read'. read' :: Ticket a => String -> a isn't very useful,
because the only thing it can do with invalid data is crash.
If we change the type to read' :: Ticket a => String -> Maybe a this can allow us to read from disk and
try all the possibilities or fail altogether.
(Alternatively you could use a parser: parse :: Ticket a => String -> Maybe (a,String).)
Let's use a GADT to give us ExistentialQuantification without the syntax and with nicer error messages:
{-# LANGUAGE GADTs #-}
data Ticket where
MkTicket :: Ticketable a => a -> Ticket
showT :: Ticket -> String
showT (MkTicket a) = show' a
runT :: Ticket -> IO()
runT (MkTicket a) = runTicket a
Notice how the MkTicket contstuctor supplies the context Ticketable a for free! GADTs are great.
It would be nice to make Ticket and instance of Ticketable, but that won't work, because there would be
an ambiguous type a hidden in it. Let's take functions that read Ticketable types and make them read
Tickets.
ticketize :: Ticketable a => (String -> Maybe a) -> (String -> Maybe Ticket)
ticketize = ((.).fmap) MkTicket -- a little pointfree fun
You could use some unusual sentinel string such as
"\n-+-+-+-+-+-Ticket-+-+-+-Border-+-+-+-+-+-+-+-\n" to separate your serialised data or better, use separate files
altogether. For this example, I'll just use "\n" as the separator.
readTickets :: [String -> Maybe Ticket] -> String -> [Maybe Ticket]
readTickets readers xs = map (foldr orelse (const Nothing) readers) (lines xs)
orelse :: (a -> Maybe b) -> (a -> Maybe b) -> (a -> Maybe b)
(f `orelse` g) x = case f x of
Nothing -> g x
just_y -> just_y
Now let's get rid of the Justs and ignore the Nothings:
runAll :: [String -> Maybe Ticket] -> String -> IO ()
runAll ps xs = mapM_ runT . catMaybes $ readTickets ps xs
Let's make a trivial ticket that just prints the contents of some directory
newtype Dir = Dir {unDir :: FilePath} deriving Show
readDir xs = let (front,back) = splitAt 4 xs in
if front == "dir:" then Just $ Dir back else Nothing
instance Ticketable Dir where
show' (Dir p) = "dir:"++show p
read' = readDir
runTicket (Dir p) = doesDirectoryExist p >>= flip when
(getDirectoryContents >=> mapM_ putStrLn $ p)
and an even more trivial ticket
data HelloWorld = HelloWorld deriving Show
readHW "HelloWorld" = Just HelloWorld
readHW _ = Nothing
instance Ticketable HelloWorld where
show' HelloWorld = "HelloWorld"
read' = readHW
runTicket HelloWorld = putStrLn "Hello World!"
and then put it all together:
myreaders = [ticketize readDir,ticketize readHW]
main = runAll myreaders $ unlines ["HelloWorld",".","HelloWorld","..",",HelloWorld"]
Just use Either. Your users don't even have to wrap it themselves. You have your deserializer wrap it in the Either for you. I don't know exactly what your serialization protocol is, but I assume that you have some way to detect which kind of request, and the following example assumes the first byte distinguishes the two requests:
deserializeRequest :: IO (Either A B)
deserializeRequest = do
byte <- get1stByte
case byte of
0 -> do
...
return $ Left $ A <A's fields>
1 -> do
...
return $ Right $ B <B's fields>
Then you don't even need to type-class spooge. Just make it a function of Either A B:
spooge :: Either A B -> Q