summaryrefslogtreecommitdiff
path: root/tests/purs/passing/EmptyDicts.purs
blob: 157af7bc52ad84160970414f3cc8f6c06b941cbe (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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
-- |
-- The purpose of this test is to make sure that the empty type class
-- dictionary elimination code doesn't change semantics.
module Main where

import Prelude
import Effect.Console (log)

-- |
-- Data type to check that the result of expressions with eliminated
-- dictionaries are as expected.
data Check = Check
derive instance eqCheck :: Eq Check

-- |
-- This type class has no constraints and no members.
-- Is is therefore considered empty.
class EmptyClass
instance emptyDictInst :: EmptyClass

-- |
-- This type class is not empty as it has members, but it has an empty super
-- class.
class EmptyClass <= HasEmptySuper where
  hasEmptySuper :: Check
instance hasEmptySuperInst :: HasEmptySuper where
  hasEmptySuper = Check

-- |
-- This type class has no members, but has a non-empty super class.
-- It is therefore not empty.
class HasEmptySuper <= HasNonEmptySuper
instance hasNonEmptySuperInst :: HasEmptySuper => HasNonEmptySuper

-- |
-- This type class is empty because all it's super classes are empty and it
-- has no members.
class EmptyClass <= AliasEmptyClass
instance aliasEmptyClassInst :: AliasEmptyClass

whenEmpty :: Check
whenEmpty = Check :: EmptyClass => Check

whenHasEmptySuper :: Check
whenHasEmptySuper = Check :: HasEmptySuper => Check

whenHasNonEmptySuper :: Check
whenHasNonEmptySuper = Check :: HasNonEmptySuper => Check

whenAliasEmptyClass :: Check
whenAliasEmptyClass = Check :: AliasEmptyClass => Check

class WithArgEmpty t
instance withArgEmptyCheck :: WithArgEmpty Check
class WithArgEmpty t <= WithArgHasEmptySuper t where
  withArgHasEmptySuper :: t
instance withArgHasEmptySuperCheck :: WithArgHasEmptySuper Check where
  withArgHasEmptySuper = Check

whenAccessingSuperDict :: Check
whenAccessingSuperDict = foo Check where

  bar :: forall t . WithArgEmpty t => t -> t
  bar x = x

  foo :: forall t . WithArgHasEmptySuper t => t -> t
  foo x = bar x

main =
  if Check == whenEmpty &&
     Check == whenHasEmptySuper &&
     Check == whenHasNonEmptySuper &&
     Check == whenAliasEmptyClass &&
     Check == whenAccessingSuperDict
    then log "Done"
    else pure unit