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
|
{-# LANGUAGE DataKinds
, FlexibleContexts
, FlexibleInstances
, GADTs
, MultiParamTypeClasses
, OverloadedLabels
, PolyKinds
, ScopedTypeVariables
, TypeApplications
, TypeOperators
, UndecidableInstances
#-}
import GHC.OverloadedLabels
import GHC.Records
import GHC.TypeLits
data Label (x :: Symbol) = Label
data Labelled x a = Label x := a
data Rec :: [(k, *)] -> * where
Nil :: Rec '[]
(:>) :: Labelled x a -> Rec xs -> Rec ('(x, a) ': xs)
infixr 5 :>
instance {-# OVERLAPS #-} a ~ b => HasField foo (Rec ('(foo, a) ': xs)) b where
getField ((_ := v) :> _) = v
instance HasField foo (Rec xs) b => HasField foo (Rec ('(bar, a) ': xs)) b where
getField (_ :> vs) = getField @foo vs
instance y ~ x => IsLabel y (Label x) where
fromLabel = Label
instance HasField x r a => IsLabel x (r -> a) where
fromLabel = getField @x
x :: Rec '[ '("foo", Int), '("bar", Bool)]
x = #foo := 42 :> #bar := True :> Nil
y = #bar := 'x' :> undefined
main = do print (#foo x)
print (#bar x)
print (#bar y)
|
