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 qualified Control.Arrow as Arrow
15 import qualified Control.Monad as Monad
16 import Data.Functor.Identity
17 import Data.Proxy (Proxy(..))
18 import Data.Text (Text)
19 import Data.Type.Equality ((:~:)(Refl))
20 import Prelude hiding ((&&), not, (||), (==), (<$>), (+), Applicative(..))
22 import Language.Symantic.Type
23 import Language.Symantic.Expr as Expr
24 import Language.Symantic.Repr
31 e1 = val (\x -> val $ \y -> x + y)
36 type Ex lam = Expr_Root
38 .|. Expr_Lambda_Val lam
44 .|. Expr_Applicative lam
46 ex_from = root_expr_from (Proxy::Proxy (Ex lam)) (Proxy::Proxy lam)
51 Left err -> Left err @?= snd `Arrow.left` expected
52 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
54 Left (_, err) -> Right ("…"::String) @?= Left err
55 Right (ty_expected::Type_Root_of_Expr (Ex Identity) h, _::h, _::Text) ->
56 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
57 case ty `eq_type` ty_expected of
58 Nothing -> Monad.return $ Left $
59 error_expr (Proxy::Proxy (Ex Identity)) $
60 Error_Expr_Type_mismatch ast
62 (Exists_Type ty_expected)
64 let h = runIdentity $ host_from_expr r
70 -- , (text_from_expr :: Repr_Text Identity h -> Text) r
74 tests = testGroup "Applicative"
78 [ AST "x" [], AST "Int" []
80 [ AST "y" [], AST "Int" []
81 , AST "+" [ AST "var" [AST "x" []]
82 , AST "var" [AST "y" []] ]
85 , AST "just" [ AST "int" [AST "1" []] ]
87 , AST "just" [ AST "int" [AST "2" []] ]
91 , "fmap (\\x0 -> (\\x1 -> x0 + x1)) (just 1) <*> just 2" )