1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE NoMonomorphismRestriction #-}
5 {-# LANGUAGE ScopedTypeVariables #-}
6 {-# LANGUAGE TypeOperators #-}
7 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
9 module Expr.Applicative.Test where
12 import Test.Tasty.HUnit
14 import Control.Arrow (left)
15 import Data.Proxy (Proxy(..))
16 import Data.Text (Text)
17 import Data.Type.Equality ((:~:)(Refl))
18 import Prelude hiding ((&&), not, (||), (==), (<$>), (+), Applicative(..))
20 import Language.Symantic.Type
21 import Language.Symantic.Expr as Expr
22 import Language.Symantic.Repr
29 e1 = val (\x -> val $ \y -> x + y)
34 type Ex lam = Expr_Root
36 .|. Expr_Lambda_Val lam
42 .|. Expr_Applicative lam
44 ex_from = root_expr_from (Proxy::Proxy (Ex lam)) (Proxy::Proxy lam)
49 Left err -> Left err @?= snd `left` expected
50 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
52 Left (_, err) -> Right ("…"::String) @?= Left err
53 Right (ty_expected::Type_Root_of_Expr (Ex IO) h, _::h, _::Text) ->
54 (>>= (@?= (\(_::Proxy h, err) -> err) `left` expected)) $
55 case ty `eq_type` ty_expected of
56 Nothing -> return $ Left $
57 error_expr (Proxy::Proxy (Ex IO)) $
58 Error_Expr_Type_mismatch ast
60 (Exists_Type ty_expected)
68 -- , (text_from_expr :: Repr_String IO h -> Text) r
72 tests = testGroup "Applicative"
76 [ AST "x" [], AST "Int" []
78 [ AST "y" [], AST "Int" []
79 , AST "+" [ AST "var" [AST "x" []]
80 , AST "var" [AST "y" []] ]
83 , AST "just" [ AST "int" [AST "1" []] ]
85 , AST "just" [ AST "int" [AST "2" []] ]
89 , "fmap (\\x0 -> (\\x1 -> x0 + x1)) (just 1) <*> just 2" )