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

import Test.Tasty
import Test.Tasty.HUnit

import qualified Control.Arrow as Arrow
import qualified Control.Monad as Monad
-- import qualified Data.List as List
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Type.Equality ((:~:)(Refl))
import Prelude hiding (maybe, not)

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

import AST.Test

-- * Expressions
t = bool True
f = bool False
e1 = map_from_list $ list_zipWith (lam (lam . tuple2))
 (list $ int Prelude.<$> [1..5])
 (list $ (text . Text.singleton) Prelude.<$> ['a'..'e'])

-- * Tests
type Ex = Expr_Root
 (   Expr_Lambda
 .|. Expr_Map
 .|. Expr_Bool
 .|. Expr_Maybe
 .|. Expr_List
 .|. Expr_Eq
 .|. Expr_Ord
 .|. Expr_Tuple2
 .|. Expr_Int
 .|. Expr_Text
 .|. Expr_Monoid
 )
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_Type_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 `eq_type` ty_expected of
			 Nothing -> Monad.return $ Left $
				error_expr (Proxy::Proxy Ex) $
				Error_Expr_Type_mismatch ast
				 (Exists_Type ty)
				 (Exists_Type 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 "Map"
 [ AST "map_from_list"
	 [ AST "list_zipWith"
		 [ AST "\\"
			 [ AST "x" []
			 , AST "Int" []
			 , AST "\\"
				 [ AST "y" []
				 , AST "Text" []
				 , AST "(,)"
					 [ AST "var" [AST "x" []]
					 , AST "var" [AST "y" []]
					 ]
				 ]
			 ]
		 , AST "list"
			 [ AST "Int" []
			 , AST "int" [AST "1" []]
			 , AST "int" [AST "2" []]
			 , AST "int" [AST "3" []]
			 ]
		 , AST "list"
			 [ AST "Text" []
			 , AST "text" [AST "a" []]
			 , AST "text" [AST "b" []]
			 , AST "text" [AST "c" []]
			 ]
		 ]
	 ] ==> Right
	 ( type_map type_int type_text
	 , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
	 , "map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"])" )
 , AST "map_foldrWithKey"
	 [ AST "\\"
		 [ AST "k" []
		 , AST "Int" []
		 , AST "\\"
			 [ AST "v" []
			 , AST "Text" []
			 , AST "\\"
				 [ AST "a" []
				 , AST "(,)" [AST "Int" [], AST "Text" []]
				 , AST "(,)"
					 [ AST "+"
						 [ AST "var" [AST "k" []]
						 , AST "fst" [ AST "var" [AST "a" []] ]
						 ]
					 , AST "mappend"
						 [ AST "var" [AST "v" []]
						 , AST "snd" [ AST "var" [AST "a" []] ]
						 ]
					 ]
				 ]
			 ]
		 ]
	 , AST "(,)"
		 [ AST "int" [AST "0" []]
		 , AST "text" [AST "" []]
		 ]
	 , AST "map_from_list"
		 [ AST "list_zipWith"
			 [ AST "\\"
				 [ AST "x" []
				 , AST "Int" []
				 , AST "\\"
					 [ AST "y" []
					 , AST "Text" []
					 , AST "(,)"
						 [ AST "var" [AST "x" []]
						 , AST "var" [AST "y" []]
						 ]
					 ]
				 ]
			 , AST "list"
				 [ AST "Int" []
				 , AST "int" [AST "1" []]
				 , AST "int" [AST "2" []]
				 , AST "int" [AST "3" []]
				 ]
			 , AST "list"
				 [ AST "Text" []
				 , AST "text" [AST "a" []]
				 , AST "text" [AST "b" []]
				 , AST "text" [AST "c" []]
				 ]
			 ]
		 ]
	 ] ==> Right
	 ( type_tuple2 type_int type_text
	 , (6, "abc")
	 , "map_foldrWithKey (\\x0 -> (\\x1 -> (\\x2 -> (x0 + fst x2, mappend x1 (snd x2))))) (0, \"\") (map_from_list (list_zipWith (\\x0 -> (\\x1 -> (x0, x1))) [1, 2, 3] [\"a\", \"b\", \"c\"]))" )
 ]