]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Type/Test.hs
factorizing Type1_From ast Type0
[haskell/symantic.git] / Language / Symantic / Type / Test.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE TypeOperators #-}
3 module Type.Test where
4
5 import Test.Tasty
6 import Test.Tasty.HUnit
7 import Data.Proxy
8
9 import Language.Symantic.Type
10
11 import AST.Test
12
13 type Type_Fun_Bool = Type_Root (Type_Fun :|: Type_Bool)
14 type Type_Fun_Bool_Int = Type_Root (Type_Fun :|: Type_Bool :|: Type_Int)
15 type Type_Fun_Int = Type_Root (Type_Fun :|: Type_Int)
16
17 tests :: TestTree
18 tests = testGroup "Type" $
19 let (==>) ast expected p =
20 testCase (show ast) $
21 (@?= Exists_Type0 <$> expected) $
22 type0_from p ast (Right . Exists_Type0) in
23 [ testGroup "Bool"
24 [ AST "Bool" []
25 ==> Right (type_bool :: Type_Fun_Bool Bool) $
26 (Proxy :: Proxy (Type_Fun_Bool))
27 , AST "->" [AST "Bool" []]
28 ==> Left (error_type_lift $
29 Error_Type_Wrong_number_of_arguments (AST "->" [AST "Bool" []]) 2) $
30 (Proxy :: Proxy (Type_Fun_Bool))
31 , AST "->" [AST "Bool" [], AST "Bool" []]
32 ==> Right (type_bool `type_fun` type_bool
33 :: Type_Fun_Bool ((->) Bool Bool)) $
34 (Proxy :: Proxy (Type_Fun_Bool))
35 , AST "->" [ AST "->" [AST "Bool" [], AST "Bool" []]
36 , AST "Bool" [] ]
37 ==> Right ((type_bool `type_fun` type_bool) `type_fun` type_bool
38 :: Type_Fun_Bool ((->) ((->) Bool Bool) Bool)) $
39 (Proxy :: Proxy (Type_Fun_Bool))
40 , AST "->" [ AST "Bool" []
41 , AST "->" [AST "Bool" [], AST "Bool" []] ]
42 ==> Right (type_bool `type_fun` (type_bool `type_fun` type_bool)
43 :: Type_Fun_Bool ((->) Bool ((->) Bool Bool))) $
44 (Proxy :: Proxy (Type_Fun_Bool))
45 , AST "Int" []
46 ==> Left (error_type_lift $ Error_Type_Unsupported $ AST "Int" []) $
47 (Proxy :: Proxy (Type_Fun_Bool))
48 , AST "->" [AST "Bool" [], AST "Int" []]
49 ==> Left (error_type_lift $ Error_Type_Unsupported $ AST "Int" []) $
50 (Proxy :: Proxy (Type_Fun_Bool))
51 , AST "->" [ AST "->" [AST "Int" [], AST "Bool" []]
52 , AST "Int" [] ]
53 ==> Left (error_type_lift $ Error_Type_Unsupported $ AST "Int" []) $
54 (Proxy :: Proxy (Type_Fun_Bool))
55 ]
56 , testGroup "Int"
57 [ AST "Int" []
58 ==> Right (type_int :: Type_Fun_Int Int) $
59 (Proxy :: Proxy (Type_Fun_Int))
60 , AST "->" [AST "Int" []]
61 ==> Left (error_type_lift $
62 Error_Type_Wrong_number_of_arguments (AST "->" [AST "Int" []]) 2) $
63 (Proxy :: Proxy (Type_Fun_Int))
64 , AST "->" [AST "Int" [], AST "Int" []]
65 ==> Right (type_int `type_fun` type_int
66 :: Type_Fun_Int ((->) Int Int)) $
67 (Proxy :: Proxy (Type_Fun_Int))
68 , AST "->" [ AST "->" [AST "Int" [], AST "Int" []]
69 , AST "Int" [] ]
70 ==> Right ((type_int `type_fun` type_int) `type_fun` type_int
71 :: Type_Fun_Int ((->) ((->) Int Int) Int)) $
72 (Proxy :: Proxy (Type_Fun_Int))
73 , AST "->" [ AST "Int" []
74 , AST "->" [AST "Int" [], AST "Int" []] ]
75 ==> Right (type_int `type_fun` (type_int `type_fun` type_int)
76 :: Type_Fun_Int ((->) Int ((->) Int Int))) $
77 (Proxy :: Proxy (Type_Fun_Int))
78 , AST "Bool" []
79 ==> Left (error_type_lift $ Error_Type_Unsupported $ AST "Bool" []) $
80 (Proxy :: Proxy (Type_Fun_Int))
81 , AST "->" [AST "Int" [], AST "Bool" []]
82 ==> Left (error_type_lift $ Error_Type_Unsupported $ AST "Bool" []) $
83 (Proxy :: Proxy (Type_Fun_Int))
84 , AST "->" [ AST "->" [AST "Bool" [], AST "Int" []]
85 , AST "Bool" [] ]
86 ==> Left (error_type_lift $ Error_Type_Unsupported $ AST "Bool" []) $
87 (Proxy :: Proxy (Type_Fun_Int))
88 ]
89 , testGroup "Fun" $
90 [ AST "Int" []
91 ==> Right (type_int :: Type_Fun_Bool_Int Int) $
92 (Proxy :: Proxy (Type_Fun_Bool_Int))
93 , AST "->" [AST "Bool" [], AST "Int" []]
94 ==> Right (type_bool `type_fun` type_int
95 :: Type_Fun_Bool_Int ((->) Bool Int)) $
96 (Proxy :: Proxy (Type_Fun_Bool_Int))
97 , AST "->" [ AST "->" [AST "Int" [], AST "Bool" []]
98 , AST "Int" [] ]
99 ==> Right ((type_int `type_fun` type_bool) `type_fun` type_int
100 :: Type_Fun_Bool_Int ((->) ((->) Int Bool) Int)) $
101 (Proxy :: Proxy (Type_Fun_Bool_Int))
102 ]
103 ]