1 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE NoMonomorphismRestriction #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5 {-# LANGUAGE TypeOperators #-}
6 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
8 module Expr.Functor.Test where
11 import Test.Tasty.HUnit
13 import qualified Control.Arrow as Arrow
14 import qualified Control.Monad as Monad
15 import Data.Functor.Identity
16 import Data.Proxy (Proxy(..))
17 import Data.Text (Text)
18 import Data.Type.Equality ((:~:)(Refl))
19 import Prelude hiding ((&&), not, (||), (==), fmap, (+))
21 import Language.Symantic.Type
22 import Language.Symantic.Expr as Expr
23 import Language.Symantic.Repr
30 e1 = fmap (val $ \x -> x + int 1) (list $ int Prelude.<$> [1..3])
33 type Ex lam = Expr_Root
35 .|. Expr_Lambda_Val lam
42 ex_from = root_expr_from (Proxy::Proxy (Ex lam)) (Proxy::Proxy lam)
47 Left err -> Left err @?= snd `Arrow.left` expected
48 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
50 Left (_, err) -> Right ("…"::String) @?= Left err
51 Right (ty_expected::Type_Root_of_Expr (Ex Identity) h, _::h, _::Text) ->
52 (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
53 case ty `eq_type` ty_expected of
54 Nothing -> Monad.return $ Left $
55 error_expr (Proxy::Proxy (Ex Identity)) $
56 Error_Expr_Type_mismatch ast
58 (Exists_Type ty_expected)
60 let h = runIdentity $ host_from_expr r
66 -- , (text_from_expr :: Repr_Text Identity h -> Text) r
70 tests = testGroup "Functor"
75 , AST "+" [ AST "var" [AST "x" []]
76 , AST "int" [AST "1" []] ]
80 , AST "int" [AST "1" []]
81 , AST "int" [AST "2" []]
82 , AST "int" [AST "3" []]
87 , "fmap (\\x0 -> x0 + 1) [1, 2, 3]" )