{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -O0 #-} -- speedup compile-time…
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.Typing
import Language.Symantic.Compiling.Bool
import Language.Symantic.Compiling.Map
import Language.Symantic.Compiling.List
import Language.Symantic.Compiling.Term
import Language.Symantic.Compiling.Tuple2
import Language.Symantic.Compiling.Int
import Language.Symantic.Compiling.Text
import Compiling.Term.Test

-- * Terms
t = bool True
f = bool False
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_term_from (Proxy::Proxy Ifaces)

tests :: TestTree
tests = testGroup "Map"
 [ Syntax "Map.fromList"
	 [ Syntax "zipWith"
		 [ syLam (Syntax "x" []) syInt $
				syLam (Syntax "y" []) syText $
					Syntax "(,)"
					 [ Syntax "x" []
					 , Syntax "y" []
					 ]
		 , Syntax "list"
			 [ syInt
			 , Syntax "int" [Syntax "1" []]
			 , Syntax "int" [Syntax "2" []]
			 , Syntax "int" [Syntax "3" []]
			 ]
		 , Syntax "list"
			 [ syText
			 , Syntax "text" [Syntax "\"a\"" []]
			 , Syntax "text" [Syntax "\"b\"" []]
			 , Syntax "text" [Syntax "\"c\"" []]
			 ]
		 ]
	 ] ==> Right
	 ( (tyMap :$ tyInt) :$ tyText
	 , 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 (Syntax "k" []) syInt $
			syLam (Syntax "v" []) syText $
				syLam (Syntax "a" []) (syTuple2 [syInt, syText]) $
					syTuple2
					 [ Syntax "+"
						 [ Syntax "k" []
						 , Syntax "fst" [ Syntax "a" [] ]
						 ]
					 , Syntax "mappend"
						 [ Syntax "v" []
						 , Syntax "snd" [ Syntax "a" [] ]
						 ]
					 ]
	 , syTuple2
		 [ Syntax "int" [Syntax "0" []]
		 , Syntax "text" [Syntax "\"\"" []]
		 ]
	 , Syntax "Map.fromList"
		 [ Syntax "zipWith"
			 [ syLam (Syntax "x" []) syInt $
					syLam (Syntax "y" []) syText $
						syTuple2
						 [ Syntax "x" []
						 , Syntax "y" []
						 ]
			 , Syntax "list"
				 [ syInt
				 , Syntax "int" [Syntax "1" []]
				 , Syntax "int" [Syntax "2" []]
				 , Syntax "int" [Syntax "3" []]
				 ]
			 , Syntax "list"
				 [ syText
				 , Syntax "text" [Syntax "\"a\"" []]
				 , Syntax "text" [Syntax "\"b\"" []]
				 , Syntax "text" [Syntax "\"c\"" []]
				 ]
			 ]
		 ]
	 ] ==> Right
	 ( (tyTuple2 :$ tyInt) :$ tyText
	 , (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\"]))" )
 ]