{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Compiling.Applicative.Test where

import Test.Tasty

import Data.Proxy (Proxy(..))
import Data.Text (Text)
import Prelude hiding ((&&), not, (||))

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

-- * Tests
type Ifaces =
 [ Proxy (->)
 , Proxy Bool
 , Proxy Maybe
 , Proxy Applicative
 ]
(==>) = test_term_from (Proxy::Proxy Ifaces)

instance
 ( Inj_Token (Syntax Text) ts Applicative
 , Tokenize (Syntax Text) (Syntax Text) ts ) =>
 TokenizeT (Syntax Text) (Syntax Text) ts (Proxy Applicative) where
	tokenizeT _t (Syntax "(<*>)" (ast_fa2b : as)) = Just $ do
		fa2b  <- tokenize ast_fa2b
		Right $ (as,) $ EToken $ inj_token (Syntax "(<*>)" [ast_fa2b]) $
			Token_Term_Applicative_ltstargt fa2b
	tokenizeT _t (Syntax "(<*)" (ast_fa : ast_fb : as)) = Just $ do
		fa  <- tokenize ast_fa
		fb  <- tokenize ast_fb
		Right $ (as,) $ EToken $ inj_token (Syntax "(<*)" [ast_fa, ast_fb]) $
			Token_Term_Applicative_ltstar fa fb
	tokenizeT _t (Syntax "(*>)" (ast_fa : ast_fb : as)) = Just $ do
		fa  <- tokenize ast_fa
		fb  <- tokenize ast_fb
		Right $ (as,) $ EToken $ inj_token (Syntax "(*>)" [ast_fa, ast_fb]) $
			Token_Term_Applicative_stargt fa fb
	tokenizeT _t _sy = Nothing

tests :: TestTree
tests = testGroup "Applicative"
 [ Syntax "(<*>)"
	 [ Syntax "Just" [Syntax "xor" [syLit True]]
	 , Syntax "Just" [syLit True]
	 ] ==> Right (ty @Maybe :$ ty @Bool, Just False, "(\\x0 -> Just ((\\x1 -> (\\x2 -> x1 `xor` x2)) True) <*> x0) (Just True)")
 , Syntax "(*>)"
	 [ Syntax "Just" [syLit False]
	 , Syntax "Just" [syLit True]
	 ] ==> Right (ty @Maybe :$ ty @Bool, Just True, "Just False *> Just True")
 , Syntax "(<*)"
	 [ Syntax "Just" [syLit False]
	 , Syntax "Just" [syLit True]
	 ] ==> Right (ty @Maybe :$ ty @Bool, Just False, "Just False <* Just True")
 ]