The following does not work in Haskell-
{-# LANGUAGE GADTs, DataKinds, TypeFamilies, UndecidableInstances,
RankNTypes, PolyKinds #-}
import Data.Kind
data Payload :: (f :: a -> Type) -> (e :: a) -> Type where
MkPayload :: (e :: a) -> (t :: f e) -> Payload f e
payload :: Payload f e -> f e
payload (MkPayload e t) = t
• Expecting one more argument to ‘f :: a -> Type’
Expected a type, but ‘f :: a -> Type’ has kind ‘a -> Type’
• In the kind ‘(f :: a -> Type) -> (e :: a) -> Type’
In the data type declaration for ‘Payload’
|
6 | data Payload :: (f :: a -> Type) -> (e :: a) -> Type where
| ^^^^^^^^^^^^^^
Is there any other way someone can define dependent types in Haskell?
You cannot use that _ :: _ notation in types as you might be used to from Agda. Instead just leave the names out and just write the types:
{-# LANGUAGE GADTs, DataKinds, TypeFamilies, UndecidableInstances,
RankNTypes, PolyKinds #-}
import Data.Kind ( Type )
data Payload :: (a -> Type) -> a -> Type where
MkPayload :: a -> f e -> Payload f e
payload :: Payload f e -> f e
payload (MkPayload e t) = t
That CUSK (complete user specified kind) notation is discouraged, instead you should use standalone kind signatures:
{-# LANGUAGE GADTs, DataKinds, TypeFamilies, UndecidableInstances,
RankNTypes, PolyKinds, StandaloneKindSignatures #-}
import Data.Kind ( Type )
type Payload :: (a -> Type) -> a -> Type
data Payload f e where
MkPayload :: a -> f e -> Payload f e
payload :: Payload f e -> f e
payload (MkPayload e t) = t
Leaving out the names does mean you lose some expressivity, but that isn't required for this example. There are techniques to recover most of that expressivity such as singletons that David Young mentioned.
Related
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)
In my application I have a type definition that looks like this:
{-# LANGUAGE ExistentialQuantification #-}
class C a where
data A = forall a. C a => A { unA :: a }
I most definitely want the kind signature A :: Type.
I would like to generalize over the class constraint, like so:
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Kind (Type, Constraint)
class C a where
data A' (c :: Type -> Constraint) where
A' :: forall a. c a => { unA :: a } -> A' c
type A = A' C
Note that A should be isomorphic to the A as defined in the beginning.
However GHC (8.6.5) rejects the generalized definition:
generalize.hs:11:19: error: Not in scope: type variable ‘c’
|
11 | A' :: forall a. c a => { unA :: a } -> A' c
| ^
generalize.hs:11:45: error: Not in scope: type variable ‘c’
|
11 | A' :: forall a. c a => { unA :: a } -> A' c
| ^
I don't understand the error, since I did enable ScopedTypeVariables.
Am I missing something obvious, or is what I'm trying to do not possible? If so, why not?
You got it almost right, what you want is
data HasConstraint (c :: Type -> Constraint) where
Pack :: forall (c :: Type -> Constraint) a . c a => { unPack :: a } -> HasConstraint c
so you have to include c as inside your constructor type signature as well because it's completely separate from the data declaration for GADTs.
I imagine you'd want to use it like this:
instance Show (HasConstraint Show) where show (Pack x) = show x
show (Pack 10 :: HasConstraint Show) -- => "10"
You could also write
withPacked :: forall (c :: Type -> Constraint) b. (forall a. c a => a -> b) -> HasConstraint c -> b
withPacked f (Pack x) = f x
withPacked #Show show (Pack 10) -- => "10"
I'm not sure if there's much else you can do with this though.
(Note that the "getter" unPack here actually isn't usable with GADTs either, you'll always have to pattern match on the constructor if you want to actually unpack things).
I wrote some code that takes a Heterogeneous List and indexes it.
{-# Language GADTs, FunctionalDependencies, MultiParamTypeClasses, KindSignatures, DataKinds, TypeOperators, FlexibleInstances, UndecidableInstances #-}
import Data.Kind
data Nat = Z | S Nat
data Natural a where
Zero :: Natural 'Z
Succ :: Natural a -> Natural ('S a)
data HList a where
EmptyList :: HList '[]
Cons :: a -> HList b -> HList (a ': b)
class IndexType (n :: Nat) (a :: [Type]) (b :: Type) | n a -> b where
index :: (Natural n) -> (HList a) -> b
instance IndexType 'Z (a ': b) a where
index _ (Cons a _) = a
instance IndexType a b c => IndexType ('S a) (d ': b) c where
index (Succ a) (Cons _ b) = index a b
To do this I implemented my own Nat and Natural types. The Nat exists solely to elevate to the Kind level and Natural exists to fulfill the kind Nat -> Type.
Now I would prefer to use GHC.TypeLits' Nat kind rather than my own however when I try to translate my code over I start to hit a wall in terms of understanding.
I want to build my IndexType class and the declaration line doesn't change any
class IndexType (n :: Nat) (a :: [Type]) (b :: Type) | n a -> b where
Since GHC.TypeLits also has its own Nat kind. However GHC.TypeLits doesn't have a replacement for Natural that I see, namely I lack something of the kind Nat -> Type. Now I could build an equivalent
data Natural a = Natural
But this is essentially equivalent the Proxy type so I could just use that instead.
{-# Language GADTs, FunctionalDependencies, MultiParamTypeClasses, KindSignatures, DataKinds, TypeOperators, FlexibleInstances, UndecidableInstances #-}
import Data.Kind
import GHC.TypeLits
import Data.Proxy
data HList a where
EmptyList :: HList '[]
Cons :: a -> HList b -> HList (a ': b)
class IndexType (n :: Nat) (a :: [Type]) (b :: Type) | n a -> b where
index :: (Proxy n) -> (HList a) -> b
Now the first instance of the IndexType class is easy enough:
instance IndexType 0 (a ': b) a where
index _ (Cons a _) = a
However the second one starts to puzzle me. The first line seems as if it would be
instance IndexType a b c => IndexType (1 + a) (d ': b) c where
However on the second line I don't know how to replace the Succ in the original code. The data constructor for Proxy is Proxy so I suppose it must use that constructor so I must write something like:
index Proxy (Cons _ b) = index a b
But now I'm pulling the definition of a out of thin air. I suppose it has to be another Proxy since index takes a Proxy, but I don't know how to force it to be the correct type.
How about this?
class IndexType (n :: Nat) (a :: [Type]) (c :: Type) | n a -> c where
index :: (Proxy n) -> (HList a) -> c
instance IndexType 0 (a ': b) a where
index _ (Cons a _) = a
instance {-# OVERLAPS #-} (IndexType (a-1) b c) => IndexType a (d ': b) c where
index _ (Cons _ b) = index (Proxy #(a-1)) b
This will use some extra extensions including ScopedTypeVariables and TypeApplications. PoC (tested on GHC 8.2.2):
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Foo where
import Data.Kind
import GHC.TypeLits
import Data.Proxy
data HList a where
EmptyList :: HList '[]
Cons :: a -> HList b -> HList (a ': b)
class IndexType (n :: Nat) (a :: [Type]) (c :: Type) | n a -> c where
index :: (Proxy n) -> (HList a) -> c
instance IndexType 0 (a ': b) a where
index _ (Cons a _) = a
instance {-# OVERLAPS #-} (IndexType (a-1) b c) => IndexType a (d ': b) c where
index _ (Cons _ b) = index (Proxy #(a-1)) b
list :: HList '[Int, Bool]
list = Cons (5 :: Int) (Cons True EmptyList)
int :: Int
int = index (Proxy #0) list
bool :: Bool
bool = index (Proxy #1) list
I am reading the Rank-N-Types section of 24 days of GHC Extensions and came across the following GADT:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
import Data.Char
data Some :: * -> * where
SomeInt :: Int -> Some Int
SomeChar :: Char -> Some Char
Anything :: a -> Some a
unSome :: Some a -> a
unSome (SomeInt x) = x + 3
unSome (SomeChar c) = toLower c
unSome (Anything x) = x
unSome (someInt 2) -- 5
Although unSome is polymorphic in its type variables one can give the compiler proof that in the SomeInt case for instance, it is safe to add three to the given value. The author calls this type refinement.
Now I was curious whether I can do the same with a Scrott encoded type. Fortunately, there is an example of such encoding. We merely need the Rank-N-Types and Type-Families extensions turned on:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
newtype SomeC a =
SomeC {
runSomeC ::
forall r.
((a ~ Int) => Int -> r) ->
((a ~ Char) => Char -> r) ->
(a -> r) ->
r
}
However, unSome isn't provided in the article. I am not well-versed in Haskell and don't have a clue how to implement this function with Scott encoding. Especially the type equality constraints (e.g. (a ~ Int) =>) confuse me.
Any help or information on other online sources are appreciated.
You just use the provided function to replace your pattern match, as in:
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
import Data.Char
newtype SomeC a =
SomeC {
runSomeC ::
forall r.
((a ~ Int) => Int -> r) ->
((a ~ Char) => Char -> r) ->
(a -> r) ->
r
}
unSome :: SomeC a -> a
unSome (SomeC f) = f (\x -> x+3) (\c -> toLower c) (\x -> x)
In ghci:
> unSome (SomeC (\someInt someChar anything -> someInt 2))
5
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.