blob: 12f7391f49ce0f6d21a3c8ed9f1fe86ad92233ee (
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
|
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module T16204b where
import Data.Kind
-----
-- singletons machinery
-----
data family Sing :: forall k. k -> Type
data SomeSing :: Type -> Type where
SomeSing :: Sing (a :: k) -> SomeSing k
-----
-- (Simplified) GHC.Generics
-----
class Generic (a :: Type) where
type Rep a :: Type
from :: a -> Rep a
to :: Rep a -> a
class PGeneric (a :: Type) where
-- type PFrom ...
type PTo (x :: Rep a) :: a
class SGeneric k where
-- sFrom :: ...
sTo :: forall (a :: Rep k). Sing a -> Sing (PTo a :: k)
-----
class SingKind k where
type Demote k :: Type
-- fromSing :: ...
toSing :: Demote k -> SomeSing k
genericToSing :: forall k.
( SingKind k, SGeneric k, SingKind (Rep k)
, Generic (Demote k), Rep (Demote k) ~ Demote (Rep k) )
=> Demote k -> SomeSing k
genericToSing d = withSomeSing (from d) $ SomeSing . sTo
withSomeSing :: forall k r
. SingKind k
=> Demote k
-> (forall (a :: k). Sing a -> r)
-> r
withSomeSing x f =
case toSing x of
SomeSing x' -> f x'
|
