{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Lib.Num.Test where

import Test.Tasty

import qualified Data.Monoid as Monoid
import Data.Proxy (Proxy(..))
import Prelude (Num)
import Prelude hiding (Num(..))

import Language.Symantic.Parsing
import Language.Symantic.Typing
import Language.Symantic.Compiling
import Language.Symantic.Interpreting
import Language.Symantic.Lib.Num
import Compiling.Term.Test

-- * Tests
type Ifaces =
 [ Proxy (->)
 , Proxy Integer
 , Proxy Num
 , Proxy Num2
 , Proxy Int
 , Proxy Integral
 , Proxy Foldable
 , Proxy Traversable
 , Proxy []
 ]
(==>) = test_compile @Ifaces

tests :: TestTree
tests = testGroup "Num"
 [ "42"                ==> Right (ty @Integer, 42, "42")
 , "-42"               ==> Right (ty @Integer, -42, "negate 42")
 , "- -42"             ==> Right (ty @Integer, 42, "negate (negate 42)")
 , "1 + -2"            ==> Right (ty @Integer, -1, "(\\x0 -> 1 + x0) (negate 2)")
 , "-1 + -2"           ==> Right (ty @Integer, -3, "(\\x0 -> negate 1 + x0) (negate 2)")
 , "-(1 + -2)"         ==> Right (ty @Integer, 1, "negate ((\\x0 -> 1 + x0) (negate 2))")
 , "(+) 1 2"           ==> Right (ty @Integer, 3, "(\\x0 -> 1 + x0) 2")
 , "1 + 2"             ==> Right (ty @Integer, 3, "(\\x0 -> 1 + x0) 2")
 , "1 + 2 - 3"         ==> Right (ty @Integer, 0, "(\\x0 -> (\\x1 -> 1 + x1) 2 - x0) 3")
 , "1 + 2 * 3"         ==> Right (ty @Integer, 7, "(\\x0 -> 1 + x0) ((\\x0 -> 2 * x0) 3)")
 , "3 * 2 + 1"         ==> Right (ty @Integer, 7, "(\\x0 -> (\\x1 -> 3 * x1) 2 + x0) 1")
 , "3 * (2 + 1)"       ==> Right (ty @Integer, 9, "(\\x0 -> 3 * x0) ((\\x0 -> 2 + x0) 1)")
 , "4 + 3 * 2 + 1"     ==> Right (ty @Integer, 11,
	 "(\\x0 -> (\\x1 -> 4 + x1) ((\\x1 -> 3 * x1) 2) + x0) 1")
 , "5 * 4 + 3 * 2 + 1" ==> Right (ty @Integer, 27,
	 "(\\x0 -> (\\x1 -> (\\x2 -> 5 * x2) 4 + x1) ((\\x1 -> 3 * x1) 2) + x0) 1")
 , "negate`42"         ==> Right (ty @Integer, -42, "negate 42")
 , "42`negate"         ==> Right (ty @Integer, -42, "negate 42")
 , "42`negate "        ==> Right (ty @Integer, -42, "negate 42")
 , "42`negate`negate"  ==> Right (ty @Integer, 42, "negate (negate 42)")
 , "42`abs`negate"     ==> Right (ty @Integer, -42, "negate (abs 42)")
 , "42`negate`abs"     ==> Right (ty @Integer, 42, "abs (negate 42)")
 , "abs`negate`42"     ==> Right (ty @Integer, 42, "abs (negate 42)")
 , "negate`abs`42"     ==> Right (ty @Integer, -42, "negate (abs 42)")
 , "abs`42`negate"     ==> Right (ty @Integer, 42, "abs (negate 42)")
 , "negate`42`abs"     ==> Right (ty @Integer, 42, "abs (negate 42)")
 , "negate`abs`42`mod`9" ==> Right
	 (ty @Integer,3, "(\\x0 -> negate (abs 42) `mod` x0) 9")
 , "42`abs`negate`mod`abs`negate`9" ==> Right
	 (ty @Integer, 3, "(\\x0 -> negate (abs 42) `mod` x0) (abs (negate 9))")
 ]

-- | A newtype to test prefix and postfix.
newtype Num2 a = Num2 a

class Sym_Num2 (term:: * -> *) where

type instance Sym_of_Iface (Proxy Num2) = Sym_Num2
type instance TyConsts_of_Iface (Proxy Num2) = Proxy Num2 ': TyConsts_imported_by Num2
type instance TyConsts_imported_by Num2 = '[ Proxy Integer ]

instance Sym_Num2 HostI where
instance Sym_Num2 TextI where
instance Sym_Num2 (DupI r1 r2) where

instance
 ( Read_TyNameR TyName cs rs
 , Inj_TyConst cs Num2
 ) => Read_TyNameR TyName cs (Proxy Num2 ': rs) where
	read_TyNameR _cs (TyName "Num2") k = k (ty @Num2)
	read_TyNameR _rs raw k = read_TyNameR (Proxy @rs) raw k
instance Show_TyConst cs => Show_TyConst (Proxy Num2 ': cs) where
	show_TyConst TyConstZ{} = "Num2"
	show_TyConst (TyConstS c) = show_TyConst c

instance Proj_TyConC cs (Proxy Num2)
data instance TokenT meta (ts::[*]) (Proxy Num2)
deriving instance (Eq meta, Eq_Token meta ts) => Eq (TokenT meta ts (Proxy Num2))
deriving instance (Show meta, Show_Token meta ts) => Show (TokenT meta ts (Proxy Num2))
instance CompileI cs is (Proxy Num2) where
	compileI _tok _ctx _k = undefined
instance -- TokenizeT
 Inj_Token meta ts Num =>
 TokenizeT meta ts (Proxy Num2) where
	tokenizeT _t = Monoid.mempty
	 { tokenizers_prefix = tokenizeTMod []
		 [ tokenize1 "abs"    (Prefix  9) Token_Term_Num_abs
		 , tokenize1 "negate" (Prefix 10) Token_Term_Num_negate
		 ]
	 , tokenizers_postfix = tokenizeTMod []
		 [ tokenize1 "abs"    (Postfix  9) Token_Term_Num_abs
		 , tokenize1 "negate" (Postfix 10) Token_Term_Num_negate
		 ]
	 }
instance Gram_Term_AtomsT meta ts (Proxy Num2) g