{-# LANGUAGE ScopedTypeVariables #-}
module Type.Test where

import Test.Tasty
import Test.Tasty.HUnit

import TFHOE.Raw
import TFHOE.Type

tests :: TestTree
tests = testGroup "Type" $
	let (==>) raw expected =
		testCase (show raw) $
		type_from raw (Right . Exists_Type) @?=
		Right (Exists_Type expected) in
	 [ Raw "->" [Raw "Bool" [], Raw "Bool" []]
	   ==> (Type_Fun_Next Type_Bool `Type_Fun` Type_Fun_Next Type_Bool
	   :: Type_Fun_Bool_End repr (repr Bool -> repr Bool))
	 , Raw "Bool" []
	   ==> (Type_Fun_Next Type_Bool
	   :: Type_Fun_Bool_End repr Bool)
	 , Raw "Int"  []
	   ==> (Type_Fun_Next (Type_Bool_Next Type_Int)
	   :: Type_Fun_Bool_Int_End repr Int)
	 , Raw "->" [Raw "Bool" [], Raw "Int" []]
	   ==> (Type_Fun_Next Type_Bool `Type_Fun` Type_Fun_Next (Type_Bool_Next Type_Int)
	   :: Type_Fun_Bool_Int_End repr (repr Bool -> repr Int))
	 ]