The monomorphic library contains the following snippet (which should hopefully compile in 7.8):
{-# LANGUAGE DataKinds, ExistentialQuantification, FlexibleContexts, GADTs #-}
{-# LANGUAGE ImpredicativeTypes, PolyKinds, RankNTypes, TypeFamilies #-}
{-# LANGUAGE TypeOperators, UndecidableInstances #-}
class Monomorphicable k where
type MonomorphicRep k :: *
withPolymorphic :: Monomorphicable k
=> MonomorphicRep k -> (forall a. k a -> b) -> b
withPolymorphic k trans = undefined
-- | Flipped version of 'withPolymorphic'.
liftPoly :: Monomorphicable k
=> (forall a. k a -> b) -> MonomorphicRep k -> b
liftPoly = flip withPolymorphic
However in 7.10, GHC complains:
Couldn't match type ‘k2 a0 -> b’ with ‘forall (a :: k0). k1 a -> b’
Expected type: MonomorphicRep k2 -> (k2 a0 -> b) -> b
Actual type: MonomorphicRep k1
-> (forall (a :: k0). k1 a -> b) -> b
Relevant bindings include
liftPoly :: (forall (a :: k). k2 a -> b) -> MonomorphicRep k2 -> b
(bound at Data/Type/Monomorphic.hs:45:1)
In the first argument of ‘flip’, namely ‘withPolymorphic’
In the expression: flip withPolymorphic
Of course if I changed the definition of liftPoly to
liftPoly a b = withPolymorphic b a
then 7.10 is happy. What's going on here? Is 7.10 supposed to be stricter when dealing with polymorphic functions somehow? It doesn't appear to be the monomorphism restriction since everything has a signature.
The type of flip is
flip :: (x -> y -> z) -> (y -> x -> z)
To type check liftPoly, we have to instantiate the variable y at the polymorphic type forall a. k a -> b. This is an instance of impredicative polymorphism.
As the page at https://ghc.haskell.org/trac/ghc/wiki/ImpredicativePolymorphism says,
We've made various attempts to support impredicativity, so there is a flag -XImpredicativeTypes. But it doesn't work, and is absolutely unsupported. If you use it, you are on your own; I make no promises about what will happen.
So, don't be too surprised when the behavior of ImpredicativeTypes changes between versions of GHC.
Related
Let's say for the purposes of this question I want to make an alias of coerce. I start with the obvious
import Data.Coerce
q = coerce
a bit surprisingly this gives rise an error:
coerce.hs:3:5: error:
• Couldn't match representation of type ‘a0’ with that of ‘b0’
arising from a use of ‘coerce’
• In the expression: coerce
In an equation for ‘q’: q = coerce
• Relevant bindings include q :: a0 -> b0 (bound at coerce.hs:4:1)
|
4 | q = coerce
| ^^^^^^
This error is quite opaque so I slapped the type signature1 of coerce onto q:
{-# Language RankNTypes #-}
{-# Language KindSignatures #-}
{-# Language PolyKinds #-}
import Data.Coerce
import GHC.Exts
q :: forall (k :: RuntimeRep) (a :: TYPE k) (b :: TYPE k). Coercible a b => a -> b
q = coerce
But this gives rise to the error:
coerce.hs:8:5: error:
Cannot use function with levity-polymorphic arguments:
coerce :: a -> b
Levity-polymorphic arguments: a :: TYPE k
|
8 | q = coerce
| ^^^^^^
This error is not very helpful. It informs me there is an issue with levity polymorphism and that is about it.
What is really quite curious to me is that when I make q bottom:
{-# Language RankNTypes #-}
{-# Language KindSignatures #-}
{-# Language PolyKinds #-}
import Data.Coerce
import GHC.Exts
q :: forall (k :: RuntimeRep) (a :: TYPE k) (b :: TYPE k). Coercible a b => a -> b
q = q
The error goes away and the code compiles fine.
I'm left unsure whether such an alias is possible, or what even the issue with the alias is.
Is such an alias possible where q maintains the type of coerce? What issue is the compiler running into with my code?
1: As pointed out by the comments this type signature only has levity polymorphism in since base-4.13 or ghc 8.8. For the purposes of this question we want the levity polymorphism.
#dfeuer's answer covers a workaround, but I think issue #17670 explains why this is happening. Because coerce is a primop, it must be fully saturated, so any use is implicitly eta-expanded. When you write:
q = coerce
you're really writing:
q = \x -> coerce x
The initial error message you get is actually a result of the monomorphism restriction. If you write either:
q x = coerce x
or add the NoMonomorphismRestriction extension, the program is accepted. Unfortunately, the resulting q isn't levity polymorphic. It's instantiated with lifted types.
If try to force the issue by adding an appropriate polymorphic type signature:
q :: forall (k :: RuntimeRep) (a :: TYPE k) (b :: TYPE k). Coercible a b => a -> b
q = coerce
then bleeding edge versions of GHC (e.g., "8.11" built from source last month) give an elaborated error message:
BadCoerce.hs:11:5: error:
Cannot use function with levity-polymorphic arguments:
coerce :: a -> b
(Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
are eta-expanded internally because they must occur fully saturated.
Use -fprint-typechecker-elaboration to display the full expression.)
Levity-polymorphic arguments: a :: TYPE k
Ultimately, you're running up against the prohibition that no variable (in this case an implicit variable introduced to eta-expand coerce) is permitted to be levity polymorphic. The reason q = q works is that there's no eta expansion and so no variable involved. Try q x = q x and it will fail with "a levity-polymorphic type is not allowed here" error message.
It doesn't look like this is possible, but you can get really close. Note: it may well be possible to shorten this.
blop
:: forall (k :: RuntimeRep) (a :: TYPE k) (b :: TYPE k) q r.
Coercible a b
=> q :~: (a -> a)
-> r :~: (a -> b)
-> Coercion q r
blop Refl Refl = Coercion
bloverce
:: forall (k :: RuntimeRep) (a :: TYPE k) (b :: TYPE k) q r.
Coercible a b
=> q :~: (a -> a)
-> r :~: (a -> b)
-> q -> r
bloverce qaa rab = case blop qaa rab of Coercion -> coerce
gloerce
:: forall (r :: RuntimeRep).
(forall (x :: TYPE r). x -> x) -> Coe r
gloerce kid = Coe (bloverce Refl Refl (kid :: a -> a) :: forall (a :: TYPE r) (b :: TYPE r). Coercible a b => a -> b)
newtype Coe (r :: RuntimeRep) = Coe (forall (a :: TYPE r) (b :: TYPE r). Coercible a b => a -> b)
As long as you can provide the polymorphic identity function for a certain runtime representation, you can use gloerce to get its coerce.
Of course, this is all fairly silly in practice: in the rare cases when you need a representation-polymorphic coercion function, you can just use coerce directly.
I'm writing a distributed programming DSL and I'd like to allow implementations to choose their serialization method (if any, as it might not even be needed for a simulated execution).
Trying to solve this by adding a type family led to the problem below for a standard function I have. I imagine that it would work if I could require, and have the type checker understand, that if two values are serializable their pairing is also serializable. However, adding that as a quantified constraint doesn't seem to work. Can this be solved or is there a better solution for the problem?
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Kind
class (Monad (DistrM t)) => Distributed (t :: *) where
type Sendable t :: * -> Constraint
type DistrM t :: * -> *
-- ...
data FromSendable t a where
FromSendable :: (Sendable t b)
=> (b -> DistrM t a)
-> b
-> FromSendable t a
pairWith :: ( Sendable t a
, Distributed t
, forall a b. (Sendable t a, Sendable t b) => Sendable t (a,b)
)
=> a
-> FromSendable t b
-> FromSendable t (a,b)
pairWith a (FromSendable f b) =
FromSendable (\(a,b) -> (a,) <$> f b) (a,b)
-- >>> Could not deduce: Sendable t (a1, b1) ...
Edit 1
It type checks if I do
pairWith :: ( Sendable t a
, Distributed t
, st ~ Sendable t
, forall a b. (st a, st b) => st (a,b)
)
=> ...
It would get cumbersome to have to repeat these types of constraints, so I tried a type synonym but that doesn't work:
type Cs t = forall (st :: * -> Constraint).
(Sendable t ~ st, forall a b. (st a, st b) => st (a,b))
-- >>> Expected a constraint, but ‘st (a, b)’ has kind ‘*’
This looks weird. I only have a partial answer, but I'll post it anyway.
I simplified your code to
class C t where -- (*)
data T t where
T :: C t => (a -> t) -> a -> T t
foo ::
( C u
, forall a b . (C a , C b) => C (a, b) )
=> u -> T t -> T (u, t)
foo i (T f x) = T (\(a,b) -> (a, f b)) (i, x)
and, in this version, it compiles fine. However, if we replace
class C t where
with
type instance C :: * -> Constraint
then we get an error telling us that C (a, b) can not be deduced.
I can't completely understand what's going on here, but it looks like quantified constraints do not mix well with type families.
It looks like the above type family is treated like it were
type instance C (t :: *) :: Constraint
and in such case, I can't understand what's wrong. Since C now does not refer to a single type class, it is impossible to implement a quantified constraint like forall a b . (C a , C b) => C (a, b) by (say) passing a pointer to a specific instance, since the three C constraints could be anything at all, in an open world.
I still do not understand why type family C :: * -> Constraint is handled in the same way.
Perhaps GHC should reject quantified constraints involving type families ... -> Constraint in such way? I not sure.
I think you've pushed your code to the edges of GHC's type system here. You can fix the kind error on Cs by writing:
type Cs t = (forall (st :: * -> Constraint).
(Sendable t ~ st, forall a b. (st a, st b) => st (a,b))) :: Constraint
but then you run up against "GHC doesn't yet support impredicative polymorphism". Until GHC adds support for class families as per issue 14860, you're maybe out of luck with this approach.
However, you did ask about alternative approaches. Doesn't making Sendable t a a multiparameter type class accomplish basically the same thing?
Certainly, the following type-checks:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Kind
class (Monad (DistrM t)) => Distributed (t :: *) where
type DistrM t :: * -> *
-- ...
class Sendable t a where
data FromSendable t a where
FromSendable :: (Sendable t b)
=> (b -> DistrM t a)
-> b
-> FromSendable t a
type Cs t = forall a b. (Sendable t a, Sendable t b) => Sendable t (a,b) :: Constraint
pairWith :: ( Sendable t a
, Distributed t
, Cs t
)
=> a
-> FromSendable t b
-> FromSendable t (a,b)
pairWith a (FromSendable f b) =
FromSendable (\(a,b) -> (a,) <$> f b) (a,b)
Consider the following declarations for a function f' using singletons with the Frames library (which defines UnColumn and AllAre), and a wrapper function using withSing.
{-# LANGUAGE AllowAmbiguousTypes -#}
import Frames
import Data.Singletons.Prelude
f' :: forall rs1 rs2 a. (AllAre a (UnColumn rs1), AllAre a (UnColumn rs2), Num a)
=> SList rs1 -> SList rs2 -> Frame (Record rs1) -> Frame (Record rs2) -> Int
f' = undefined
f df1 df2 = withSing (withSing f') df1 df2
This seems to work fine. But when I add a type annotation, type checking fails with the error Could not deduce: (AllAre a0 (UnColumn rs1), AllAre a0 (UnColumn rs2)).
f :: (SingI rs1, SingI rs2, AllAre a (UnColumn rs2), AllAre a (UnColumn rs1), Num a)
=> Frame (Record rs1) -> Frame (Record rs2) -> Int
f df1 df2 = withSing (withSing f') df1 df2
The thing is, this is precisely the inferred type signature, according to GHCi (well, Intero). To my understanding adding an explicit signature matching the inferred signature should have no impact on the code semantics, so why would this break the code?
As a general rule of thumb, adding an explicit type signature that matches the inferred type to a Haskell program will not change its meaning, but it's not actually guaranteed in the general case. (I believe it is guaranteed for top-level definitions in Haskell98, though.)
Ultimately, your problem isn't much different from the sort of type variable scoping problem that can happen with local definitions in Haskell98:
import Data.List
sortImage :: Ord b => (a -> b) -> [a] -> [a]
sortImage f = sortBy cmp
where cmp x y = compare (f x) (f y)
Here, the inferred type of cmp is effectively (Ord b) => a -> a -> Ordering. You can't make this signature explicit, though, because you can't tie a and b back to the outer signature (and the type of f in particular) unless you use ScopedTypeVariables, in which case you can write:
sortImage :: forall a b . Ord b => (a -> b) -> [a] -> [a]
sortImage f = sortBy cmp
where cmp :: a -> a -> Ordering
cmp x y = compare (f x) (f y)
As you've discovered, you can make this sort of type variable scoping problem happen with top level definitions, too, at least with AllowAmbiguousTypes enabled.
Here is a simpler example that illustrates what I believe is the same problem, adapted from the GHC documentation on the AllowAmbiguousTypes extension:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
class D a b
instance D Bool b
instance D Int b
strange :: D a b => a -> a
strange = undefined
-- stranger :: (D a b1, D a b) => a -> a
stranger x = strange (strange x)
I've shown the inferred type of stranger as a comment. If you try to make it explicit, you'll get the error:
• Could not deduce (D a b0) arising from a use of ‘strange’
from the context: (D a b2, D a b)
The issue is that GHC can infer that stranger can be called on any a that satisfies D a b1 for the outer strange :: D a b1 => a -> a and also satisfies D a b for the inner strange :: D a b => a -> a.
However, if you attempt to make this type signature explicit, the link between the b1 and b variables in the explicit signature for stranger and their relationship to the types of the strange calls is lost, much as the relationship between the a and b in a hypothetical cmp signature and the a and b in the sortImage signature is lost in the first example.
Using ScopedTypeVariables alone isn't enough to solve the problem here because, constraints aside, the type of strange is just a -> a and doesn't directly reference b. So, you can write:
stranger :: forall a b1 b2 . (D a b1, D a b2) => a -> a
stranger x = (strange :: a -> a) ((strange :: a -> a) x)
but you can't tie the b1 and b2 to the types of the strange calls. You need TypeApplications to do that:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
class D a b
instance D Bool b
strange :: forall a b . D a b => a -> a
strange = id
stranger :: forall a b1 b2 . (D a b1, D a b2) => a -> a
stranger x = (strange #a #b1) (strange #a #b2 x)
and then it type checks okay, and you can even call:
> stranger False
False
without any type annotations (which is somewhat surprising). If you had an instance:
instance D Int Double
though, then you'd need to be explicit to use stranger on Ints:
> stranger #_ #Double #Double (1 :: Int)
This is more or the less the functionality I want to implement:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeInType #-}
type family ReturnType arr where
ReturnType (a -> b) = ReturnType b
ReturnType a = a
type family ReplaceReturnType t r where
ReplaceReturnType (a -> b) r = a -> ReplaceReturnType b r
ReplaceReturnType _ r = r
class CollectArgs f where
collectArgs :: ((forall r. ReplaceReturnType f r -> r) -> ReturnType f) -> f
instance CollectArgs f => CollectArgs (a -> f) where
collectArgs :: ((forall r. (a -> ReplaceReturnType f r) -> r) -> ReturnType f) -> a -> f
collectArgs f a = collectArgs (\ap -> f (\k -> ap (k a)))
instance (ReturnType a ~ a, ReplaceReturnType a dummy ~ dummy) => CollectArgs a where
collectArgs :: ((forall r. ReplaceReturnType a r -> r) -> a) -> a
collectArgs f = f id
What I eventually want to do with this is to write functions which are polymorphic in the number of incoming arguments, while they don't have to be part of a type class definition (which would correspond to printf var args style). So, for example:
wrapsVariadicFunction :: (CollectArgs f) => f -> Int -> f
wrapsVariadicFunction f config = collectArgs $ \apply ->
if odd config
then error "odd config... are you nuts?!"
else apply f
Only that the return type of f might not coicide with that of wrapsVariadicFunction.
Now, in a perfect world where I can associate a type class with a closed type family (a closed type class, so to speak), this would be easy to implement, because the connection ReplaceReturnType a r ~ r would be clear.
Since I can't state that connection, it is, quite understandably, not clear to GHC 8.2.1:
* Could not deduce: ReplaceReturnType a r ~ r
from the context: (ReturnType a ~ a,
ReplaceReturnType a dummy ~ dummy)
bound by the instance declaration
`r' is a rigid type variable bound by
a type expected by the context:
forall r. ReplaceReturnType a r -> r
Expected type: ReplaceReturnType a r -> r
Actual type: r -> r
* In the first argument of `f', namely `id'
In the expression: f id
In an equation for `collectArgs': collectArgs f = f id
* Relevant bindings include
f :: (forall r. ReplaceReturnType a r -> r) -> a
collectArgs :: ((forall r. ReplaceReturnType a r -> r) -> a) -> a
|
29 | collectArgs f = f id
|
A solution here would be universally quantifying over dummy in the instance context, but that's not possible (yet, judging from what I saw at ICFP). Also it's really cumbersome.
So, the actual question here is: How do I associate a value-level definition with a closed type family, much like a closed type class? Or is this impossible because types cannot be erased anymore? If so, is there some other workaround?
The standard trick to have these type classes that look like they are overlapping is to add a second parameter to the typeclass which will be distinct in each instance and whose value can be computed from the other ones.
The idea distilled to its very core is as follows (we need some scary extensions like UndecidableInstances but that's fine: we're writing total programs):
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
type family IsBase arr :: Bool where
IsBase (a -> b) = 'False
IsBase a = 'True
class SillyId a b where
sillyId :: IsBase a ~ b => a -> a
instance SillyId b (IsBase b) => SillyId (a -> b) 'False where
sillyId f = \x -> sillyId (f x)
instance SillyId b 'True where
sillyId t = t
Now, in your case it's a bit more complicated because you not only want this extra argument to do the dispatch, you also want other type level functions to reduce based on it. The trick is simply... to define these functions in terms of that dispatch!
Of course a type level Bool won't do anymore: you'll need to keep all of the information around. So instead of IsBase you'll have IsArrow:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
type family IsArrow arr :: Either (*, *) * where
IsArrow (a -> b) = 'Left '(a, b)
IsArrow a = 'Right a
type family ReturnType arr where
ReturnType ('Left '(a, b)) = ReturnType (IsArrow b)
ReturnType ('Right a) = a
type family ReplaceReturnType t r where
ReplaceReturnType ('Left '(a, b)) r = a -> ReplaceReturnType (IsArrow b) r
ReplaceReturnType _ r = r
class CollectArgs f (f' :: Either (*, *) *) where
collectArgs :: IsArrow f ~ f' => ((forall r. ReplaceReturnType f' r -> r) -> ReturnType f') -> f
instance CollectArgs f (IsArrow f) => CollectArgs (a -> f) ('Left '(a, f)) where
collectArgs :: ((forall r. (a -> ReplaceReturnType (IsArrow f) r) -> r) -> ReturnType (IsArrow f)) -> a -> f
collectArgs g a = collectArgs (\ap -> g (\k -> ap (k a)))
instance CollectArgs a ('Right a) where
collectArgs :: IsArrow a ~ 'Right a => ((forall r. ReplaceReturnType (IsArrow a) r -> r) -> a) -> a
collectArgs f = f id
And voilà. You can of course define type synonyms for ReplaceReturnType (IsArrow a) r to make the notations a bit lighter but that's the gist of it.
I'm generalizing this n-ary complement to an n-ary compose, but I'm having trouble making the interface nice. Namely, I can't figure out how to use numeric literals at the type level while still being able to pattern match on successors.
Rolling my own nats
Using roll-my-own nats, I can make n-ary compose work, but I can only pass n as an iterated successor, not as a literal:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module RollMyOwnNats where
import Data.List (genericIndex)
-- import Data.Proxy
data Proxy (n::Nat) = Proxy
----------------------------------------------------------------
-- Stuff that works.
data Nat = Z | S Nat
class Compose (n::Nat) b b' t t' where
compose :: Proxy n -> (b -> b') -> t -> t'
instance Compose Z b b' b b' where
compose _ f x = f x
instance Compose n b b' t t' => Compose (S n) b b' (a -> t) (a -> t') where
compose _ g f x = compose (Proxy::Proxy n) g (f x)
-- Complement a binary relation.
compBinRel :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (Proxy::Proxy (S (S Z))) not
----------------------------------------------------------------
-- Stuff that does not work.
instance Num Nat where
fromInteger n = iterate S Z `genericIndex` n
-- I now have 'Nat' literals:
myTwo :: Nat
myTwo = 2
-- But GHC thinks my type-level nat literal is a 'GHC.TypeLits.Nat',
-- even when I say otherwise:
compBinRel' :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel' = compose (Proxy::Proxy (2::Nat)) not
{-
Kind mis-match
An enclosing kind signature specified kind `Nat',
but `2' has kind `GHC.TypeLits.Nat'
In an expression type signature: Proxy (2 :: Nat)
In the first argument of `compose', namely
`(Proxy :: Proxy (2 :: Nat))'
In the expression: compose (Proxy :: Proxy (2 :: Nat)) not
-}
Using GHC.TypeLits.Nat
Using GHC.TypeLits.Nat, I get type-level nat literals, but there is no successor constructor that I can find, and using the type function (1 +) doesn't work, because GHC (7.6.3) can't reason about injectivity of type functions:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module UseGHCTypeLitsNats where
import GHC.TypeLits
-- import Data.Proxy
data Proxy (t::Nat) = Proxy
----------------------------------------------------------------
-- Stuff that works.
class Compose (n::Nat) b b' t t' where
compose :: Proxy n -> (b -> b') -> t -> t'
instance Compose 0 b b' b b' where
compose _ f x = f x
instance (Compose n b b' t t' , sn ~ (1 + n)) => Compose sn b b' (a -> t) (a -> t') where
compose _ g f x = compose (Proxy::Proxy n) g (f x)
----------------------------------------------------------------
-- Stuff that does not work.
-- Complement a binary relation.
compBinRel , compBinRel' :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (Proxy::Proxy 2) not
{-
Couldn't match type `1 + (1 + n)' with `2'
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
In the expression: compose (Proxy :: Proxy 2) not
In an equation for `compBinRel':
compBinRel = compose (Proxy :: Proxy 2) not
-}
{-
No instance for (Compose n Bool Bool Bool Bool)
arising from a use of `compose'
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there is a potential instance available:
instance Compose 0 b b' b b'
-}
compBinRel' = compose (Proxy::Proxy (1+(1+0))) not
{-
Couldn't match type `1 + (1 + 0)' with `1 + (1 + n)'
NB: `+' is a type function, and may not be injective
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Expected type: Proxy (1 + (1 + 0))
Actual type: Proxy (1 + (1 + n))
In the first argument of `compose', namely
`(Proxy :: Proxy (1 + (1 + 0)))'
-}
I agree that semantic editor combinators are more elegant and more general here -- and concretely, it will always be easy enough to write (.) . (.) . ... (n times) instead of compose (Proxy::Proxy n) -- but I'm frustrated that I can't make the n-ary composition work as well as I expected. Also, it seems I would run into similar problems for other uses of GHC.TypeLits.Nat, e.g. when trying to define a type function:
type family T (n::Nat) :: *
type instance T 0 = ...
type instance T (S n) = ...
UPDATE: Summary and adaptation of the accepted answer
There's a lot of interesting stuff going on in the accepted answer,
but the key for me is the Template Haskell trick in the GHC 7.6
solution: that effectively lets me add type-level literals to my GHC
7.6.3 version, which already had injective successors.
Using my types above, I define literals via TH:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
module RollMyOwnLiterals where
import Language.Haskell.TH
data Nat = Z | S Nat
nat :: Integer -> Q Type
nat 0 = [t| Z |]
nat n = [t| S $(nat (n-1)) |]
where I've moved my Nat declaration into the new module to avoid an
import loop. I then modify my RollMyOwnNats module:
+import RollMyOwnLiterals
...
-data Nat = Z | S Nat
...
+compBinRel'' :: (a -> a -> Bool) -> (a -> a -> Bool)
+compBinRel'' = compose (Proxy::Proxy $(nat 2)) not
Unfortunately your question cannot be answered in principle in the currently released version of GHC (GHC 7.6.3) because of a consistency problem pointed out in the recent message
http://www.haskell.org/pipermail/haskell-cafe/2013-December/111942.html
Although type-level numerals look like numbers they are not guaranteed to behave like numbers at all (and they don't). I have seen Iavor Diatchki and colleagues have implemented proper type level arithmetic in GHC (which as as sound as the SMT solver used as a back end -- that is, we can trust it). Until that version is released, it is best to avoid type level numeric literals, however cute they may seem.
EDIT: Rewrote answer. It was getting a little bulky (and a little buggy).
GHC 7.6
Since type level Nats are somewhat... incomplete (?) in GHC 7.6, the least verbose way of achieving what you want is a combination of GADTs and type families.
{-# LANGUAGE GADTs, TypeFamilies #-}
module Nats where
-- Type level nats
data Zero
data Succ n
-- Value level nats
data N n f g where
Z :: N Zero (a -> b) a
S :: N n f g -> N (Succ n) f (a -> g)
type family Compose n f g
type instance Compose Zero (a -> b) a = b
type instance Compose (Succ n) f (a -> g) = a -> Compose n f g
compose :: N n f g -> f -> g -> Compose n f g
compose Z f x = f x
compose (S n) f g = compose n f . g
The advantage of this particular implementation is that it doesn't use type classes, so applications of compose aren't subject to the monomorphism restriction. For example, compBinRel = compose (S (S Z)) not will type check without type annotations.
We can make this nicer with a little Template Haskell:
{-# LANGUAGE TemplateHaskell #-}
module Nats.TH where
import Language.Haskell.TH
nat :: Integer -> Q Exp
nat 0 = conE 'Z
nat n = appE (conE 'S) (nat (n - 1))
Now we can write compBinRel = compose $(nat 2) not, which is much more pleasant for larger numbers. Some may consider this "cheating", but seeing as we're just implementing a little syntactic sugar, I think it's alright :)
GHC 7.8
The following works on GHC 7.8:
-- A lot more extensions.
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, PolyKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Nats where
import GHC.TypeLits
data N = Z | S N
data P n = P
type family Index n where
Index 0 = Z
Index n = S (Index (n - 1))
-- Compose is defined using Z/S instead of 0, 1, ... in order to avoid overlapping.
class Compose n f r where
type Return n f r
type Replace n f r
compose' :: P n -> (Return n f r -> r) -> f -> Replace n f r
instance Compose Z a b where
type Return Z a b = a
type Replace Z a b = b
compose' _ f x = f x
instance Compose n f r => Compose (S n) (a -> f) r where
type Return (S n) (a -> f) r = Return n f r
type Replace (S n) (a -> f) r = a -> Replace n f r
compose' x f g = compose' (prev x) f . g
where
prev :: P (S n) -> P n
prev P = P
compose :: Compose (Index n) f r => P n -> (Return (Index n) f r -> r) -> f -> Replace (Index n) f r
compose x = compose' (convert x)
where
convert :: P n -> P (Index n)
convert P = P
-- This does not type check without a signature due to the monomorphism restriction.
compBinRel :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (P::P 2) not
-- This is an example where we compose over higher order functions.
-- Think of it as composing (a -> (b -> c)) and ((b -> c) -> c).
-- This will not typecheck without signatures, despite the fact that it has arguments.
-- However, it will if we use the first solution.
appSnd :: b -> (a -> b -> c) -> a -> c
appSnd x f = compose (P::P 1) ($ x) f
However, this implementation has a few downsides, as annotated in the source.
I attempted (and failed) to use closed type families to infer the composition index automatically. It might have been possible to infer higher order functions like this:
-- Given r and f, where f = x1 -> x2 -> ... -> xN -> r, Infer r f returns N.
type family Infer r f where
Infer r r = Zero
Infer r (a -> f) = Succ (Infer r f)
However, Infer won't work for higher order functions with polymorphic arguments. For example:
ghci> :kind! forall a b. Infer a (b -> a)
forall a b. Infer a (b -> a) :: *
= forall a b. Infer a (b -> a)
GHC can't expand Infer a (b -> a) because it doesn't perform an occurs check when matching closed family instances. GHC won't match the second case of Infer on the off chance that a and b are instantiated such that a unifies with b -> a.