]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/Map/Test.hs
fix Num requiring Integer
[haskell/symantic.git] / Language / Symantic / Expr / Map / Test.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE NoMonomorphismRestriction #-}
4 {-# LANGUAGE Rank2Types #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeOperators #-}
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
8 module Expr.Map.Test where
9
10 import Test.Tasty
11 import Test.Tasty.HUnit
12
13 import qualified Control.Arrow as Arrow
14 import qualified Control.Monad as Monad
15 -- import qualified Data.List as List
16 import qualified Data.Map.Strict as Map
17 import Data.Proxy (Proxy(..))
18 import Data.Text (Text)
19 import qualified Data.Text as Text
20 import Data.Type.Equality ((:~:)(Refl))
21 import Prelude hiding (maybe, not)
22
23 import Language.Symantic.Repr
24 import Language.Symantic.Expr
25 import Language.Symantic.Type
26
27 import AST.Test
28
29 -- * Expressions
30 t = bool True
31 f = bool False
32 e1 = map_from_list $ list_zipWith (lam (lam . tuple2))
33 (list $ int Prelude.<$> [1..5])
34 (list $ (text . Text.singleton) Prelude.<$> ['a'..'e'])
35
36 -- * Tests
37 type Ex = Expr_Root
38 ( Expr_Lambda
39 .|. Expr_Map
40 .|. Expr_Bool
41 .|. Expr_Maybe
42 .|. Expr_List
43 .|. Expr_Eq
44 .|. Expr_Ord
45 .|. Expr_Tuple2
46 .|. Expr_Int
47 .|. Expr_Integer
48 .|. Expr_Text
49 .|. Expr_Monoid
50 .|. Expr_Num
51 )
52 ex_from = root_expr_from (Proxy::Proxy Ex)
53
54 (==>) ast expected =
55 testCase (show ast) $
56 case ex_from ast of
57 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
58 Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
59 case expected of
60 Left (_, err) -> Right ("…"::String) @?= Left err
61 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
62 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
63 case ty `type0_eq` ty_expected of
64 Nothing -> Monad.return $ Left $
65 error_expr (Proxy::Proxy Ex) $
66 Error_Expr_Type_mismatch ast
67 (Exists_Type0 ty)
68 (Exists_Type0 ty_expected)
69 Just Refl -> do
70 let h = host_from_expr r
71 Monad.return $
72 Right
73 ( ty
74 , h
75 , text_from_expr r
76 -- , (text_from_expr :: Repr_Text h -> Text) r
77 )
78
79 tests :: TestTree
80 tests = testGroup "Map"
81 [ AST "map_from_list"
82 [ AST "list_zipWith"
83 [ AST "\\"
84 [ AST "x" []
85 , AST "Int" []
86 , AST "\\"
87 [ AST "y" []
88 , AST "Text" []
89 , AST "(,)"
90 [ AST "var" [AST "x" []]
91 , AST "var" [AST "y" []]
92 ]
93 ]
94 ]
95 , AST "list"
96 [ AST "Int" []
97 , AST "int" [AST "1" []]
98 , AST "int" [AST "2" []]
99 , AST "int" [AST "3" []]
100 ]
101 , AST "list"
102 [ AST "Text" []
103 , AST "text" [AST "a" []]
104 , AST "text" [AST "b" []]
105 , AST "text" [AST "c" []]
106 ]
107 ]
108 ] ==> Right
109 ( type_map type_int type_text
110 , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
111 , "map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"])" )
112 , AST "map_foldrWithKey"
113 [ AST "\\"
114 [ AST "k" []
115 , AST "Int" []
116 , AST "\\"
117 [ AST "v" []
118 , AST "Text" []
119 , AST "\\"
120 [ AST "a" []
121 , AST "(,)" [AST "Int" [], AST "Text" []]
122 , AST "(,)"
123 [ AST "+"
124 [ AST "var" [AST "k" []]
125 , AST "fst" [ AST "var" [AST "a" []] ]
126 ]
127 , AST "mappend"
128 [ AST "var" [AST "v" []]
129 , AST "snd" [ AST "var" [AST "a" []] ]
130 ]
131 ]
132 ]
133 ]
134 ]
135 , AST "(,)"
136 [ AST "int" [AST "0" []]
137 , AST "text" [AST "" []]
138 ]
139 , AST "map_from_list"
140 [ AST "list_zipWith"
141 [ AST "\\"
142 [ AST "x" []
143 , AST "Int" []
144 , AST "\\"
145 [ AST "y" []
146 , AST "Text" []
147 , AST "(,)"
148 [ AST "var" [AST "x" []]
149 , AST "var" [AST "y" []]
150 ]
151 ]
152 ]
153 , AST "list"
154 [ AST "Int" []
155 , AST "int" [AST "1" []]
156 , AST "int" [AST "2" []]
157 , AST "int" [AST "3" []]
158 ]
159 , AST "list"
160 [ AST "Text" []
161 , AST "text" [AST "a" []]
162 , AST "text" [AST "b" []]
163 , AST "text" [AST "c" []]
164 ]
165 ]
166 ]
167 ] ==> Right
168 ( type_tuple2 type_int type_text
169 , (6, "abc")
170 , "map_foldrWithKey (\\x0 -> (\\x1 -> (\\x2 -> (x0 + fst x2, mappend x1 (snd x2))))) (0, \"\") (map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"]))" )
171 ]