Embrace -XTypeInType, add -XStarIsType
[ghc.git] / testsuite / tests / overloadedrecflds / should_run / overloadedrecfldsrun07.hs
1 {-# LANGUAGE DataKinds
2 , PolyKinds
3 , FlexibleContexts
4 , FlexibleInstances
5 , GADTs
6 , MultiParamTypeClasses
7 , OverloadedLabels
8 , ScopedTypeVariables
9 , TypeApplications
10 , TypeOperators
11 , UndecidableInstances
12 #-}
13
14 import GHC.OverloadedLabels
15 import GHC.Records
16 import GHC.TypeLits
17 import Data.Kind
18
19 data Label (x :: Symbol) = Label
20 data Labelled x a = Label x := a
21
22 data Rec :: forall k. [(k, Type)] -> Type where
23 Nil :: Rec '[]
24 (:>) :: Labelled x a -> Rec xs -> Rec ('(x, a) ': xs)
25 infixr 5 :>
26
27 instance {-# OVERLAPS #-} a ~ b => HasField foo (Rec ('(foo, a) ': xs)) b where
28 getField ((_ := v) :> _) = v
29
30 instance HasField foo (Rec xs) b => HasField foo (Rec ('(bar, a) ': xs)) b where
31 getField (_ :> vs) = getField @foo vs
32
33 instance y ~ x => IsLabel y (Label x) where
34 fromLabel = Label
35
36 instance HasField x r a => IsLabel x (r -> a) where
37 fromLabel = getField @x
38
39 x :: Rec '[ '("foo", Int), '("bar", Bool)]
40 x = #foo := 42 :> #bar := True :> Nil
41
42 y = #bar := 'x' :> undefined
43
44 main = do print (#foo x)
45 print (#bar x)
46 print (#bar y)