Type Family Not Evaluating - haskell

I am quite new to type level programming in haskell and I'm stuck with the following example. It is a fragment of a type level type checker for a small dsl. I want the Find type family to return a proof that a given element is contained in Env, or force a compile time error otherwise.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
import GHC.TypeLits
-- atomic data types in the source language
data Atom = Boolean
-- the typechecking environment
type Env = [(Symbol, Atom)]
-- A proof that a particular pair has been declared in the Env
data Elem (n :: Symbol) (a :: Atom) (e :: Env) where
DH :: Elem n a ('(n,a):e)
DT :: Elem n a e -> Elem n a (t:e)
-- Compile time type env lookup
type Find :: Symbol -> Atom -> Env -> Elem n a e
type family Find n a e where
Find n a ('(n,a): e) = DH
Find n a ('(t,p): e) = DT (Find n a e)
Find n a '[] = TypeError (Text "name '" :<>: Text n :<>: Text "' not found in env")
However when I try to evaluate Find in ghci it seems to be stuck:
kind! Find "hi" Boolean '[ '("hi", Boolean) ]
Find "hi" Boolean '[ '("hi", Boolean) ] :: Elem n a e
I would expect this to reduce to DH :: Elem "hi" Boolean '[ '("hi", Boolean) ], but nothing seems to have happened. Have I somehow defined my type family incorrectly?

Related

Elimination by `TypeError` constraint

