Language/Symantic/Expr/Eq/Test.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE GADTs #-}
   3 {-# LANGUAGE NoMonomorphismRestriction #-}
   4 {-# LANGUAGE ScopedTypeVariables #-}
   5 {-# LANGUAGE TypeOperators #-}
   6 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   7
   8 module Expr.Eq.Test where
   9
  10 import Test.Tasty
  11 import Test.Tasty.HUnit
  12
  13 import qualified Control.Arrow as Arrow
  14 import qualified Control.Monad as Monad
  15 import Data.Proxy (Proxy(..))
  16 import Data.Text (Text)
  17 import Data.Type.Equality ((:~:)(Refl))
  18 import Prelude hiding ((&&), not, (||), (==))
  19
  20 import Language.Symantic.Type
  21 import Language.Symantic.Expr
  22 import Language.Symantic.Repr
  23
  24 import AST.Test
  25
  26 -- * Expressions
  27 t = bool True
  28 f = bool False
  29 e1 = if_ ((t && t) == (t || f)) t f
  30 e2 = if_ (((t && t) || f) == (t && (t || f))) t f
  31 e3 = if_ (not (t == f) == (t == t)) t f
  32
  33 -- * Tests
  34 type Ex = Expr_Root
  35  (   Expr_Lambda
  36  .|. Expr_Bool
  37  .|. Expr_Eq
  38  )
  39 ex_from = root_expr_from (Proxy::Proxy Ex)
  40
  41 (==>) ast expected =
  42         testCase (show ast) $
  43         case ex_from ast of
  44          Left err -> Left err @?= Prelude.snd `Arrow.left` expected
  45          Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
  46                 case expected of
  47                  Left (_, err) -> Right ("…"::String) @?= Left err
  48                  Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
  49                         (Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
  50                         case ty `type0_eq` ty_expected of
  51                          Nothing -> Monad.return $ Left $
  52                                 error_expr (Proxy::Proxy Ex) $
  53                                 Error_Expr_Type_mismatch ast
  54                                  (Exists_Type0 ty)
  55                                  (Exists_Type0 ty_expected)
  56                          Just Refl -> do
  57                                 let h = host_from_expr r
  58                                 Monad.return $
  59                                         Right
  60                                          ( ty
  61                                          , h
  62                                          , text_from_expr r
  63                                          -- , (text_from_expr :: Repr_Text h -> Text) r
  64                                          )
  65
  66 tests :: TestTree
  67 tests = testGroup "Eq"
  68  [ AST "==" [ AST "bool" [AST "True" []]
  69                   , AST "bool" [AST "True" []]
  70                   ] ==> Right
  71          ( type_bool
  72          , True
  73          , "True == True" )
  74  , AST "$"
  75          [ AST "\\"
  76                  [ AST "x" []
  77                  , AST "Bool" []
  78                  , AST "==" [ AST "var" [AST "x" []]
  79                             , AST "not" [AST "var" [AST "x" []]] ]
  80                  ]
  81          , AST "bool" [AST "True" []]
  82          ] ==> Right
  83          ( type_bool
  84          , False
  85          , "(\\x0 -> x0 == not x0) True" )
  86  ]