]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/Maybe/Test.hs
Integer, Integral, Num
[haskell/symantic.git] / Language / Symantic / Expr / Maybe / 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.Maybe.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)
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 = maybe (bool True) (lam not) (just $ bool True)
28
29 -- * Tests
30 type Ex = Expr_Root
31 ( Expr_Lambda
32 .|. Expr_Maybe
33 .|. Expr_Bool
34 )
35 ex_from = root_expr_from (Proxy::Proxy Ex)
36
37 (==>) ast expected =
38 testCase (show ast) $
39 case ex_from ast of
40 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
41 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
42 case expected of
43 Left (_, err) -> Right ("…"::String) @?= Left err
44 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
45 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
46 case ty `eq_type` ty_expected of
47 Nothing -> Monad.return $ Left $
48 error_expr (Proxy::Proxy Ex) $
49 Error_Expr_Type_mismatch ast
50 (Exists_Type ty)
51 (Exists_Type ty_expected)
52 Just Refl -> do
53 let h = host_from_expr r
54 Monad.return $
55 Right
56 ( ty
57 , h
58 , text_from_expr r
59 -- , (text_from_expr :: Repr_Text h -> Text) r
60 )
61
62 tests :: TestTree
63 tests = testGroup "Maybe"
64 [ AST "just" [AST "bool" [AST "True" []]] ==> Right
65 ( type_maybe type_bool
66 , Just True
67 , "just True" )
68 , AST "just"
69 [ AST "let"
70 [ AST "x" []
71 , AST "bool" [AST "True" []]
72 , AST "var" [AST "x" []]
73 ]
74 ] ==> Right
75 ( type_maybe type_bool
76 , Just True
77 , "just (let x0 = True in x0)" )
78 , AST "maybe"
79 [ AST "bool" [AST "True" []]
80 , AST "\\"
81 [ AST "x" []
82 , AST "Bool" []
83 , AST "not" [AST "var" [AST "x" []]]
84 ]
85 , AST "nothing"
86 [ AST "Bool" []
87 ]
88 ] ==> Right
89 ( type_bool
90 , True
91 , "maybe True (\\x0 -> !x0) nothing" )
92 , AST "maybe"
93 [ AST "bool" [AST "False" []]
94 , AST "\\"
95 [ AST "x" []
96 , AST "Bool" []
97 , AST "not" [AST "var" [AST "x" []]]
98 ]
99 , AST "just"
100 [ AST "bool" [AST "True" []]
101 ]
102 ] ==> Right
103 ( type_bool
104 , False
105 , "maybe False (\\x0 -> !x0) (just True)" )
106 ]