{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Expr.List.Test where

import Test.Tasty
import Test.Tasty.HUnit

import Control.Arrow (left)
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import Data.Type.Equality ((:~:)(Refl))
import Prelude hiding (mod, (==))

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

import AST.Test

-- * Expressions
t = bool True
f = bool False
e1 = list_filter (inline $ \x -> if_ (x `mod` int 2 == int 0) t f)
                 (list $ int <$> [1..5])

{-
-- * Tests
(==>) ast expected =
	testCase (show ast) $
	case expr_lambda_maybe_bool_from (Proxy::Proxy IO) ast of
	 Left err -> Left err @?= snd `left` expected
	 Right (Exists_Type_and_Repr ty (Forall_Repr r)) ->
		case expected of
		 Left (_, err) -> Right ("…"::String) @?= Left err
		 Right (ty_expected::Type_Root_of_Expr (Expr_Lambda_List_Bool IO) h, _::h, _::Text) ->
			(>>= (@?= (\(_::Proxy h, err) -> err) `left` expected)) $
			case ty `type_eq` ty_expected of
			 Nothing -> return $ Left $
				error_expr (Proxy::Proxy (Expr_Lambda_List_Bool IO)) $
				Error_Expr_Type_mismatch ast
				 (Exists_Type ty)
				 (Exists_Type ty_expected)
			 Just Refl -> do
				h <- host_from_expr r
				return $
					Right
					 ( ty
					 , h
					 , text_from_expr r
					 -- , (text_from_expr :: Repr_String IO h -> Text) r
					 )
-}
tests :: TestTree
tests = testGroup "List"
 [{- AST "just" [AST "bool" [AST "True" []]] ==> Right
	 ( type_maybe type_bool
	 , Just True
	 , "just True" )
 , AST "just"
	 [ AST "let_val"
		 [ AST "x" []
		 , AST "bool" [AST "True" []]
		 , AST "var" [AST "x" []]
		 ]
	 ] ==> Right
	 ( type_maybe type_bool
	 , Just True
	 , "just (let x0 = True in x0)" )
 , AST "maybe"
	 [ AST "bool" [AST "True" []]
	 , AST "val"
		 [ AST "x" []
		 , AST "Bool" []
		 , AST "not" [AST "var" [AST "x" []]]
		 ]
	 , AST "nothing"
		 [ AST "Bool" []
		 ]
	 ] ==> Right
	 ( type_bool
	 , True
	 , "maybe True (\\x0 -> !x0) nothing" )
 , AST "maybe"
	 [ AST "bool" [AST "False" []]
	 , AST "val"
		 [ AST "x" []
		 , AST "Bool" []
		 , AST "not" [AST "var" [AST "x" []]]
		 ]
	 , AST "just"
		 [ AST "bool" [AST "True" []]
		 ]
	 ] ==> Right
	 ( type_bool
	 , False
	 , "maybe False (\\x0 -> !x0) (just True)" )
 -}]