]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/MonoFunctor/Test.hs
factorizing Type1_From ast Type0
[haskell/symantic.git] / Language / Symantic / Expr / MonoFunctor / 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.MonoFunctor.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, (||), (==), fmap, (+))
19
20 import Language.Symantic.Type
21 import Language.Symantic.Expr as Expr
22 import Language.Symantic.Repr
23
24 import AST.Test
25
26 -- * Expressions
27 t = bool True
28 f = bool False
29 e1 = omap (lam $ \x -> x + int 1) (list $ int Prelude.<$> [1..3])
30 e2 = omap (lam char_toUpper) (text "abcde")
31
32 -- * Tests
33 type Ex = Expr_Root
34 ( Expr_Lambda
35 .|. Expr_Maybe
36 .|. Expr_List
37 .|. Expr_MonoFunctor
38 .|. Expr_Int
39 .|. Expr_Integer
40 .|. Expr_Num
41 .|. Expr_Bool
42 .|. Expr_Char
43 .|. Expr_Text
44 )
45 ex_from = root_expr_from (Proxy::Proxy Ex)
46
47 (==>) ast expected =
48 testCase (show ast) $
49 case ex_from ast of
50 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
51 Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
52 case expected of
53 Left (_, err) -> Right ("…"::String) @?= Left err
54 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
55 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
56 case ty `type0_eq` ty_expected of
57 Nothing -> Monad.return $ Left $
58 error_expr (Proxy::Proxy Ex) $
59 Error_Expr_Type_mismatch ast
60 (Exists_Type0 ty)
61 (Exists_Type0 ty_expected)
62 Just Refl -> do
63 let h = host_from_expr r
64 Monad.return $
65 Right
66 ( ty
67 , h
68 , text_from_expr r
69 -- , (text_from_expr :: Repr_Text h -> Text) r
70 )
71
72 tests :: TestTree
73 tests = testGroup "MonoFunctor"
74 [ AST "omap"
75 [ AST "\\"
76 [ AST "x" []
77 , AST "Int" []
78 , AST "+" [ AST "var" [AST "x" []]
79 , AST "int" [AST "1" []] ]
80 ]
81 , AST "list"
82 [ AST "Int" []
83 , AST "int" [AST "1" []]
84 , AST "int" [AST "2" []]
85 , AST "int" [AST "3" []]
86 ]
87 ] ==> Right
88 ( type_list type_int
89 , [2,3,4]
90 , "omap (\\x0 -> x0 + 1) [1, 2, 3]" )
91 , AST "omap"
92 [ AST "\\"
93 [ AST "x" []
94 , AST "Char" []
95 , AST "char_toUpper" [ AST "var" [AST "x" []] ]
96 ]
97 , AST "text" [ AST "abcde" [] ]
98 ] ==> Right
99 ( type_text
100 , "ABCDE"
101 , "omap (\\x0 -> char_toUpper x0) \"abcde\"" )
102 ]