Consider the following code:
type CFunctor f = forall x y. (x -> y -> Constraint) -> f x -> f y -> Constraint
type MapList :: CFunctor []
class MapList c xs ys
instance MapList c '[] '[]
instance (c x y, MapList c xs ys) => MapList c (x ': xs) (y ': ys)
This works fine, but it's desirable in some situations to "make things compute" by introducing a functional dependency of the form:
class MapList c xs ys | c xs -> ys
With the functional dependency we have the following code:
type CFunctor f = forall x y. (x -> y -> Constraint) -> f x -> f y -> Constraint
type MapList :: CFunctor []
class MapList c xs ys | c xs -> ys
instance MapList c '[] '[]
instance (c x y, MapList c xs ys) => MapList c (x ': xs) (y ': ys)
This does not compile however, and produces the following error on the last instance:
[typecheck] [E] • Illegal instance declaration for ‘MapList c (x : xs) (y : ys)’
The liberal coverage condition fails in class ‘MapList’
for functional dependency: ‘c xs -> ys’
Reason: lhs types ‘c’, ‘x : xs’
do not jointly determine rhs type ‘y : ys’
Un-determined variable: y
• In the instance declaration for ‘MapList c (x : xs) (y : ys)’
This makes sense: c + xs determines ys due to the recursive use of MapList c xs ys (which has a functional dependency). But c + x ': xs determines c + y ': ys only if x determines y, which is a property we must require of the class being passed in for c.
But how can we adjust the CFunctor kind to demand this? As far as I'm aware there is no vocabulary in kind signatures to discuss functional dependencies. Is there still a way I can make this work?
One workaround is to create a wrapper class that simply demands whatever your original constraint was, plus a functional dependency. The only way to satisfy the functional dependency in the wrapper is to have a functional dependency in the original class.
To wit:
type FDep :: (a -> b -> Constraint) -> a -> b -> Constraint
class c x y => FDep c x y | c x -> y
Now we can write:
type MapList :: CFunctor []
class MapList c xs ys | c xs -> ys
instance MapList (FDep c) '[] '[]
instance (FDep c x y, MapList (FDep c) xs ys) => MapList (FDep c) (x ': xs) (y ': ys)
And have it type check.
When passing in some arrow, e.g.:
class Fst ab a | ab -> a
instance Fst '(a, b) a
We simply instantiate FDep for it as well, to witness the fact that it has the relevant functional dependency:
instance Fst ab a => FDep Fst ab a
Somewhat curiously, our functor mappings are closed with respect to FDep-ness, as illustrated below:
type MapList :: CFunctor []
class MapList c xs ys | c xs -> ys
instance MapList c xs ys => FDep (MapList c) xs ys
instance MapList (FDep c) '[] '[]
instance (FDep c x y, MapList (FDep c) xs ys) => MapList (FDep c) (x ': xs) (y ': ys)
This is nice, because it allows functors to compose arbitrarily. It suggests we are doing some kind of weird Constraint enriched category theory whose objects are kinds, and whose morphisms are functionally dependent classes.
Here is a worked example of using our type level computer:
(^$) :: FDep c x y => Proxy c -> Proxy x -> Proxy y
(^$) _ _ = Proxy
class Fst ab a | ab -> a
instance Fst ab a => FDep Fst ab a
instance Fst '(a, b) a
test :: _
test = Proxy #(MapList (FDep Fst)) ^$ Proxy #'[ '(0, 1)]
The type hole error that results is:
[typecheck] [E] • Found type wildcard ‘_’ standing for ‘Proxy '[0]’
To use the inferred type, enable PartialTypeSignatures
• In the type signature: test :: _
Related
With the answer to this question I was able to define a list in witch the length is part of the type:
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
data Nat = Z | S Nat
data ListF (n :: Nat) a where
Nil :: (ListF 'Z a)
Cons :: a -> ListF m a -> ListF ('S m) a
I would like be able to convert a normal list in to these kind of list. If a make these:
toListF :: [a] -> ListF n a
toListF [] = Nil
toListF (x:xs) = Cons x (toListF xs)
It does't type-check, because for [a] -> ListF n a to type-check, the function should return any Nat that the caller needs:
ListF.hs:11:14: error:
• Couldn't match type ‘n’ with ‘'Z’
‘n’ is a rigid type variable bound by
the type signature for:
toListF :: forall a (n :: Nat). [a] -> ListF n a
at ListF.hs:10:1-27
Expected type: ListF n a
Actual type: ListF 'Z a
• In the expression: Nil
In an equation for ‘toListF’: toListF [] = Nil
• Relevant bindings include
toListF :: [a] -> ListF n a (bound at ListF.hs:11:1)
|
11 | toListF [] = Nil
| ^^^
Failed, no modules loaded.
The logical type for toListF I think it wold be something like exists n. [a] -> ListF n a or [a] -> (exists n. ListF n a), but of course those are not valid haskell types.
It is possible to do what I am trying to do in haskell? And how?
There are existential types in Haskell.
{-# LANGUAGE DataKinds, GADTs, KindSignatures, RankNTypes #-}
data Nat = Z | S Nat
data ListF (n :: Nat) a where
Nil :: (ListF 'Z a)
Cons :: a -> ListF m a -> ListF ('S m) a
data SomeListF a = forall n . AList (ListF n a)
You cam convert from a regular list to SomeListF:
fromList :: [a] -> SomeListF a
fromList [] = AList Nil
fromList (x:xs) = someCons x (fromList xs) where
someCons x (AList zs) = AList (Cons x zs)
You can also recover ListF from SomeListF, but only in a restricted scope. The n in forall n cannot escape, so you cannot have something like
toListF :: SomeListF a -> ListF n a
but you can have this:
withSomeList :: (forall n . ListF n a -> b) -> SomeListF a -> b
withSomeList f (AList zs) = f zs
Inside the f argument, n is known and you can for example map your list and the length of the result is statically known to be the same as the length of the argument. Here's a silly example:
zipF :: ListF n a -> ListF n b -> ListF n (a, b)
zipF Nil Nil = Nil
zipF (Cons y ys) (Cons z zs) = Cons (y, z) (zipF ys zs)
mapF :: (a->b) -> ListF n a -> ListF n b
mapF _ Nil = Nil
mapF f (Cons z zs) = Cons (f z) (mapF f zs)
zipMapF :: (a->b) -> ListF n a -> ListF n (a, b)
zipMapF f zs = zipF zs (mapF f zs)
zipMapAny :: (a->b) -> ListF n a -> SomeListF (a, b)
zipMapAny f zs = AList (zipMapF f zs)
nums = fromList [1,2,3,4,5]
numsAndSquares = withSomeList (zipMapAny (\x -> x * x)) nums
zipMapAny "knows" that the length of all the lists inside it is the same, but it cannot leak that length to the result. You cannot have for example withSomeList (zipMapF (\x -> x * x)) nums because n would escape.
I am trying to achieve something like this :
I have a parameterized type, let's call it Variable. This one is a Functor
Then I want a Container of Variable ( of any Variable, Variable Int, Variable Double, Variable String, etc)
I want that this container is a Functor too.
I managed to make a parameterized container FooContainer but I would like to deal with heterogenous types.
So I created the Bar algebraic data type and the BarContainer. (as suggested here https://wiki.haskell.org/Heterogenous_collections#Algebraic_datatypes)
But I don't understand how to make BarContainer a Functor because its constructor takes no parameter.
import Data.List
data Variable a = Variable {
varName :: String
,value :: [a] } deriving (Show,Read,Eq)
instance Functor Variable where
fmap f (Variable name vals ) = Variable name (fmap f vals)
data FooContainer a = FooContainer {
fooname:: String
, pdata :: [Variable a]
} deriving (Show,Read,Eq)
instance Functor FooContainer where
fmap f (FooContainer n p ) = FooContainer n ( Data.List.map (\x-> fmap f x) p)
data Bar = BarInt [Int] | BarDouble [Double] | BarString [String] | BarChar [Char] deriving (Show,Read,Eq)
data BarContainer = BarContainer {
nameB:: String
, pdataB :: [Bar]
} deriving (Show,Read,Eq)
fooC = FooContainer "foo Container" [Variable "v1" [5,6], Variable "v2" [2,6,8]]
fooC_plus2 = fmap (+2) fooC
barC = BarContainer "bar Container" [ BarInt [5,1], BarDouble [3.2,2,6], BarString ["bob", "dupont"]]
--barC_plus2 ?
main = print $ "Hello, world!" ++ ( show fooC_plus2) ++ (show barC)
You want a container that contains a String name, and then a list of Values of varying types. The way you've done it, with Bar, you are limited to only certain types of Variable. If you want a true, unrestricted heterogenous container, you'll need a GADT.
data HMapList (f :: k -> Type) (xs :: [k]) :: Type where
HMNil :: HMapList f '[]
HMCons :: f x -> HMapList f xs -> HMapList f (x : xs)
data Container xs = Container {
containerName :: String
, containerValues :: HMapList Variable xs
}
Functor is not possible here. Closely related is the concept of a lens, which you can get. Doing this "properly" requires a bit of boilerplate:
data Elem (x :: k) (xs :: [k]) where -- where do I find x in xs?
Here :: Elem x (x : xs)
There :: Elem x xs -> Elem x (y : xs)
data SElem (e :: Elem (x :: k) xs) where
SHere :: SElem Here
SThere :: SElem e -> SElem (There e)
-- these are like indices: think 0 = (S)Here, 1 = (S)There (S)Here, 2 = (S)There 1, etc.
type family Replace (xs :: [k]) (e :: Elem x xs) (y :: k) :: [k] where
Replace (_ : xs) Here y = y : xs
Replace (x : xs) (There e) y = x : Replace xs e y
hmLens :: forall x y xs (e :: Elem x xs) f g. Functor g => SElem e ->
-- Lens (f x) (f y) (HMapList f xs) (HMapList f (Replace xs e y))
(f x -> g (f y)) -> HMapList f xs -> g (HMapList f (Replace xs e y))
hmLens SHere mod (HMCons fx xs) = (\fx' -> HMCons fx' xs) <$> mod fx
hmLens (SThere e) mod (HMCons fx xs) = (\xs' -> HMCons fx xs') <$> hmLens e mod xs
hmLens represents the "fields" of a HMapList. You can use operators from the lens library to manipulate the f x contained in a "slot" of a Container, complete with type-changes. That is, once you select a position within the list with an Elem, you get the Functory ability to replace as with bs by using an a -> b. Though, Container isn't acting as a functor itself; rather, it's generating an infinite family of functors that someone more experienced than me can probably name. To perform your example:
container :: Container [Int, Double, String]
container = Container "container" $ HMCons (Variable "v1" [5,1]) $
HMCons (Variable "v2" [3.2,2,6]) $
HMCons (Variable "v3" ["bob", "dupont"])
HMNil
container' :: Container [Int, Double, String]
container' = let Container name vs = container
in Container name $ vs & (hmLens SHere).mapped %~ (+2)
-- ^ access 1st field ^ modify w/ function
-- ^ flip ($) ^ peek into Variable
-- a proper Lens (Container xs) (Container ys) (HMapList Variable xs) (HMapList Variable ys)
-- would alleviate the match/rebuild pain.
If you want to extend this to apply (+2) to all of the Variable Ints inside a Container (with the potential to change types, like by using show), then you can adapt part of one of my other answers.
Container is also a proper, lowercase-"f" functor. Let's me define a class of categories:
data ZippingWith (f :: a -> b -> Type) (as :: [a]) (bs :: [b]) where
ZWNil :: ZippingWith f '[] '[]
ZWCons :: f a b -> ZippingWith f as bs -> ZippingWith f (a : as) (b : bs)
If f :: k -> k -> Type itself identifies a category, so does ZippingWith f. A ZippingWith f-arrow between xs and ys is a list of f-arrows between the elements of xs and ys, in a "zippy" fashion. HMapList f (and Container, therefore) is a functor from ZippingWith (On f (->)) to (->). It lifts a list of functions into a function on a list.
newtype On (f :: i -> o) (arr :: o -> o -> Type) (a :: i) (b :: i)
= On { runOn :: arr (f a) (f b) }
hmMap :: (ZippingWith (On f (->))) xs ys ->
(->) (HMapList f xs) (HMapList f ys)
hmMap ZWNil HMNil = HMNil
hmMap (ZWCons (On axy) as) (HMCons fx xs) = HMCons (axy fx) (hmMap as xs)
containerMap :: (ZippingWith (On Variable (->))) xs ys ->
(->) (Container xs) (Container ys)
containerMap as (Container name vs) = Container name (hmMap as vs)
Should f itself be a Functor (which it is, in this case), you get some lifting action from ZippingWith (->) to ZippingWith (On f (->))
zwManyMap :: Functor f => ZippingWith (->) xs ys -> ZippingWith (On f (->)) xs ys
zwManyMap ZWNil = ZWNil
zwManyMap (ZWCons axy as) = ZWCons (On (fmap axy)) (zwManyMap as)
Which gives us more functorness:
hmMapMap :: Functor f =>
(ZippingWith (->)) xs ys ->
(->) (HMapList f xs) (HMapList f ys)
hmMapMap = hmMap . zwManyMap
containerMapMap :: (ZippingWith (->)) xs ys ->
(->) (Container xs) (Container ys)
containerMapMap = containerMap . zwManyMap
But wait; there's more: a functor category is a category where objects are functors (f, g) and arrows are natural transformations (f ~> g = forall a. f a -> g a). HMapList is actually a bifunctor. You've seen the ZippingWith (On f (->)) to (->) functor. Now see the (~>) to (->) functor.
hmLMap :: (forall x. f x -> g x) ->
HMapList f xs -> HMapList g xs
hmLMap _ HMNil = HMNil
hmLMap f (HMCons fx xs) = HMCons (f fx) (hmLMap f xs)
This one doesn't generalize to Container, unless you redefine it:
data Container f xs = Container {
containerName :: String
, containerValues :: HMapList f xs
}
If you do choose to keep your BarContainer representation, containerMap and containerMapMap degrade to some useable remnants. Again, they are more lensy than functory, but they are workable.
-- "type-changing": e.g. BarInt can become BarChar, if desired
containerMapChanging :: ([Int] -> Bar) -> ([Double] -> Bar) ->
([String] -> Bar) -> ([Char] -> Bar) ->
BarContainer -> BarContainer
containerMapChanging i d s c (BarContainer name bs) = BarContainer name (f <$> bs)
where f (BarInt x) = i x
f (BarDouble x) = d x
f (BarString x) = s x
f (BarChar x) = c x
containerMap :: ([Int] -> [Int]) -> ([Double] -> [Double]) ->
([String] -> [String]) -> ([Char] -> [Char]) ->
BarContainer -> BarContainer
containerMap i d s c bc = containerMapChanging (BarInt . i) (BarDouble . d)
(BarString . s) (BarChar . c)
bc
containerMapMap :: (Int -> Int) -> (Double -> Double) ->
(String -> String) -> (Char -> Char) ->
BarContainer -> BarContainer
containerMapMap i d s c bc = containerMap (map i) (map d) (map s) (map c) bc
So, e.g. if I want to add 2 to every Int in a BarContainer and strip the first character of every String, I can use containerMapMap (+2) id tail id.
(This is more like a comment than an answer, but I need more space.)
Such container seems impossible to achieve as stated, but perhaps you are OK with something similar.
Problem 1:
suppose we have an heterogeneous container c containing a mixture of Variable Int and Variable String. Then, consider any f :: Int -> Int (say f = succ).
What would fmap f c be? We can't apply f to all the variables. Would f be applied only to Int ones? This would require some runtime type checking, i.e. we need to add Typeable constraints here and there, but Functor does not allow to add such constraint on fmap.
Problem 2:
To use fmap f c the argument c must have type Container T for some type T. What should the index T be?
Maybe there is no index at all. Maybe the index is a type-level list of the types inside the heterogeneous container. E.g. Container '[Int,Int,String,Int].
In any case, Functor can not work with this.
Perhaps what you want, instead, is a custom function like
notFmap :: (Typeable a, Typeable b) => (a -> b) -> Container -> Container
or
notFmap :: (a -> b) -> Container t -> Container (Replace a b t)
with Replace being a suitable type family that processes the index list t and replaces a with b.
I'm working in an example of dependently typed program in Haskell and I would like to "rewrite" an evidence of propositional equality type a :~: b defined in singletons library.
More specifically, I have a data type for represent evidence of regular expression membership. My trouble is how to deal with evidence of concatenation of two regular expressions. In my code, I have a GADT called InRegExp xs e that express the fact that xs is in the language of regular expression e. For concatenation, I have the following constructor:
InCat :: InRegExp xs l -> InRegExp ys r ->
(zs :~: xs ++ ys) -> InRegExp zs (Cat l r)
So far, so good. Now I want to define an inversion lemma for membership in concatenation of two regular expressions:
inCatInv :: InRegExp (xs ++ ys) (Cat e e') -> (InRegExp xs e , InRegExp ys e')
inCatInv (InCat p p' Refl) = (p , p')
but the code is rejected by GHC with the following error message:
Could not deduce (xs1 ~ xs)
from the context ('Cat e e' ~ 'Cat l r)
bound by a pattern with constructor
InCat :: forall (zs :: [Nat])
(xs :: [Nat])
(l :: RegExp [Nat])
(ys :: [Nat])
(r :: RegExp [Nat]).
InRegExp xs l
-> InRegExp ys r -> zs :~: (xs ++ ys) -> InRegExp zs ('Cat l r),
in an equation for ‘inCatInv’
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:11-25
or from ((xs ++ ys) ~ (xs1 ++ ys1))
bound by a pattern with constructor
Refl :: forall (k :: BOX) (b :: k). b :~: b,
in an equation for ‘inCatInv’
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:22-25
‘xs1’ is a rigid type variable bound by
a pattern with constructor
InCat :: forall (zs :: [Nat])
(xs :: [Nat])
(l :: RegExp [Nat])
(ys :: [Nat])
(r :: RegExp [Nat]).
InRegExp xs l
-> InRegExp ys r -> zs :~: (xs ++ ys) -> InRegExp zs ('Cat l r),
in an equation for ‘inCatInv’
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:11
‘xs’ is a rigid type variable bound by
the type signature for
inCatInv :: InRegExp (xs ++ ys) ('Cat e e')
-> (InRegExp xs e, InRegExp ys e')
at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:43:13
Expected type: InRegExp xs e
Actual type: InRegExp xs1 l
Relevant bindings include
p :: InRegExp xs1 l
(bound at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:17)
inCatInv :: InRegExp (xs ++ ys) ('Cat e e')
-> (InRegExp xs e, InRegExp ys e')
(bound at /Users/rodrigo/Dropbox/projects/haskell/experiments/src/Lib.hs:44:1)
In the expression: p
In the expression: (p, p')
In Agda or Idris, this kind of inversion lemma works just fine. Is possible to express such inversion lemma in Haskell? The complete code is available in the following gist.
Any tip or explanation of how can I express such lemma or why it isn't possible to express is highly appreciated.
The simplest method for writing dependently typed programs in Haskell is to first write it in Agda, then replace (x : A) -> B with Sing x -> b. However, we can use Proxy instead of Sing when we're sure we won't need to compute with values.
In our case (assuming our goal is to write hasEmpty from your gist), we only need a single Sing in the Cat constructor, because we need a pattern matching proof for the following function:
appendEmpty :: Sing xs -> Proxy ys -> (xs :++ ys) :~: '[] -> (xs :~: '[], ys :~: '[])
appendEmpty SNil ys eq = (Refl, eq)
appendEmpty (SCons x xs) ys eq = case eq of {}
appendEmpty establishes that the sublists of the empty list are empty too, so we can use them in the Cat case for hasEmpty. Anyway, below's the whole code.
I used a slightly different but equivalent definition for Star that reuses Choice and Eps for building a list structure.
{-# language
TemplateHaskell, UndecidableInstances, LambdaCase, EmptyCase,
DataKinds, PolyKinds, GADTs, TypeFamilies, ScopedTypeVariables,
TypeOperators #-}
import Data.Singletons.Prelude
import Data.Singletons.TH
import Data.Proxy
$(singletons [d|
data Regex c
= Sym c
| Cat (Regex c) (Regex c)
| Choice (Regex c) (Regex c)
| Star (Regex c)
| Eps
deriving (Show)
|])
appendEmpty :: Sing xs -> Proxy ys -> (xs :++ ys) :~: '[] -> (xs :~: '[], ys :~: '[])
appendEmpty SNil ys eq = (Refl, eq)
appendEmpty (SCons x xs) ys eq = case eq of {}
data InRegex :: [c] -> Regex c -> * where
InEps :: InRegex '[] Eps
InSym :: InRegex '[c] (Sym c)
InCat :: Sing xs -> InRegex xs l -> InRegex ys r -> InRegex (xs :++ ys) (Cat l r)
InLeft :: InRegex xs l -> InRegex xs (Choice l r)
InRight :: InRegex ys r -> InRegex ys (Choice l r)
InStar :: InRegex xs (Choice Eps (Cat r (Star r))) -> InRegex xs (Star r)
hasEmpty :: Sing r -> Either (InRegex '[] r) (InRegex '[] r -> Void)
hasEmpty (SSym _) = Right (\case {})
hasEmpty (SCat l r) = case hasEmpty l of
Left inl -> case hasEmpty r of
Left inr -> Left (InCat SNil inl inr)
Right notInr -> Right
(\(InCat xs inl (inr :: InRegex ys r)) -> case appendEmpty xs (Proxy :: Proxy ys) Refl of
(Refl, Refl) -> notInr inr)
Right notInl -> Right
(\(InCat xs inl (inr :: InRegex ys r)) -> case appendEmpty xs (Proxy :: Proxy ys) Refl of
(Refl, Refl) -> notInl inl)
hasEmpty (SChoice l r) = case hasEmpty l of
Left inl -> Left (InLeft inl)
Right notInl -> case hasEmpty r of
Left inr -> Left (InRight inr)
Right notInr -> Right (\case
InLeft inl -> notInl inl
InRight inr -> notInr inr)
hasEmpty (SStar r) = Left (InStar (InLeft InEps))
hasEmpty SEps = Left InEps
Defined:
type family (xs :: [*]) ++ (ys :: [*]) where
'[] ++ ys = ys
(x ': xs) ++ ys = x ': (xs ++ ys)
I have a GADT that's kinda like
data Foo :: [*] -> * -> * where
Foo0 :: a -> Foo '[] a
Foo1 :: Foo '[a] a
Foo2 :: Foo vs a -> Foo us a -> Foo (vs ++ us) a
And I want to do something like
test :: Foo '[] Int -> Int
test (Foo0 x) = x
test (Foo2 x y) = test x + test y
But I can't use test on x or y because x ~ Foo '[] Int and y ~ Foo '[] Int have to be proven. But I want to say that this is proven from the fact that vs ++ us ~ '[] means that the individual vs and us of x and y are necessarily '[].
Is there any way to do this with type families, or maybe switching over to a multi param typeclass approach with fundeps?
Thanks!
Don't touch the green smile!
The presence of ‘green slime’ — defined functions in the return types
of constructors — is a danger sign.
The simplest workaround is to generalize test and then instantiate:
gtest :: Foo xs Int -> Int
gtest (Foo0 x) = x
gtest (Foo2 x y) = gtest x + gtest y
test :: Foo '[] Int -> Int
test = gtest
You could add two type families that would serve as inverses of ++, and without loss of generality add them as constraints to the Foo2 constructor. Through those inverse type families GHC would be able to infer exactly what you're asking from it.
Here's an example implementation of CutX and CutY such that r ~ a ++ b <=> a ~ CutY r b <=> b ~ CutX r a.
type family (xs :: [*]) ++ (ys :: [*]) where
'[] ++ ys = ys
(x ': xs) ++ ys = x ': (xs ++ ys)
type family CutX (rs :: [*]) (xs :: [*]) where
CutX '[] xs = '[]
CutX rs '[] = rs
CutX (r ': rs) (x ': xs) = CutX rs xs
type family ZipWithConst (xs :: [*]) (ys :: [*]) where
ZipWithConst '[] ys = '[]
ZipWithConst xs '[] = '[]
ZipWithConst (x ': xs) (y ': ys) = y ': ZipWithConst xs ys
type CutY rs ys = ZipWithConst rs (CutX rs ys)
data Foo :: [*] -> * -> * where
Foo0 :: a -> Foo '[] a
Foo1 :: Foo '[a] a
Foo2 :: (rs ~ (vs ++ us), us ~ CutX rs vs, vs ~ CutY rs us) => Foo vs a -> Foo us a -> Foo rs a
I'm trying to build a list at the type level, but I'm having some trouble figuring out how to enforce constraints.
My base code is:
data Foo z q = Foo1 (z q)
| Foo2 (z q)
class Qux q -- where ...
class Baz z -- where ...
class Bar a where -- a has kind *->*
type BCtx a q :: Constraint -- using ConstraintKinds to allow constraints on the concrete type
f :: (BCtx a q) => a q -> a q -> a q
g :: (BCtx a q, BCtx a q') => a q -> a q'
instance (Baz z) => Bar (Foo z) where
type BCtx (Foo z) q = (Num (z q), Qux q) -- for example
f (Foo1 x) (Foo1 y) = Foo1 $ x+y -- these functions need access to the type q to do arithmetic mod q
f (Foo1 x) (Foo2 y) = Foo2 $ x-y
-- ...
You can think of the qs above representing prime powers. I would also like to represent composite numbers using a type list of qis. I'm imagining something like:
data QList qi qs = QCons qi qs
| QNil
with the data
data FList c q = FNil
| FCons (c (Head q)) (FList c (Tail q))
where (Head q) should correspond to qi and (Tail q) should correspond to qs. Note that the q parameter for FList is NOT (necessarily) a (Qux q), it is a list of (Qux qi). (I don't want to flesh out anything more about this list, since it's one of the design problems I'm posing). I would like to work "modulus-wise" on the FList:
instance (Bar c) => Bar (FList c) where
type BCtx (FList c) q = () -- Anything I put here is not enough
f (FCons x xs) (FCons y ys) = FCons (f x y) (f xs ys)
-- the left call to `f` calls a concrete instance, the right call to `f` is a recursive call on the rest of the list
-- ...
Compiling these codes snippets together in GHC result in (modulo transcription, abstraction, and typing errors):
Could not deduce (BCtx c (Head q), BCtx c (Tail q))
and then
Could not deduce (BCtx c (Head (Tail q)), BCtx c (Tail (Tail q)))
etc.
I see why I'm getting this error, but not how to fix it.
Concretely, I'm expecting an FList c q type where c~Foo z and q~QCons q1 (QCons q2 QNil), and of course my list will satisfy all of the BCtx constraints at every level.
I'm not sure that fixing those particular errors will result in compiling code, but it is a start. The entire Bar class is basically fixed (the Constraint kind is required, and the instances of Bar must have kind * -> *). I don't believe I can use existential types to create a list of generic objects because I need access to the qi parameter. I am willing to change the type of FList and QList to allow me to work modulus-wise on a collection of Bars.
Thanks for your time!
To handle type lists, it's necessary to discriminate empty from nonempty lists and handle them separately. The 'Could not deduce' errors in your code occur because your instance assumes a nonempty list, when in fact the list may or may not be empty. Here is a solution using the extensions TypeFamilies, TypeOperators, DataKinds, and GADTs.
With DataKinds, type lists are predefined. They have kind [*], but they'll be used in a context where kind * is expected, so an operator is needed to cast them:
data InjList (qs :: [*])
Using type lists, FList is defined as
data FList c q where
FNil :: FList c (InjList '[])
FCons :: c h -> FList c (InjList t) -> FList c (InjList (h ': t))
It's defined as a GADT to express how it's only possible to construct FLists over the type InjList q' for some type-list q'. For instance, the term FCons [True] FNil has type FList [] (InjList (Bool ': '[])). On the other hand, since Bool isn't of the form InjList q', there are no terms (except ⊥) of type FList [] Bool. By pattern matching on an FList, a function can verify that it has been given a non-⊥ argument, and further determine whether it's been passed an empty type list.
An instance of Bar for FLists has to handle nil lists and cons lists separately. A nil list has an empty context.
A cons list has components for the head and tail of the list. This is expressed by pattern matching on the type-list in the associated type instance of BCtx. The function f examines its argument to verify that it's not ⊥ and to decide whether it's an empty list.
instance (Bar c) => Bar (FList c) where
-- Empty context for '[]
type BCtx (FList c) (InjList '[]) = ()
-- Context includes components for head and tail of list
type BCtx (FList c) (InjList (h ': t)) = (BCtx c h, BCtx (FList c) (InjList t))
f FNil FNil = FNil
f (FCons x xs) (FCons y ys) = FCons (f x y) (f xs ys)
We can load the code into GHCi to verify that it works:
instance Bar [] where
type BCtx [] q = Num q
f xs ys = zipWith (+) xs ys
instance Show (FList c (InjList '[])) where
show FNil = "FNil"
instance (Show (c h), Show (FList c (InjList t))) => Show (FList c (InjList (h ': t))) where
show (FCons h t) = "FCons (" ++ show h ++ ") (" ++ show t ++ ")"
$ ghci
> :load Test
> f (FCons [1,2] FNil) (FCons [3,4] FNil)
FCons ([4,6]) (FNil)