]> Git — Sourcephile - haskell/symantic.git/blob - Language/Symantic/Expr/Functor/Test.hs
fix Num requiring Integer
[haskell/symantic.git] / Language / Symantic / Expr / Functor / 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.Functor.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 = fmap (lam $ \x -> x + int 1) (list $ int Prelude.<$> [1..3])
30
31 -- * Tests
32 type Ex = Expr_Root
33 ( Expr_Lambda
34 .|. Expr_Maybe
35 .|. Expr_List
36 .|. Expr_Functor
37 .|. Expr_Int
38 .|. Expr_Integer
39 .|. Expr_Num
40 .|. Expr_Bool
41 )
42 ex_from = root_expr_from (Proxy::Proxy Ex)
43
44 (==>) ast expected =
45 testCase (show ast) $
46 case ex_from ast of
47 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
48 Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
49 case expected of
50 Left (_, err) -> Right ("…"::String) @?= Left err
51 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
52 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
53 case ty `type0_eq` ty_expected of
54 Nothing -> Monad.return $ Left $
55 error_expr (Proxy::Proxy Ex) $
56 Error_Expr_Type_mismatch ast
57 (Exists_Type0 ty)
58 (Exists_Type0 ty_expected)
59 Just Refl -> do
60 let h = host_from_expr r
61 Monad.return $
62 Right
63 ( ty
64 , h
65 , text_from_expr r
66 -- , (text_from_expr :: Repr_Text h -> Text) r
67 )
68
69 tests :: TestTree
70 tests = testGroup "Functor"
71 [ AST "fmap"
72 [ AST "\\"
73 [ AST "x" []
74 , AST "Int" []
75 , AST "+" [ AST "var" [AST "x" []]
76 , AST "int" [AST "1" []] ]
77 ]
78 , AST "list"
79 [ AST "Int" []
80 , AST "int" [AST "1" []]
81 , AST "int" [AST "2" []]
82 , AST "int" [AST "3" []]
83 ]
84 ] ==> Right
85 ( type_list type_int
86 , [2,3,4]
87 , "fmap (\\x0 -> x0 + 1) [1, 2, 3]" )
88 ]