{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Expr.Eq.Test where

import Test.Tasty
import Test.Tasty.HUnit

import qualified Control.Arrow as Arrow
import qualified Control.Monad as Monad
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import Data.Type.Equality ((:~:)(Refl))
import Prelude hiding ((&&), not, (||), (==))

import Language.Symantic.Type
import Language.Symantic.Expr
import Language.Symantic.Repr

import AST.Test

-- * Expressions
t = bool True
f = bool False
e1 = if_ ((t && t) == (t || f)) t f
e2 = if_ (((t && t) || f) == (t && (t || f))) t f
e3 = if_ (not (t == f) == (t == t)) t f

-- * Tests
type Ex = Expr_Root
 (   Expr_Lambda
 .|. Expr_Bool
 .|. Expr_Eq
 )
ex_from = root_expr_from (Proxy::Proxy Ex)

(==>) ast expected =
	testCase (show ast) $
	case ex_from ast of
	 Left err -> Left err @?= Prelude.snd `Arrow.left` expected
	 Right (Exists_Type0_and_Repr ty (Forall_Repr r)) ->
		case expected of
		 Left (_, err) -> Right ("…"::String) @?= Left err
		 Right (ty_expected::Type_Root_of_Expr Ex h, _::h, _::Text) ->
			(Monad.>>= (@?= (\(_::Proxy h, err) -> err) `Arrow.left` expected)) $
			case ty `type0_eq` ty_expected of
			 Nothing -> Monad.return $ Left $
				error_expr (Proxy::Proxy Ex) $
				Error_Expr_Type_mismatch ast
				 (Exists_Type0 ty)
				 (Exists_Type0 ty_expected)
			 Just Refl -> do
				let h = host_from_expr r
				Monad.return $
					Right
					 ( ty
					 , h
					 , text_from_expr r
					 -- , (text_from_expr :: Repr_Text h -> Text) r
					 )

tests :: TestTree
tests = testGroup "Eq"
 [ AST "==" [ AST "bool" [AST "True" []]
	          , AST "bool" [AST "True" []]
	          ] ==> Right
	 ( type_bool
	 , True
	 , "True == True" )
 , AST "$"
	 [ AST "\\"
		 [ AST "x" []
		 , AST "Bool" []
		 , AST "==" [ AST "var" [AST "x" []]
		            , AST "not" [AST "var" [AST "x" []]] ]
		 ]
	 , AST "bool" [AST "True" []]
	 ] ==> Right
	 ( type_bool
	 , False
	 , "(\\x0 -> x0 == not x0) True" )
 ]