]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Compiling/Map/Test.hs
Add Typing.Family and Compiling.MonoFunctor.
[haskell/symantic.git] / Language / Symantic / Compiling / Map / Test.hs
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE NoMonomorphismRestriction #-}
3 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
4 {-# OPTIONS_GHC -O0 #-} -- speedup compile-time…
5 module Compiling.Map.Test where
6
7 import Test.Tasty
8
9 import Data.Map.Strict (Map)
10 import qualified Data.Map.Strict as Map
11 import Data.Proxy (Proxy(..))
12 import Data.Text (Text)
13 import qualified Data.Text as Text
14 import Prelude hiding (zipWith)
15
16 import Language.Symantic.Typing
17 import Language.Symantic.Compiling
18 import Compiling.Term.Test
19
20 -- * Terms
21 t = bool True
22 f = bool False
23 e1 = map_fromList $ zipWith (lam (lam . tuple2))
24 (list $ int Prelude.<$> [1..5])
25 (list $ (text . Text.singleton) Prelude.<$> ['a'..'e'])
26
27 -- * Tests
28 type Ifaces =
29 [ Proxy (->)
30 , Proxy []
31 , Proxy Int
32 , Proxy Map
33 , Proxy Text
34 , Proxy (,)
35 , Proxy Num
36 , Proxy Monoid
37 ]
38 (==>) = test_term_from (Proxy::Proxy Ifaces)
39
40 tests :: TestTree
41 tests = testGroup "Map"
42 [ Syntax "Map.fromList"
43 [ Syntax "zipWith"
44 [ syLam (Syntax "x" []) syInt $
45 syLam (Syntax "y" []) syText $
46 Syntax "(,)"
47 [ Syntax "x" []
48 , Syntax "y" []
49 ]
50 , Syntax "list"
51 [ syInt
52 , Syntax "int" [Syntax "1" []]
53 , Syntax "int" [Syntax "2" []]
54 , Syntax "int" [Syntax "3" []]
55 ]
56 , Syntax "list"
57 [ syText
58 , Syntax "text" [Syntax "\"a\"" []]
59 , Syntax "text" [Syntax "\"b\"" []]
60 , Syntax "text" [Syntax "\"c\"" []]
61 ]
62 ]
63 ] ==> Right
64 ( (tyMap :$ tyInt) :$ tyText
65 , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
66 , "Map.fromList (((\\x0 -> (\\x1 -> zipWith (\\x2 -> (\\x3 -> (x2, x3))) x0 x1)) [1, 2, 3]) [\"a\", \"b\", \"c\"])" )
67 , Syntax "Map.foldrWithKey"
68 [ syLam (Syntax "k" []) syInt $
69 syLam (Syntax "v" []) syText $
70 syLam (Syntax "a" []) (syTuple2 [syInt, syText]) $
71 syTuple2
72 [ Syntax "+"
73 [ Syntax "k" []
74 , Syntax "fst" [ Syntax "a" [] ]
75 ]
76 , Syntax "mappend"
77 [ Syntax "v" []
78 , Syntax "snd" [ Syntax "a" [] ]
79 ]
80 ]
81 , syTuple2
82 [ Syntax "int" [Syntax "0" []]
83 , Syntax "text" [Syntax "\"\"" []]
84 ]
85 , Syntax "Map.fromList"
86 [ Syntax "zipWith"
87 [ syLam (Syntax "x" []) syInt $
88 syLam (Syntax "y" []) syText $
89 syTuple2
90 [ Syntax "x" []
91 , Syntax "y" []
92 ]
93 , Syntax "list"
94 [ syInt
95 , Syntax "int" [Syntax "1" []]
96 , Syntax "int" [Syntax "2" []]
97 , Syntax "int" [Syntax "3" []]
98 ]
99 , Syntax "list"
100 [ syText
101 , Syntax "text" [Syntax "\"a\"" []]
102 , Syntax "text" [Syntax "\"b\"" []]
103 , Syntax "text" [Syntax "\"c\"" []]
104 ]
105 ]
106 ]
107 ] ==> Right
108 ( (tyTuple2 :$ tyInt) :$ tyText
109 , (6, "abc")
110 , "((\\x0 -> (\\x1 -> Map.foldrWithKey (\\x2 -> (\\x3 -> (\\x4 -> ((\\x5 -> x2 + x5) (fst x4), (\\x5 -> mappend x3 x5) (snd x4))))) x0 x1)) (0, \"\")) (Map.fromList (((\\x0 -> (\\x1 -> zipWith (\\x2 -> (\\x3 -> (x2, x3))) x0 x1)) [1, 2, 3]) [\"a\", \"b\", \"c\"]))" )
111 ]