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