]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/List/Test.hs
init
[haskell/symantic.git] / Language / Symantic / Expr / List / Test.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE NoMonomorphismRestriction #-}
4 {-# LANGUAGE Rank2Types #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
7 module Expr.List.Test where
8
9 import Test.Tasty
10 {-
11 import Test.Tasty.HUnit
12
13 import Control.Arrow (left)
14 import Data.Proxy (Proxy(..))
15 import Data.Text (Text)
16 import Data.Type.Equality ((:~:)(Refl))
17 -}
18 import Prelude hiding (mod, (==))
19
20 -- import Language.Symantic.Repr
21 import Language.Symantic.Expr
22 -- import Language.Symantic.Type
23
24 -- import AST.Test
25
26 -- * Expressions
27 t = bool True
28 f = bool False
29 e1 = list_filter (inline $ \x -> if_ (x `mod` int 2 == int 0) t f)
30 (list $ int Prelude.<$> [1..5])
31
32 {-
33 -- * Tests
34 (==>) ast expected =
35 testCase (show ast) $
36 case ex_from (Proxy::Proxy IO) ast of
37 Left err -> Left err @?= snd `left` expected
38 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
39 case expected of
40 Left (_, err) -> Right ("…"::String) @?= Left err
41 Right (ty_expected::Type_Root_of_Expr (Ex IO) h, _::h, _::Text) ->
42 (>>= (@?= (\(_::Proxy h, err) -> err) `left` expected)) $
43 case ty `eq_type` ty_expected of
44 Nothing -> return $ Left $
45 error_expr (Proxy::Proxy (Ex IO)) $
46 Error_Expr_Type_mismatch ast
47 (Exists_Type ty)
48 (Exists_Type ty_expected)
49 Just Refl -> do
50 h <- host_from_expr r
51 return $
52 Right
53 ( ty
54 , h
55 , text_from_expr r
56 -- , (text_from_expr :: Repr_String IO h -> Text) r
57 )
58 -}
59 tests :: TestTree
60 tests = testGroup "List"
61 [{- AST "just" [AST "bool" [AST "True" []]] ==> Right
62 ( type_maybe type_bool
63 , Just True
64 , "just True" )
65 , AST "just"
66 [ AST "let_val"
67 [ AST "x" []
68 , AST "bool" [AST "True" []]
69 , AST "var" [AST "x" []]
70 ]
71 ] ==> Right
72 ( type_maybe type_bool
73 , Just True
74 , "just (let x0 = True in x0)" )
75 , AST "maybe"
76 [ AST "bool" [AST "True" []]
77 , AST "val"
78 [ AST "x" []
79 , AST "Bool" []
80 , AST "not" [AST "var" [AST "x" []]]
81 ]
82 , AST "nothing"
83 [ AST "Bool" []
84 ]
85 ] ==> Right
86 ( type_bool
87 , True
88 , "maybe True (\\x0 -> !x0) nothing" )
89 , AST "maybe"
90 [ AST "bool" [AST "False" []]
91 , AST "val"
92 [ AST "x" []
93 , AST "Bool" []
94 , AST "not" [AST "var" [AST "x" []]]
95 ]
96 , AST "just"
97 [ AST "bool" [AST "True" []]
98 ]
99 ] ==> Right
100 ( type_bool
101 , False
102 , "maybe False (\\x0 -> !x0) (just True)" )
103 -}]