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

import Test.Tasty

import qualified Data.MonoTraversable as MT
import Data.Proxy (Proxy(..))
import Data.Text (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 (syBool)
import Compiling.Foldable.Test ()
import Parsing.Test

-- * Tests
type Ifaces =
 [ Proxy (->)
 , Proxy []
 , Proxy Bool
 , Proxy Char
 , Proxy Text
 , Proxy MT.MonoFunctor
 , Proxy Maybe
 ]
(==>) = test_term_from (Proxy::Proxy Ifaces)

instance
 ( Inj_Token (Syntax Text) ts MT.MonoFunctor
 , Tokenize (Syntax Text) (Syntax Text) ts ) =>
 TokenizeT (Syntax Text) (Syntax Text) ts (Proxy MT.MonoFunctor) where
	tokenizeT _t (Syntax "omap" (ast_f : ast_m : as)) = Just $ do
		f <- tokenize ast_f
		m <- tokenize ast_m
		Right $ (as,) $ EToken $ inj_token (Syntax "omap" [ast_f, ast_m]) $
			Token_Term_MonoFunctor_omap f m
	tokenizeT _t _sy = Nothing

tests :: TestTree
tests = testGroup "MonoFunctor"
 [ Syntax "omap"
	 [ syLam "x" (sy @Bool)
		 (Syntax "not" [syVar "x"])
	 , Syntax "Just" [syBool True]
	 ] ==> Right (ty @Maybe :$ ty @Bool, Just False, "omap (\\x0 -> (\\x1 -> not x1) x0) (Just True)")
 , Syntax "omap"
	 [ syLam "x" (sy @Char)
		 (Syntax "Char.toUpper" [syVar "x"])
	 , Syntax "text" [Syntax "\"abc\"" []]
	 ] ==> Right (ty @Text, "ABC", "omap (\\x0 -> (\\x1 -> Char.toUpper x1) x0) \"abc\"")
 ]