Language/Symantic/Repr/Host/Test.hs

   1 {-# LANGUAGE ConstraintKinds #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE Rank2Types #-}
   5 {-# LANGUAGE ScopedTypeVariables #-}
   6 {-# LANGUAGE TypeOperators #-}
   7
   8 module Repr.Host.Test where
   9
  10 -- import Data.Function (($))
  11 -- import Data.Functor.Identity (Identity)
  12 import Test.Tasty
  13 import Test.Tasty.HUnit
  14
  15 import Data.Functor.Identity
  16 import Data.Text (Text)
  17 import qualified Data.Text as Text
  18 import Prelude hiding (and, not, or, Monad(..))
  19
  20 import Language.Symantic.Repr
  21 import Language.Symantic.Expr
  22 import qualified Expr.Lambda.Test as Lambda.Test
  23 import qualified Expr.Bool.Test as Bool.Test
  24 import qualified Expr.Maybe.Test as Maybe.Test
  25 import qualified Expr.If.Test as If.Test
  26 import qualified Expr.List.Test as List.Test
  27 import qualified Expr.Functor.Test as Functor.Test
  28 import qualified Expr.Applicative.Test as Applicative.Test
  29
  30 tests :: TestTree
  31 tests = testGroup "Host" $
  32  [ testGroup "Bool" $
  33         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
  34                                                             .|. Expr_Lambda_Val Identity
  35                                                             .|. Expr_Bool
  36                                                             )) repr => repr h) expected =
  37                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
  38                 -- (>>= (@?= expected)) $
  39                 (\(Identity a) -> (a @?= expected)) $
  40                 host_from_expr expr in
  41          [ Bool.Test.e1 ==> False
  42          , Bool.Test.e2 ==> True
  43          , Bool.Test.e3 ==> True
  44          , Bool.Test.e4 ==> True
  45          ]
  46  , testGroup "Lambda" $
  47         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
  48                                                             .|. Expr_Lambda_Val Identity
  49                                                             .|. Expr_Bool
  50                                                             )) repr => repr h) expected =
  51                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
  52                 (\(Identity a) -> (a @?= expected)) $
  53                 host_from_expr expr in
  54          [ (Lambda.Test.e1 `app` bool True  `app` bool True)  ==> False
  55          , (Lambda.Test.e1 `app` bool True  `app` bool False) ==> True
  56          , (Lambda.Test.e1 `app` bool False `app` bool True)  ==> True
  57          , (Lambda.Test.e1 `app` bool False `app` bool False) ==> False
  58
  59          , (Lambda.Test.e2 `app` bool True  `app` bool True)  ==> False
  60          , (Lambda.Test.e2 `app` bool True  `app` bool False) ==> True
  61          , (Lambda.Test.e2 `app` bool False `app` bool True)  ==> True
  62          , (Lambda.Test.e2 `app` bool False `app` bool False) ==> False
  63
  64          , Lambda.Test.e3 ==> True
  65          , Lambda.Test.e4 ==> True
  66
  67          , (Lambda.Test.e5 `app` bool True  `app` bool True)  ==> True
  68          , (Lambda.Test.e5 `app` bool True  `app` bool False) ==> False
  69          , (Lambda.Test.e5 `app` bool False `app` bool True)  ==> False
  70          , (Lambda.Test.e5 `app` bool False `app` bool False) ==> False
  71
  72          , Lambda.Test.e6 ==> False
  73          , (Lambda.Test.e7 `app` val id) ==> True
  74          , (Lambda.Test.e7 `app` val not) ==> False
  75          ]
  76  , testGroup "Maybe" $
  77         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
  78                                                             .|. Expr_Lambda_Val Identity
  79                                                             .|. Expr_Maybe Identity
  80                                                             .|. Expr_Bool )) repr => repr h) expected =
  81                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
  82                 (\(Identity a) -> (a @?= expected)) $
  83                 host_from_expr expr in
  84          [ Maybe.Test.e1 ==> False
  85          ]
  86  , testGroup "If" $
  87         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
  88                                                             .|. Expr_Lambda_Val Identity
  89                                                             .|. Expr_If
  90                                                             .|. Expr_Bool )) repr => repr h) expected =
  91                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
  92                 (\(Identity a) -> (a @?= expected)) $
  93                 host_from_expr expr in
  94          [ If.Test.e1 ==> False
  95          ]
  96  , testGroup "List" $
  97         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
  98                                                             .|. Expr_Lambda_Val Identity
  99                                                             .|. Expr_List Identity
 100                                                             .|. Expr_Bool
 101                                                             .|. Expr_Int
 102                                                             .|. Expr_If
 103                                                             .|. Expr_Eq )) repr => repr h) expected =
 104                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
 105                 (\(Identity a) -> (a @?= expected)) $
 106                 host_from_expr expr in
 107          [ List.Test.e1 ==> [2::Int,4]
 108          ]
 109  , testGroup "Functor" $
 110         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
 111                                                             .|. Expr_Lambda_Val Identity
 112                                                             .|. Expr_List Identity
 113                                                             .|. Expr_Functor Identity
 114                                                             .|. Expr_Bool
 115                                                             .|. Expr_Int
 116                                                             .|. Expr_If
 117                                                             .|. Expr_Eq )) repr => repr h) expected =
 118                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
 119                 (\(Identity a) -> (a @?= expected)) $
 120                 host_from_expr expr in
 121          [ Functor.Test.e1 ==> [2::Int,3,4]
 122          ]
 123  , testGroup "Applicative" $
 124         let (==>) (expr::forall repr. Sym_of_Expr (Expr_Root (  Expr_Lambda_App Identity
 125                                                             .|. Expr_Lambda_Val Identity
 126                                                             .|. Expr_List Identity
 127                                                             .|. Expr_Functor Identity
 128                                                             .|. Expr_Applicative Identity
 129                                                             .|. Expr_Maybe Identity
 130                                                             .|. Expr_Bool
 131                                                             .|. Expr_Int
 132                                                             .|. Expr_If
 133                                                             .|. Expr_Eq )) repr => repr h) expected =
 134                 testCase (Text.unpack $ (text_from_expr :: Repr_Text Identity _h -> Text) $ expr) $
 135                 (\(Identity a) -> (a @?= expected)) $
 136                 host_from_expr expr in
 137          [ Applicative.Test.e1 ==> Just (3::Int)
 138          ]
 139  ]