Show that cheating is caught
[nt-coerce.git] / test.hs
1 {-# OPTIONS_GHC -fplugin GHC.NT.Plugin #-}
2
3 import GHC.NT
4 import Abstract
5
6 listNT :: NT a b -> NT [a] [b]
7 listNT = deriveThisNT
8
9 tupleNT :: NT a b -> NT (a,c) (b,c)
10 tupleNT = deriveThisNT
11
12 nestedNT :: NT a a' -> NT ((a,b),c) ((a',b),c)
13 nestedNT = deriveThisNT
14
15 data Bal a = Leaf a | Node (Bal (a,a))
16
17 balNT :: NT a b -> NT (Bal a) (Bal b)
18 balNT = deriveThisNT
19
20 newtype Age = Age Int deriving Show
21
22 ageNT :: NT Age Int
23 ageNT = deriveThisNT
24
25 newtype MyList a = MyList [a] deriving Show
26
27 myListNT :: NT (MyList a) [a]
28 myListNT = deriveThisNT
29
30 foo :: NT a b -> NT (MyList a) (MyList b)
31 foo = deriveThisNT
32
33 newtype R a = R [R a] deriving Show
34
35 rNT :: NT (R a) [R a]
36 rNT = deriveThisNT
37
38 -- Would not work (but is removed anyways before it is seen by GHC.NT.Plugin)
39 bar :: NT (MyList Age) [Int]
40 bar = deriveThisNT
41
42 data Tree a = T a [Tree a] deriving Show
43 newtype Tree' a = Tree' (Tree a) deriving Show
44
45 treeNT :: NT a b -> NT (Tree a) (Tree b)
46 treeNT = deriveThisNT
47
48 tree'NT :: NT (Tree' a) (Tree a)
49 tree'NT = deriveThisNT
50
51 tree'NT' :: NT a b -> NT (Tree' a) (Tree' b)
52 tree'NT' = deriveThisNT
53
54 data F a b c = F a b c deriving Show
55
56 fNT :: NT a a' -> NT (F a b c) (F a' b c)
57 fNT = deriveThisNT
58
59
60 badNT :: NT a b -> NT (Abs1 a) (Abs1 b)
61 badNT = deriveThisNT -- rejected 
62
63 data WrappedBad a = WrappedBad (Abs1 a) deriving Show
64 wrappedBadNT :: NT a b -> NT (WrappedBad a) (WrappedBad b)
65 wrappedBadNT = deriveThisNT -- rejected
66
67 data WrappedAbstract a = WrappedAbstract (Abs2 a) deriving Show
68 wrappedAbstactBadNT :: NT a b -> NT (WrappedAbstract a) (WrappedAbstract b)
69 wrappedAbstactBadNT = deriveThisNT -- rejected
70
71 wrappedAbstactNTRaw :: NT a b -> NT (Abs2 a) (Abs2 b) -> NT (WrappedAbstract a) (WrappedAbstract b)
72 wrappedAbstactNTRaw = deriveThisNT -- accepted
73
74 wrappedAbstactNT :: NT a b -> NT (WrappedAbstract a) (WrappedAbstract b)
75 wrappedAbstactNT nt = wrappedAbstactNTRaw nt (abs2NT nt)
76
77 main = do
78     let n = 1 :: Int
79     let a = coerce (sym ageNT) 1
80     let l1 = [a]
81     let l2 = coerce (listNT ageNT) l1
82     let l3 = coerce (sym myListNT) l2
83     print a
84     print l2
85     print l3
86     print $ coerce (foo (sym ageNT)) l3
87     --print $ coerce bar (MyList [a])
88     print $ coerce (sym rNT) []
89     print $ coerce (fNT (sym ageNT)) (F 1 2 3)
90     tree'NT `seq` tree'NT' `seq` tupleNT `seq` return ()
91     -- badNT `seq` return ()
92     -- wrappedBadNT `seq` return ()
93     -- wrappedAbstactBadNT `seq` return ()
94     wrappedAbstactNT `seq` return ()
95     let wa = WrappedAbstract abs2
96     print wa
97     print $ coerce (sym (wrappedAbstactNT ageNT)) wa
98     let t1 = T 1 []
99     print $ coerce (trans (sym tree'NT) (sym (tree'NT' ageNT))) t1
100     print $ coerce (trans (treeNT (sym ageNT)) (sym tree'NT)) t1
101     nestedNT `seq` return ()
102     -- balNT `seq` return ()
103