X-Git-Url: https://git.sourcephile.fr/haskell/symantic.git/blobdiff_plain/f42ef36108725a4daf6132ffae9a747aba17fed5..1a9992f46d376b20475e04c7439c8a43b131eeef:/Language/Symantic/Repr/Host/Test.hs

diff --git a/Language/Symantic/Repr/Host/Test.hs b/Language/Symantic/Repr/Host/Test.hs
index 67d70f7..a3f52fd 100644
--- a/Language/Symantic/Repr/Host/Test.hs
+++ b/Language/Symantic/Repr/Host/Test.hs
@@ -8,13 +8,12 @@
 module Repr.Host.Test where
 
 -- import Data.Function (($))
--- import Data.Functor.Identity (Identity)
 import Test.Tasty
 import Test.Tasty.HUnit
 
 import Data.Text (Text)
 import qualified Data.Text as Text
-import Prelude hiding (and, not, or)
+import Prelude hiding (and, not, or, Monad(..), id)
 
 import Language.Symantic.Repr
 import Language.Symantic.Expr
@@ -23,13 +22,19 @@ import qualified Expr.Bool.Test as Bool.Test
 import qualified Expr.Maybe.Test as Maybe.Test
 import qualified Expr.If.Test as If.Test
 import qualified Expr.List.Test as List.Test
+import qualified Expr.Functor.Test as Functor.Test
+import qualified Expr.Applicative.Test as Applicative.Test
+import qualified Expr.Foldable.Test as Foldable.Test
 
 tests :: TestTree
 tests = testGroup "Host" $
  [ testGroup "Bool" $
-	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (Expr_Lambda IO .|. Expr_Bool)) repr => repr h) expected =
-		testCase (Text.unpack $ (text_from_expr :: Repr_Text IO _h -> Text) $ expr) $
-		(>>= (@?= expected)) $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_Bool
+	                                                    )) repr => repr h) expected =
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		-- (>>= (@?= expected)) $
+		(@?= expected) $
 		host_from_expr expr in
 	 [ Bool.Test.e1 ==> False
 	 , Bool.Test.e2 ==> True
@@ -37,56 +42,109 @@ tests = testGroup "Host" $
 	 , Bool.Test.e4 ==> True
 	 ]
  , testGroup "Lambda" $
-	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (Expr_Lambda IO .|. Expr_Bool)) repr => repr h) expected =
-		testCase (Text.unpack $ (text_from_expr :: Repr_Text IO _h -> Text) $ expr) $
-		(>>= (@?= expected)) $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_Bool
+	                                                    )) repr => repr h) expected =
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		(@?= expected) $
 		host_from_expr expr in
-	 [ (Lambda.Test.e1 `app` bool True  `app` bool True)  ==> False
-	 , (Lambda.Test.e1 `app` bool True  `app` bool False) ==> True
-	 , (Lambda.Test.e1 `app` bool False `app` bool True)  ==> True
-	 , (Lambda.Test.e1 `app` bool False `app` bool False) ==> False
+	 [ (Lambda.Test.e1 $$ bool True  $$ bool True)  ==> False
+	 , (Lambda.Test.e1 $$ bool True  $$ bool False) ==> True
+	 , (Lambda.Test.e1 $$ bool False $$ bool True)  ==> True
+	 , (Lambda.Test.e1 $$ bool False $$ bool False) ==> False
 	 
-	 , (Lambda.Test.e2 `app` bool True  `app` bool True)  ==> False
-	 , (Lambda.Test.e2 `app` bool True  `app` bool False) ==> True
-	 , (Lambda.Test.e2 `app` bool False `app` bool True)  ==> True
-	 , (Lambda.Test.e2 `app` bool False `app` bool False) ==> False
+	 , (Lambda.Test.e2 $$ bool True  $$ bool True)  ==> False
+	 , (Lambda.Test.e2 $$ bool True  $$ bool False) ==> True
+	 , (Lambda.Test.e2 $$ bool False $$ bool True)  ==> True
+	 , (Lambda.Test.e2 $$ bool False $$ bool False) ==> False
 	 
 	 , Lambda.Test.e3 ==> True
 	 , Lambda.Test.e4 ==> True
 	 
-	 , (Lambda.Test.e5 `app` bool True  `app` bool True)  ==> True
-	 , (Lambda.Test.e5 `app` bool True  `app` bool False) ==> False
-	 , (Lambda.Test.e5 `app` bool False `app` bool True)  ==> False
-	 , (Lambda.Test.e5 `app` bool False `app` bool False) ==> False
+	 , (Lambda.Test.e5 $$ bool True  $$ bool True)  ==> True
+	 , (Lambda.Test.e5 $$ bool True  $$ bool False) ==> False
+	 , (Lambda.Test.e5 $$ bool False $$ bool True)  ==> False
+	 , (Lambda.Test.e5 $$ bool False $$ bool False) ==> False
 	 
 	 , Lambda.Test.e6 ==> False
-	 , (Lambda.Test.e7 `app` val id) ==> True
-	 , (Lambda.Test.e7 `app` val not) ==> False
+	 , (Lambda.Test.e7 $$ lam id) ==> True
+	 , (Lambda.Test.e7 $$ lam not) ==> False
 	 ]
  , testGroup "Maybe" $
-	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (Expr_Lambda IO .|. Expr_Maybe IO .|. Expr_Bool)) repr => repr h) expected =
-		testCase (Text.unpack $ (text_from_expr :: Repr_Text IO _h -> Text) $ expr) $
-		(>>= (@?= expected)) $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_Maybe
+	                                                    .|. Expr_Bool )) repr => repr h) expected =
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		(@?= expected) $
 		host_from_expr expr in
 	 [ Maybe.Test.e1 ==> False
 	 ]
  , testGroup "If" $