I'd like to use a TypeError constraint to make a "non-instance" produce a more meaningful type error:
{-# LANGUAGE DataKinds, KindSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
import GHC.TypeLits
import Data.Proxy
class Compat (x :: Bool) (y :: Bool) where
combine :: Proxy x -> Proxy y -> Int
instance Compat False pre2 where
combine _ _ = 42
instance Compat True False where
combine _ _ = 1
instance (TypeError (Text "Meaningful error message goes here")) => Compat True True where
combine = _
At the hole, I'd like to fill it using elimination by the TypeError constraint, i.e. use the fact that I have a TypeError constraint in scope to avoid having to write undefined or error or similar.
Is that possible?
I don't think this is possible with the standard TypeError, but you can define your own variant (TE below) so to provide the eliminator you need.
{-# LANGUAGE
DataKinds, UndecidableInstances,
MultiParamTypeClasses, KindSignatures, TypeFamilies #-}
import GHC.TypeLits
import Data.Kind
class Impossible where
impossible :: a
type family TE (t :: ErrorMessage) :: Constraint where
TE t = (TypeError t, Impossible)
class C t where
foo :: t -> Bool
instance (TE (Text "impossible")) => C Bool where
foo _ = impossible

How to satisfy constraints on existentially quantified values?

In an attempt at learning how to work with dependent data types in haskell I encountered the following problem:
Suppose you have a function such as:
mean :: ((1 GHC.TypeLits.<=? n) ~ 'True, GHC.TypeLits.KnownNat n) => R n -> ℝ
defined in the hmatrix library, then how do you use this on a vector that has an existential type? E.g.:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
import Data.Proxy (Proxy (..))
import GHC.TypeLits
import Numeric.LinearAlgebra.Static
getUserInput =
let userInput = 3 -- pretend it's unknown at compile time
seed = 42
in existentialCrisis seed userInput
existentialCrisis seed userInput
| userInput <= 0 = 0
| otherwise =
case someNatVal userInput of
Nothing -> undefined -- let's ignore this case for now
Just (SomeNat (proxy :: Proxy n)) ->
let someVector = randomVector seed Gaussian :: R n
in mean someVector -- I know that 'n > 0' but the compiler doesn't
This gives the following error:
• Couldn't match type ‘1 <=? n’ with ‘'True’
arising from a use of ‘mean’
Makes sense indeed, but after some googling and fiddling around, I could not find out how to deal with this. How can I get hold of an n :: Nat, based on user input, such that it satisfies the 1 <= n constraint?. I believe it must be possible since the someNatVal function already succeeds in satisfying the KnownNat constraint based on the condition that the input is not negative.
It seems to me that this is a common thing when working with dependent types, and maybe the answer is obvious but I don't see it.
So my question:
How, in general, can I bring an existential type in scope satisfying the constraints required for some function?
My attempts:
To my surprise, even the following modification
let someVector = randomVector seed Gaussian :: R (n + 1)
gave a type error:
• Couldn't match type ‘1 <=? (n + 1)’ with ‘'True’
arising from a use of ‘mean’
Also, adding an extra instance to <=? to prove this equality does not work as <=? is closed.
I tried an approach combining GADTs with typeclasses as in this answer to a previous question of mine but could not make it work.
Thanks #danidiaz for pointing me in the right direction, the typelist-witnesses documentation provides a nearly direct answer to my question. Seems like I was using the wrong search terms when googling for a solution.
So here is a self contained compileable solution:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Proxy (Proxy (..))
import Data.Type.Equality ((:~:)(Refl))
import GHC.TypeLits
import GHC.TypeLits.Compare
import Numeric.LinearAlgebra.Static
existentialCrisis :: Int -> Int -> IO (Double)
existentialCrisis seed userInput =
case someNatVal (fromIntegral userInput) of
Nothing -> print "someNatVal failed" >> return 0
Just (SomeNat (proxy :: Proxy n)) ->
case isLE (Proxy :: Proxy 1) proxy of
Nothing -> print "isLE failed" >> return 0
Just Refl ->
let someVector = randomVector seed Gaussian :: R n
in do
print userInput
-- I know that 'n > 0' and so does the compiler
return (mean someVector)
And it works with input only known at runtime:
λ: :l ExistentialCrisis.hs
λ: existentialCrisis 41 1
(0.2596687587224799 :: R 1)
0.2596687587224799
*Main
λ: existentialCrisis 41 0
"isLE failed"
0.0
*Main
λ: existentialCrisis 41 (-1)
"someNatVal failed"
0.0
It seems like typelist-witnesses does a lot unsafeCoerceing under the hood. But the interface is type-safe so it doesn't really matter that much for practical use cases.
EDIT:
If this question was of interest to you, might also find this post interesting: https://stackoverflow.com/a/41615278/2496293

How to create a type level list with symbols to test a type family

I try to learn about Haskell type level programming. I wrote a little function to lookup a key, a Symbol, in a type level list:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
import GHC.TypeLits
type family Lookup (x :: k) (l :: [(k,v)]) :: k where
Lookup k ('(k,a) ': ls) = a
Lookup k ('(x,a) ': ls) = Lookup k ls
Lookup k '[] = TypeError (Text "Key not found: ")
GHC (8.0.1) compiles this function without errors and
now I need to test the function in GHCi. In GHCi I set the options:
:set -XDataKinds
:set -XTypeOperators
and try to run a first test example:
:kind! Lookup "bar" '[("foo", Int), ("bar", String)]
The Strings "bar" and "foo" should be Type-level Strings aka Symbols.
GHC rejects my little test case with:
<interactive>:1:14: error:
• Expected kind ‘[(Symbol, v0)]’,
but ‘'[("foo", Int), ("bar", String)]’ has kind ‘[*]’
• In the second argument of ‘Lookup’, namely
‘'[("foo", Int), ("bar", String)]’
In the type ‘Lookup "bar" '[("foo", Int), ("bar", String)]’
The question is how to change the test example, so GHC will accept it.
Note: My type level function Lookup is in its first version, it may be wrong, maybe I should use CmpSymbol or do other changes. However this is not the topic of this SO question.
(k1, k2) is the type of pairs of elements of type/kind k1 and k2, and '(a, b) is a type-level pair (note the ').
'(a, b) :: (k1, k2) with a :: k1 and b :: k2
Fix:
Lookup "bar" '[ '("foo", Int), '("bar", String)]

Haskell instance signatures

I'm a complete newbie in Haskell so please be patient.
Let's say I've got this class
class Indexable i where
at :: i a p -> p -> a
Now let's say I want to implement that typeclass for this data type:
data Test a p = Test [a]
What I tried is:
instance Indexable Test where
at (Test l) p = l `genericIndex` p
However it didn't compile, because p needs to be an Integral, however as far as I understand, it's impossibile to add the type signature to instances. I tried to use InstanceSigs, but failed.
Any ideas?
here is a version where you add the index-type to the class using MultiParamTypeClasses
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Index where
import Data.List (genericIndex)
class Indexable i f where
at :: forall a . f a -> i -> a
data Test a = Test [a]
instance Integral i => Indexable i Test where
at (Test as) i = as `genericIndex` i
here I need the FlexibleInstances because of the way the instance is declared and RankNTypes for the forall a . ;)
assuming this is your expected behavior:
λ> let test = Test [1..5]
λ> test `at` 3
4
λ> test `at` 0
1
λ> test `at` (0 :: Int)
1
λ> test `at` (1 :: Integer)
2
Just for fun, here's a very different solution which doesn't require any changes to your class declaration. (N.B. This answer is for fun only! I do not advocate keeping your class as-is; it seems a strange class definition to me.) The idea here is to push the burden of proof off from the class instance to the person constructing a value of type Test p a; we will demand that constructing such a value will require an Integral p instance in scope.
All this code stays exactly the same (but with a new extension turned on):
{-# LANGUAGE GADTs #-}
import Data.List
class Indexable i where
at :: i a p -> p -> a
instance Indexable Test where
at (Test l) p = l `genericIndex` p
But the declaration of your data type changes just slightly to demand an Integral p instance:
data Test a p where
Test :: Integral p => [a] -> Test a p
You are actually trying to do something fairly advanced. If I understand what you want, you actually need a multiparameter typeclass here, because your type parameter "p" depends on "i": for a list indexed by integer you need "p" to be integral, but for a table indexed by strings you need it to be "String", or at least an instance of "Ord".
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-} -- Enable the language extensions.
class Indexable i p | i -> p where
at :: i a -> p -> a
This says that the class is for two types, "i" and "p", and if you know "i" then "p" follows automatically. So if "i" is a list the "p" has to be Int, and if "i" is a "Map String a" then "p" has to be "String".
instance Indexable [a] Int where
at = (!!)
This declares the combination of [a] and Int as being an instance of Indexable.
user2407038 has provided an alternative approach using "type families", which is a more recent and sophisticated version of multiparameter type classes.
You can use associated type families and constraint kinds:
import GHC.Exts(Constraint)
class Indexable i where
type IndexableCtr i :: * -> Constraint
at :: IndexableCtr i p => i a p -> p -> a
instance Indexable Test where
type IndexableCtr Test = Integral
at (Test l) p = l `genericIndex` p
This defines the class Indexable with an associated type IndexableCtr which
is used to constraint the type of at.

How to create a value in compdata

I've got the following compdata example code
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
module Web.Rusalka.Hello (
iB, iV, Z) where
import Data.Comp
import Data.Comp.Ops
import Data.Comp.Show ()
import Data.Comp.Derive
data B e = B Bool
data V a e = V a
type Z a = Term (B :+: V a)
$(derive [makeFunctor, makeTraversable, makeFoldable,
makeEqF, makeShowF, smartConstructors, smartAConstructors,
makeArbitrary, makeArbitraryF]
[''B, ''V])
(You'll note that in fact, everything in Z is a leaf node.)
Now, as I understand it, this has created two functions, iB and iV, that can be used to create (Z a) s. However, I can't for the life of me figure
out how to create, for instance a (Z Int). What do I need to put in? (Or what am I misunderstanding?)
iB True :: Z Int or iV (1 :: Int) :: Z Int produce valid, printable expressions within this module.

Resources