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
45 .|. Expr_Traversable lam
47 ex_from = root_expr_from (Proxy::Proxy (Ex lam)) (Proxy::Proxy lam)
52 Left err -> Left err @?= snd `Arrow.left` expected
53 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
55 Left (_, err) -> Right ("…"::String) @?= Left err
56 Right (ty_expected::Type_Root_of_Expr (Ex Identity) h, _::h, _::Text) ->
57 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
58 case ty `eq_type` ty_expected of
59 Nothing -> Monad.return $ Left $
60 error_expr (Proxy::Proxy (Ex Identity)) $
61 Error_Expr_Type_mismatch ast
63 (Exists_Type ty_expected)
65 let h = runIdentity $ host_from_expr r
71 -- , (text_from_expr :: Repr_Text Identity h -> Text) r
75 tests = testGroup "Traversable"
79 [ AST "x" [], AST "Int" []
81 [ AST "y" [], AST "Int" []
82 , AST "+" [ AST "var" [AST "x" []]
83 , AST "var" [AST "y" []] ]
86 , AST "just" [ AST "int" [AST "1" []] ]
88 , AST "just" [ AST "int" [AST "2" []] ]
92 , "fmap (\\x0 -> (\\x1 -> x0 + x1)) (just 1) <*> just 2" )