{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -O0 #-} -- speedup compiling…
module Compiling.Map.Test where

import Test.Tasty

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Prelude hiding (zipWith)

import Language.Symantic.Parsing
import Language.Symantic.Typing
import Language.Symantic.Compiling
import Compiling.Term.Test
import Compiling.Bool.Test ()
import Compiling.Foldable.Test ()
import Parsing.Test

-- * Terms
e1 = map_fromList $ zipWith (lam (lam . tuple2))
 (list $ int Prelude.<$> [1..5])
 (list $ (text . Text.singleton) Prelude.<$> ['a'..'e'])

-- * Tests
type Ifaces =
 [ Proxy (->)
 , Proxy []
 , Proxy Int
 , Proxy Map
 , Proxy Text
 , Proxy (,)
 , Proxy Num
 , Proxy Monoid
 ]
(==>) = test_compile (Proxy::Proxy Ifaces)

instance
 ( Inj_Token (Syntax Text) ts Map
 , Tokenize (Syntax Text) (Syntax Text) ts ) =>
 TokenizeT (Syntax Text) (Syntax Text) ts (Proxy Map) where
	tokenizeT _t (Syntax "Map.fromList" (ast_f : as)) = Just $ do
		f <- tokenize ast_f
		Right $ (as,) $ EToken $ inj_token (Syntax "Map.fromList" [ast_f]) $
			Token_Term_Map_fromList f
	tokenizeT _t (Syntax "Map.foldrWithKey" (ast_f : as)) = Just $ do
		f <- tokenize ast_f
		Right $ (as,) $ EToken $ inj_token (Syntax "Map.foldrWithKey" [ast_f]) $
			Token_Term_Map_foldrWithKey f
	tokenizeT _t _sy = Nothing

tests :: TestTree
tests = testGroup "Map"
 [ Syntax "Map.fromList"
	 [ Syntax "zipWith"
		 [ syLam "x" (sy @Int) $
				syLam "y" (sy @Text) $
					Syntax "(,)"
					 [ syVar "x"
					 , syVar "y"
					 ]
		 , Syntax "list"
			 [ sy @Int
			 , syLit (1::Int)
			 , syLit (2::Int)
			 , syLit (3::Int)
			 ]
		 , Syntax "list"
			 [ sy @Text
			 , syLit ("a"::Text)
			 , syLit ("b"::Text)
			 , syLit ("c"::Text)
			 ]
		 ]
	 ] ==> Right
	 ( (ty @Map :$ ty @Int) :$ ty @Text
	 , Map.fromList [(1, "a"), (2, "b"), (3, "c")]
	 , "Map.fromList (((\\x0 -> (\\x1 -> zipWith (\\x2 -> (\\x3 -> (x2, x3))) x0 x1)) [1, 2, 3]) [\"a\", \"b\", \"c\"])" )
 , Syntax "Map.foldrWithKey"
	 [ syLam "k" (sy @Int) $
			syLam "v" (sy @Text) $
				syLam "a" (sy @(,) [sy @Int, sy @Text]) $
					sy @(,)
					 [ Syntax "(+)"
						 [ syVar "k"
						 , Syntax "fst" [ syVar "a" ]
						 ]
					 , Syntax "mappend"
						 [ syVar "v"
						 , Syntax "snd" [ syVar "a" ]
						 ]
					 ]
	 , sy @(,)
		 [ syLit (0::Int)
		 , syLit (""::Text)
		 ]
	 , Syntax "Map.fromList"
		 [ Syntax "zipWith"
			 [ syLam "x" (sy @Int) $
					syLam "y" (sy @Text) $
						sy @(,)
						 [ syVar "x"
						 , syVar "y"
						 ]
			 , Syntax "list"
				 [ sy @Int
				 , syLit (1::Int)
				 , syLit (2::Int)
				 , syLit (3::Int)
				 ]
			 , Syntax "list"
				 [ sy @Text
				 , syLit ("a"::Text)
				 , syLit ("b"::Text)
				 , syLit ("c"::Text)
				 ]
			 ]
		 ]
	 ] ==> Right
	 ( (ty @(,) :$ ty @Int) :$ ty @Text
	 , (6, "abc")
	 , "((\\x0 -> (\\x1 -> Map.foldrWithKey (\\x2 -> (\\x3 -> (\\x4 -> ((\\x5 -> x2 + x5) (fst x4), (\\x5 -> mappend x3 x5) (snd x4))))) x0 x1)) (0, \"\")) (Map.fromList (((\\x0 -> (\\x1 -> zipWith (\\x2 -> (\\x3 -> (x2, x3))) x0 x1)) [1, 2, 3]) [\"a\", \"b\", \"c\"]))" )
 ]