summaryrefslogtreecommitdiff
path: root/testsuite/tests/unsatisfiable/UnsatisfiableFail3.hs
blob: 90befcd5a9515fca1cc9eb198f879fb3d9b137ae (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
{-# LANGUAGE DataKinds #-}

module UnsatisfiableFail3 where

import GHC.TypeError


-- This test makes sure we don't end up with duplication of error messages
-- when adding Unsatisfiable contexts to classes with superclasses.

-- Test 1: we add an Unsatisfiable context to both the class and its superclass.

class Eq a => ReflexiveEq a where
    reflexiveEq :: a -> a -> Bool
    reflexiveEq = (==)

instance Unsatisfiable (Text "Can't compare functions with (==)") => Eq (a -> b) where
  (==) = unsatisfiable

instance Unsatisfiable (Text "Can't compare functions with reflexiveEq") => ReflexiveEq (a -> b)

type DoubleMsg = Text "Equality is not reflexive on Double"
instance Unsatisfiable DoubleMsg => ReflexiveEq Double where
    reflexiveEq = unsatisfiable @DoubleMsg

foo = reflexiveEq 0 (0 :: Double)

bar = reflexiveEq (\ (x :: Int) -> x + 1)


-- Test 2: we add an Unsatisfiable context to the class, but not the superclass.

class Eq a => ReflexiveEq' a where
    reflexiveEq' :: a -> a -> Bool
    reflexiveEq' = (==)

instance Unsatisfiable (Text "Can't compare functions with reflexiveEq'") => ReflexiveEq' (a -> b)
instance Unsatisfiable DoubleMsg => ReflexiveEq' Double where
    reflexiveEq' = unsatisfiable @DoubleMsg

foo' = reflexiveEq' 0 (0 :: Double)

bar' = reflexiveEq' (\ (x :: Int) -> x + 1)