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

import Test.Tasty
import Test.Tasty.HUnit
import Data.Proxy

import Language.LOL.Symantic.AST
import Language.LOL.Symantic.Type

tests :: TestTree
tests = testGroup "Type" $
	let (==>) raw expected p =
		testCase (show raw) $
		type_from p raw (Right . Exists_Type) @?=
		(Exists_Type <$> expected) in
	 [ testGroup "Fun_Bool" $
		 [ AST "Bool" []
		   ==> Right (type_bool :: Type_Fun_Bool lam Bool) $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "->" [AST "Bool" []]
		   ==> Left (Just $ error_type_lift $ Error_Type_Fun_Wrong_number_of_arguments 2 (AST "->" [AST "Bool" []])) $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "->" [AST "Bool" [], AST "Bool" []]
		   ==> Right (type_bool `type_fun` type_bool
		   :: Type_Fun_Bool lam (lam Bool -> lam Bool)) $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "->" [ AST "->" [AST "Bool" [], AST "Bool" []]
		            , AST "Bool" [] ]
		   ==> Right ((type_bool `type_fun` type_bool) `type_fun` type_bool
		   :: Type_Fun_Bool lam (lam (lam Bool -> lam Bool) -> lam Bool)) $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "->" [ AST "Bool" []
		            , AST "->" [AST "Bool" [], AST "Bool" []] ]
		   ==> Right (type_bool `type_fun` (type_bool `type_fun` type_bool)
		   :: Type_Fun_Bool lam (lam Bool -> lam (lam Bool -> lam Bool))) $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "Int" []
		   ==> Left Nothing $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "->" [AST "Bool" [], AST "Int" []]
		   ==> Left Nothing $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 , AST "->" [ AST "->" [AST "Int" [], AST "Bool" []]
		            , AST "Int" [] ]
		   ==> Left Nothing $
		   (Proxy :: Proxy (Type_Fun_Bool lam))
		 ]
	 , testGroup "Fun_Bool_Int" $
		 [ AST "Int"  []
		   ==> Right (type_int :: Type_Fun_Bool_Int lam Int) $
		   (Proxy :: Proxy (Type_Fun_Bool_Int lam))
		 , AST "->" [AST "Bool" [], AST "Int" []]
		   ==> Right (type_bool `type_fun` type_int :: Type_Fun_Bool_Int lam (lam Bool -> lam Int)) $
		   (Proxy :: Proxy (Type_Fun_Bool_Int lam))
		 , AST "->" [ AST "->" [AST "Int" [], AST "Bool" []]
		            , AST "Int" [] ]
		   ==> Right ((type_int `type_fun` type_bool) `type_fun` type_int
		   :: Type_Fun_Bool_Int lam (lam (lam Int -> lam Bool) -> lam Int)) $
		   (Proxy :: Proxy (Type_Fun_Bool_Int lam))
		 ]
	 ]