]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/If/Test.hs
init
[haskell/symantic.git] / Language / Symantic / Expr / If / 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.If.Test where
9
10 import Test.Tasty
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 import Prelude hiding (maybe, not, (&&))
18
19 import Language.Symantic.Repr
20 import Language.Symantic.Expr
21 import Language.Symantic.Type
22
23 import AST.Test
24
25 -- * Expressions
26 e1 = if_ (bool True) (bool False) (bool True)
27 e2 = if_ (bool True && bool True) (bool False) (bool True)
28
29 -- * Tests
30 type Ex lam = Expr_Root (Expr_Lambda lam .|. Expr_If .|. Expr_Bool)
31 ex_from = root_expr_from (Proxy::Proxy (Ex lam)) (Proxy::Proxy lam)
32
33 (==>) ast expected =
34 testCase (show ast) $
35 case ex_from ast of
36 Left err -> Left err @?= snd `left` expected
37 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
38 case expected of
39 Left (_, err) -> Right ("…"::String) @?= Left err
40 Right (ty_expected::Type_Root_of_Expr (Ex IO) h, _::h, _::Text) ->
41 (>>= (@?= (\(_::Proxy h, err) -> err) `left` expected)) $
42 case ty `eq_type` ty_expected of
43 Nothing -> return $ Left $
44 error_expr (Proxy::Proxy (Ex IO)) $
45 Error_Expr_Type_mismatch ast
46 (Exists_Type ty)
47 (Exists_Type ty_expected)
48 Just Refl -> do
49 h <- host_from_expr r
50 return $
51 Right
52 ( ty
53 , h
54 , text_from_expr r
55 -- , (text_from_expr :: Repr_String IO h -> String) r
56 )
57
58 tests :: TestTree
59 tests = testGroup "If"
60 [ AST "if"
61 [ AST "bool" [AST "True" []]
62 , AST "bool" [AST "False" []]
63 , AST "bool" [AST "True" []]
64 ] ==> Right
65 ( type_bool
66 , False
67 , "if True then False else True" )
68 ]