]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/Eq/Test.hs
fix (->) by removing inline/val/lazy
[haskell/symantic.git] / Language / Symantic / Expr / Eq / Test.hs
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE GADTs #-}
3 {-# LANGUAGE NoMonomorphismRestriction #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5 {-# LANGUAGE TypeOperators #-}
6 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
7
8 module Expr.Eq.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 Data.Proxy (Proxy(..))
16 import Data.Text (Text)
17 import Data.Type.Equality ((:~:)(Refl))
18 import Prelude hiding ((&&), not, (||), (==))
19
20 import Language.Symantic.Type
21 import Language.Symantic.Expr
22 import Language.Symantic.Repr
23
24 import AST.Test
25
26 -- * Expressions
27 t = bool True
28 f = bool False
29 e1 = if_ ((t && t) == (t || f)) t f
30 e2 = if_ (((t && t) || f) == (t && (t || f))) t f
31 e3 = if_ (not (t == f) == (t == t)) t f
32
33 -- * Tests
34 type Ex = Expr_Root
35 ( Expr_Lambda
36 .|. Expr_Bool
37 .|. Expr_Eq
38 )
39 ex_from = root_expr_from (Proxy::Proxy Ex)
40
41 (==>) ast expected =
42 testCase (show ast) $
43 case ex_from ast of
44 Left err -> Left err @?= snd `Arrow.left` expected
45 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
46 case expected of
47 Left (_, err) -> Right ("…"::String) @?= Left err
48 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
49 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
50 case ty `eq_type` ty_expected of
51 Nothing -> Monad.return $ Left $
52 error_expr (Proxy::Proxy Ex) $
53 Error_Expr_Type_mismatch ast
54 (Exists_Type ty)
55 (Exists_Type ty_expected)
56 Just Refl -> do
57 let h = host_from_expr r
58 Monad.return $
59 Right
60 ( ty
61 , h
62 , text_from_expr r
63 -- , (text_from_expr :: Repr_Text h -> Text) r
64 )
65
66 tests :: TestTree
67 tests = testGroup "Eq"
68 [ AST "==" [ AST "bool" [AST "True" []]
69 , AST "bool" [AST "True" []]
70 ] ==> Right
71 ( type_bool
72 , True
73 , "True == True" )
74 , AST "$"
75 [ AST "\\"
76 [ AST "x" []
77 , AST "Bool" []
78 , AST "==" [ AST "var" [AST "x" []]
79 , AST "not" [AST "var" [AST "x" []]] ]
80 ]
81 , AST "bool" [AST "True" []]
82 ] ==> Right
83 ( type_bool
84 , False
85 , "(\\x0 -> x0 == !x0) True" )
86 ]