I have the following type family in haskell :
type family Foo (a :: Bar) :: * where
followed by a bunch of equality. I want to put a constraint on the kind return to ensure they're all instance of a typeclass. How can i do that ?
Seems like you're looking for
class (YourConstraint (Foo a)) => Fooish (a :: Bar) where
type Foo a :: Type
As Carl noted, this is somewhat analogous to the old data declaration style with
data C a => D a = D ...
which is widely considered a bad idea because it's not possible to use the constraint, all it accomplishes is preventing to build values that don't obey the constraint.
But unlike those data declarations, a constraint to an associated type family is useful IMO, because there's an easy way to get at the constrait whenever it's needed: you just need to mention Fooish.
In Haskell, it's better not to do that. (See also the desire to put constraints on type variables in data declarations.) You should put constraints where they're actually going to be used. That will still get called out during type checking if it's missing when it's needed, but it will allow things that don't need it to be more flexible.
Related
I can separate functions from nullary values with a type family like this:
type family Funs (ts :: [*]) :: [*]
where
Funs '[ ] = '[ ]
Funs ((a -> b): ts) = (a -> b): Funs ts
Funs (k: ts) = Funs ts
What I would like is to separate types that satisfy a constraint, for instance Show. An attempt by analogy:
type family Showable (ts :: [*]) :: [*]
where
Showable '[ ] = '[ ]
Showable ((Show a => a): ts) = a: Showable ts
Showable (k: ts) = Showable ts
— Leads to an error:
• Illegal qualified type: Show a => a
• In the equations for closed type family ‘Showable’
In the type family declaration for ‘Showable’
|
35 | Showable ((Show a => a): ts) = a: Showable ts
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
What can be done? I am fine with a solution that uses Template Haskell, or lowly hackery of any sort.
I don't believe that it is possible to do this easily (without TH) because of the open-world assumption: GHC basically will never resolve the negative of a class constraint, because there might be more instances somewhere that make it true (and don't play nicely with the separate compilation strategy that GHC/Haskell uses). So, it is not generally possible to---from pure "regular" Haskell code---decide whether or not a type has a class instance, and so whether or not to include it in the list.
If you are willing to slightly break separate compilation, by only considering instances that are in scope when the module that you are working on is compiled (i.e. that are in scope in that module's source file), you can use Template Haskell or GHC typechecker plugins to get something very much like this behavior. I know of a couple of implementations doing something similar at the value level, including ifcxt and constraints-emerge. I believe that these libraries, especially ifcxt (which I am slightly more familiar with) are quite simple: you can use the TH function reify to get a ClassI Info for a particular typeclass, and use its [InstanceDec] field to get a list of all instances that are in scope during compilation. Then you can basically make one branch for each concrete type instance that adds the instance head to the list, and follow it up with one catch-all branch that will not. You may also need to do this recursively to deal with instances that have constraints themselves.
Notice that if you choose to use this approach, this will break the open-world assumption in potentially confusing ways: if a module imports the type-level filter module, and then defines a datatype/instance, the type-level filter will not be aware of the new instance, and will continue to treat the type as if it does not have an instance. You will need to make sure that all instances that you care about are in scope when you use TH to generate the filter type family.
If you want to improve this somewhat, you can use an approach even more like IfCxt where instead of creating the type family instances directly, you might be able to do something like this:
class IsShow (a :: Type) (b :: Bool) where
instance {-# OVERLAPPABLE #-} (b ~ 'False) => IsShow a b where
And you have your TH generate instances like:
instance IsShow Int 'True where
This has the advantage that if another module defines important types/instances, you should be able to use (roughly) the same TH to extend the instances of IsShow with these new instances, and your type families that use IsShow should be fine. The ifcxt package linked above does basically the same thing, but instead of doing the necessary trickery to get the information at the type level, it just generates functions to get it at the value level.
This solution uses a class with functional dependencies instead of a type family because OverlappingInstances makes it possible to give the class-based solution a "default case". I'm not sure whether there's any reasonable way to give an open type family a default case, so you might not be able to get this "extensibility" while using type families everywhere (instead of fundep'd instances).
Richard Eisenberg says
With separate compilation, the lack of ordering and the overlap check are necessary for type soundness.
So I think it may be impossible. There are also some interesting discussions around type families vs. fundeps here: https://typesandkinds.wordpress.com/2015/09/09/what-are-type-families/
Suppose i have some type like:
newtype Foo a b = Foo { getFoo :: SomeStructure b }
I.e. a is a phantom type used only for compile-time checks.
However, I don't want to use the phantom type everywhere. It's not universally useful in my code. So I would like to do something like:
type FooUnrestricted b = Foo Anything b
What should I use in place of Anything? Do I need some language extensions?
Edit: I realized I could simply use () and it would answer my question. But the actual point is that I have functions that place constraints on a and I would like them to be always satisfied.
One option is to use an existential type:
data UnrestrictedFoo b where
Unrestricted :: Foo a b -> UnrestrictedFoo b
In some other contexts, it may make sense to use a rank 2 type instead.
newtype UnrestrictedFoo b = UnrestrictedFoo (forall a . Foo a b)
You're probably looking for undefined at type level to make a stub for types. This was already discussed here:
Undefined at the type level
So you can define your own data type and make instances for it of any type classes you use. If you want to lower number of instances you need to implement, you can use some standard data types like Void or even Proxy (). The latter is better because it has more instances.
http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Void.html
http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Proxy.html
I agree that () is the best type to use here, as it conveys that you don't care about the type, but if you want it to satisfy your code constraints, you could newtype it and derive the needed instances trivially when you need them.
Does Haskell, or a specific compiler, have anything like type-level lambdas (if that's even a term)?
To elaborate, say I have a parametrized type Foo a b and want Foo _ b to be an instance of, say, Functor. Is there any mechanism that would let me do something akin to
instance Functor (\a -> Foo a b) where
...
?
While sclv answered your direct question, I'll add as an aside that there's more than one possible meaning for "type-level lambda". Haskell has a variety of type operators but none really behave as proper lambdas:
Type constructors: Abstract type operators that introduce new types. Given a type A and a type constructor F, the function application F A is also a type but carries no further (type level) information than "this is F applied to A".
Polymorphic types: A type like a -> b -> a implicitly means forall a b. a -> b -> a. The forall binds the type variables within its scope, thus behaving somewhat like a lambda. If memory serves me this is roughly the "capital lambda" in System F.
Type synonyms: A limited form of type operators that must be fully applied, and can produce only base types and type constructors.
Type classes: Essentially functions from types/type constructors to values, with the ability to inspect the type argument (i.e., by pattern matching on type constructors in roughly the same way that regular functions pattern match on data constructors) and serving to define a membership predicate on types. These behave more like a regular function in some ways, but are very limited: type classes aren't first-class entities that can be manipulated, and they operate on types only as input (not output) and values only as output (definitely not input).
Functional dependencies: Along with some other extensions, these allow type classes to implicitly produce types as results as well, which can then be used as the parameters to other type classes. Still very limited, e.g. by being unable to take other type classes as arguments.
Type families: An alternate approach to what functional dependencies do; they allow functions on types to be defined in a manner that looks much closer to regular value-level functions. The usual restrictions still apply, however.
Other extensions relax some of the restrictions mentioned, or provide partial workarounds (see also: Oleg's type hackery). However, pretty much the one thing you can't do anywhere in any way is exactly what you were asking about, namely introduce new a binding scope with an anonymous function abstraction.
From TypeCompose:
newtype Flip (~>) b a = Flip { unFlip :: a ~> b }
http://hackage.haskell.org/packages/archive/TypeCompose/0.6.3/doc/html/Control-Compose.html#t:Flip
Also, if something is a Functor in two arguments, you can make it a bifunctor:
http://hackage.haskell.org/packages/archive/category-extras/0.44.4/doc/html/Control-Bifunctor.html
(or, in a later category-extras, a more general version: http://hackage.haskell.org/packages/archive/category-extras/0.53.5/doc/html/Control-Functor.html#t:Bifunctor)
I don't like the idea of answering my own question, but apparently, according to several people on #haskell on Freenode, Haskell doesn't have type-level lambdas.
EHC (and perhaps also its successor, UHC) has type-level lambdas, but they are undocumented and not as powerful as in a dependently-typed language. I recommend you use a dependently-typed language such as Agda (similar to Haskell) or Coq (different, but still pure functional at its core, and can be interpreted and compiled either lazily or strictly!) But I'm biased towards such languages, and this is probably 100x overkill for what you are asking for here!
The closest I know of to get a type lambda is by defining a type synonym. In your example,
data Foo a b = Foo a b
type FooR a b = Foo b a
instance Functor (FooR Int) where
...
But even with -XTypeSynonymInstances -XFlexibleInstances this doesn't work; GHC expects the type syn to be fully applied in the instance head. There may be some way to arrange it with type families.
Yeah, what Gabe said, which is somewhat answered by type families:
http://www.haskell.org/haskellwiki/GHC/Type_families
Depending on the situation, you could replace your original type definition with a "flipped" version, and then make a type synonym for the "correct" version.
From
data X a b = Y a b
instance Functor (\a -> X a b) where ...
to
data XFlip b a = Y a b -- Use me for instance decalarations
type X a b = XFlip b a -- Use me for everything else
instance Functor XFlip where ...
Since type variables cannot hold poly-types, it seems that with Rank*Types we cannot re-use existing functions because of their monotype restriction.
For example, we cannot use the function (.) when the intermediate type is a polytype. We are forced to re-implement (.) at the spot. This is of course trivial for (.) but a problem for more substantial bodies of code.
I also think making ((f . g) x) not equivalent to (f (g x)) a severe blow to referential transparency and its benefits.
It seems to me to be a show-stopper issue, and seems to make the Rank*Types extensions almost impractical for wide-spread use.
Am I missing something? Is there a plan to make Rank*Types interact better with the rest of the type-system?
EDIT: How can you make the types of (runST . forever) work out?
The most recent proposal for Rank-N types is Don's linked FPH paper. In my opinion it's also the nicest of the bunch. The main goal of all these systems is to require as few type annotations as possible. The problem is that when going from Hindley/Milner to System F we lose principal types and type inference becomes undecidable – hence the need for type annotations.
The basic idea of the "boxy types" work is to propagate type annotations as far as possible. The type checker switches between type checking and type inference mode and hopefully no more annotations are required. The downside here is that whether or not a type annotation is required is hard to explain because it depends on implementation details.
Remy's MLF system is so far the nicest proposal; it requires the least amount of type annotations and is stable under many code transformations. The problem is that it extends the type system. The following standard example illustrates this:
choose :: forall a. a -> a -> a
id :: forall b. b -> b
choose id :: forall c. (c -> c) -> (c -> c)
choose id :: (forall c. c -> c) -> (forall c. c -> c)
Both the above types are admissable in System F. The first one is the standard Hindley/Milner type and uses predicative instantiation, the second one uses impredicative instantiation. Neither type is more general than the other, so type inference would have to guess which type the user wants, and that is usually a bad idea.
MLF instead extends System F with bounded quantification. The principal (= most general) type for the above example would be:
choose id :: forall (a < forall b. b -> b). a -> a
You can read this as "choose id has type a to a where a must be an instance of forall b. b -> b".
Interestingly, this alone is no more powerful than standard Hindley/Milner. MLF therefore also allows rigid quantification. The following two types are equivalent:
(forall b. b -> b) -> (forall b. b -> b)
forall (a = forall b. b -> b). a -> a
Rigid quantification is introduced by type annotations and the technical details are indeed quite complicated. The upside is that MLF only needs very few type annotations and there is a simple rule for when they are needed. The downsides are:
Types can become harder to read, because the right hand side of '<' can contain further nested quantifications.
Until recently no explicitly typed variant of MLF existed. This is important for typed compiler transformations (like GHC does). Part 3 of Boris Yakobowski's PhD thesis has a first attempt at such a variant. (Parts 1 & 2 are also interesting; they describe a more intuitive representation of MLF via "Graphical Types".)
Coming back to FPH, its basic idea is to use MLF techniques internally, but to require type annotations on let bindings. If you only want the Hindley/Milner type, then no annotations are necessary. If you want a higher-rank type, you need to specify the requested type, but only at the let (or top-level) binding.
FPH (like MLF) supports impredicative instantiation, so I don't think your issue applies. It should therefore have no issue typing your f . g expression above. However, FPH hasn't been implemented in GHC yet and most likely won't be. The difficulties come from the interaction with equality coercions (and possibly type class constraints). I'm not sure what the latest status is, but I heard that SPJ wants to move away from impredicativity. All that expressive power comes at a cost, and so far no affordable and all-accompanying solution has been found.
Is there a plan to make Rank*Types interact better with the rest of the type-system?
Given how common the ST monad is, at least Rank2 types are common enough to be evidence to the contrary. However, you might look at the "sexy/boxy types" series of papers, for how approaches to making arbitrary rank polymorphism play better with others.
FPH : First-class Polymorphism for Haskell, Dimitrios Vytiniotis, Stephanie Weirich, and Simon Peyton Jones, submitted to ICFP 2008.
See also -XImpredicativeTypes -- which interestingly, is slated for deprecation!
About ImpredicativeTypes: that doesn't actually make a difference (I'm relatively sure) to peaker's question. That extension has to do with datatypes. For instance, GHC will tell you that:
Maybe :: * -> *
(forall a. a -> a) :: *
However, this is sort of a lie. It's true in an impredicative system, and in such a system, you can write:
Maybe (forall a. a -> a) :: *
and it will work fine. That is what ImpredicativeTypes enables. Without the extension, the appropriate way to think about this is:
Maybe :: *m -> *m
(forall a :: *m. a -> a) :: *p
and thus there is a kind mismatch when you try to form the application above.
GHC is fairly inconsistent on the impredicativity front, though. For instance, the type for id I gave above would be:
id :: (forall a :: *m. a -> a)
but GHC will gladly accept the annotation (with RankNTypes enabled, but not ImpredicativeTypes):
id :: (forall a. a -> a) -> (forall a. a -> a)
even though forall a. a -> a is not a monotype. So, it will allow impredicative instantiation of quantified variables that are used only with (->) if you annotate as such. But it won't do it itself, I guess, which leads to the runST $ ... problems. That used to be solved with an ad-hoc instantiation rule (the details of which I was never particularly clear on), but that rule was removed not long after it was added.
Firstly, this question isn't 100% specific to Haskell, feel free to comment on the general design of typeclasses, interfaces and types.
I'm reading LYAH - creating types and typeclasses The following is the passage that I'm looking for more information on:
Data (Ord k) => Map k v = ...
However, it's a very strong convention
in Haskell to never add typeclass
constraints in data declarations. Why?
Well, because we don't benefit a lot,
but we end up writing more class
constraints, even when we don't need
them. If we put or don't put the Ord k
constraint in the data declaration for
Map k v, we're going to have to put
the constraint into functions that
assume the keys in a map can be
ordered. But if we don't put the
constraint in the data declaration, we
don't have to put (Ord k) => in the
type declarations of functions that
don't care whether the keys can be
ordered or not. An example of such a
function is toList, that just takes a
mapping and converts it to an
associative list. Its type signature
is toList :: Map k a -> [(k, a)]. If
Map k v had a type constraint in its
data declaration, the type for toList
would have to be toList :: (Ord k) =>
Map k a -> [(k, a)], even though the
function doesn't do any comparing of
keys by order.
This at first, seems logical -- but isn't there an upside to having the typeclass attached to the type? If the typeclass is the behavior of the type, then why should the behavior be defined by the use of the type (through functions), and not the type itself? I assume there is some meta-programming that could make use of it, and it is certainly nice and descriptive code-documentation. Conversely, would this be a good idea in other languages? Would it be ideal to specify the interface the object should conform to on the method, such that if the method isn't used by the caller the object doesn't have to conform to the interface? Moreover, why can Haskell not infer that a function using type Foo, has to pull in the typeclass constraints identified in type Foo's declaration? Is there a pragma to enable this?
The first time I read it, it conjured a "that's a hack (or workaround) response". On second read with some thought, it sounded clever. On third read, drawing a compairison to the OO world, it sounded like a hack again.
So here I am.
Perhaps Map k v wasn't the best example to illustrate the point. Given the definition of Map, even though there are some functions that won't need the (Ord k) constraint, there is no possible way to construct a Map without it.
One often finds that a type is quite usable with the sub-set of functions that work on without some particular constraint, even when you envisioned the constraint as an obvious aspect of your original design. In such cases, having left the constraint off the type declaration leaves it more flexible.
For example, Data.List contains plenty of functions that require (Eq a), but of course lists are perfectly useful without that constraint.
The short answer is: Haskell does this because that's how the language spec is written.
The long answer involves quoting from the GHC documentation language extensions section:
Any data type that can be declared in standard Haskell-98 syntax can also be declared using GADT-style syntax. The choice is largely stylistic, but GADT-style declarations differ in one important respect: they treat class constraints on the data constructors differently. Specifically, if the constructor is given a type-class context, that context is made available by pattern matching. For example:
data Set a where
MkSet :: Eq a => [a] -> Set a
(...)
All this behaviour contrasts with Haskell 98's peculiar treatment of contexts on a data type declaration (Section 4.2.1 of the Haskell 98 Report). In Haskell 98 the definition
data Eq a => Set' a = MkSet' [a]
gives MkSet' the same type as MkSet above. But instead of making available an (Eq a) constraint, pattern-matching on MkSet' requires an (Eq a) constraint! GHC faithfully implements this behaviour, odd though it is. But for GADT-style declarations, GHC's behaviour is much more useful, as well as much more intuitive.
The main reason to avoid typeclass constraints in data declarations is that they accomplish absolutely nothing; in fact, I believe GHC refers to such a class context as the "stupid context". The reason for this is that the class dictionary is not carried around with the values of the data type, so you have to add it to every function operating on the values anyway.
As a way of "forcing" the typeclass constraint on functions operating on the data type, it also doesn't really accomplish anything; functions should generally be as polymorphic as possible, so why force the constraint onto things that don't need it?
At this point, you might think that it should be possible to change the semantics of ADTs in order to carry the dictionary around with the values. In fact, it seems like this is the whole point of GADTs; for example, you can do:
data Foo a where { Foo :: (Eq a) => a -> Foo a }
eqfoo :: Foo t -> Foo t -> Bool
eqfoo (Foo a) (Foo b) = a == b
Notice that the type of eqfoo does not need the Eq constraint, as it is "carried" by the Foo data type itself.
I would like to point out that if you are worried that one could construct an object that requires constraints for its operations but doesn't for its creation, say mkFoo, you can always artifically put the constraint on the mkFoo function to enforce the use of the typeclass by people who use the code. The idea also extends to non mkFoo type functions that operate on Foo. Then when defining the module, don't export anything that doesn't enforce the constraints.
Though I have to admit, I don't see any use for this.