]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/If/Test.hs
factorizing Type1_From ast Type0
[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 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 (maybe, not, (&&), Monad(..))
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 e1 = if_ (bool True) (bool False) (bool True)
28 e2 = if_ (bool True && bool True) (bool False) (bool True)
29
30 -- * Tests
31 type Ex = Expr_Root
32 ( Expr_Lambda
33 .|. Expr_If
34 .|. Expr_Bool
35 )
36 ex_from = root_expr_from (Proxy::Proxy Ex)
37
38 (==>) ast expected =
39 testCase (show ast) $
40 case ex_from ast of
41 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
42 Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
43 case expected of
44 Left (_, err) -> Right ("…"::String) @?= Left err
45 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
46 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
47 case ty `type0_eq` ty_expected of
48 Nothing -> Monad.return $ Left $
49 error_expr (Proxy::Proxy Ex) $
50 Error_Expr_Type_mismatch ast
51 (Exists_Type0 ty)
52 (Exists_Type0 ty_expected)
53 Just Refl -> do
54 let h = host_from_expr r
55 Monad.return $
56 Right
57 ( ty
58 , h
59 , text_from_expr r
60 -- , (text_from_expr :: Repr_Text h -> Text) r
61 )
62
63 tests :: TestTree
64 tests = testGroup "If"
65 [ AST "if"
66 [ AST "bool" [AST "True" []]
67 , AST "bool" [AST "False" []]
68 , AST "bool" [AST "True" []]
69 ] ==> Right
70 ( type_bool
71 , False
72 , "if True then False else True" )
73 ]