-	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (Expr_Lambda IO .|. Expr_If .|. Expr_Bool)) repr => repr h) expected =
-		testCase (Text.unpack $ (text_from_expr :: Repr_Text IO _h -> Text) $ expr) $
-		(>>= (@?= expected)) $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_If
+	                                                    .|. Expr_Bool )) repr => repr h) expected =
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		(@?= expected) $
 		host_from_expr expr in
 	 [ If.Test.e1 ==> False
 	 ]
  , testGroup "List" $
-	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda IO
-	                                                    .|. Expr_List IO
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_List
 	                                                    .|. Expr_Bool
 	                                                    .|. Expr_Int
+	                                                    .|. Expr_Num
+	                                                    .|. Expr_Integral
 	                                                    .|. Expr_If
 	                                                    .|. Expr_Eq )) repr => repr h) expected =
-		testCase (Text.unpack $ (text_from_expr :: Repr_Text IO _h -> Text) $ expr) $
-		(>>= (@?= expected)) $
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		(@?= expected) $
 		host_from_expr expr in
 	 [ List.Test.e1 ==> [2::Int,4]
 	 ]
+ , testGroup "Functor" $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_List
+	                                                    .|. Expr_Functor
+	                                                    .|. Expr_Bool
+	                                                    .|. Expr_Int
+	                                                    .|. Expr_Num
+	                                                    .|. Expr_If
+	                                                    .|. Expr_Eq )) repr => repr h) expected =
+		testCase (Text.unpack $ (text_from_expr :: Repr_Text _h -> Text) $ expr) $
+		(@?= expected) $
+		host_from_expr expr in
+	 [ Functor.Test.e1 ==> [2::Int,3,4]
+	 ]
+ , testGroup "Applicative" $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_List
+	                                                    .|. Expr_Functor
+	                                                    .|. Expr_Applicative
+	                                                    .|. Expr_Maybe
+	                                                    .|. Expr_Bool
+	                                                    .|. Expr_Int
+	                                                    .|. Expr_Num
+	                                                    .|. Expr_If
+	                                                    .|. Expr_Eq )) repr => repr h) expected =
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		(@?= expected) $
+		host_from_expr expr in
+	 [ Applicative.Test.e1 ==> Just (3::Int)
+	 ]
+ , testGroup "Foldable" $
+	let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda
+	                                                    .|. Expr_List
+	                                                    .|. Expr_Foldable
+	                                                    .|. Expr_Maybe
+	                                                    .|. Expr_Bool
+	                                                    .|. Expr_Int
+	                                                    .|. Expr_Num
+	                                                    .|. Expr_If
+	                                                    .|. Expr_Eq )) repr => repr h) expected =
+		testCase (Text.unpack $ text_from_expr $ expr) $
+		(@?= expected) $
+		host_from_expr expr in
+	 [ Foldable.Test.e1 ==> [1::Int,1,2,2,3,3]
+	 ]
  ]