module ConcreteSpec where

import Test.Hspec

import Utils

import Syntax
import ConcreteSemantics

import Data.Map

import Data.Concrete.Error
import Data.Concrete.Exception

import Data.Number.Transfinite

import Java.Lang.Throwable
import Classes.ArrayFieldExample
import Classes.FactorialExample
import Classes.PersonExample
import Classes.SingleMethodExample
import Classes.TryCatchExample

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "Literals" $ do
    it "LocalName lookup" $ do
      let i = Local "x"
      let mem = [("x", IntVal 2)]
      evalImmediate'' mem i `shouldBe` Success (IntVal 2)
    it "Integer literals" $ do
      let i = IntConstant 7
      evalImmediate'' [] i `shouldBe` Success (IntVal 7)
    it "Float literals" $ do
      let i = FloatConstant 2.5
      evalImmediate'' [] i `shouldBe` Success (FloatVal 2.5)
    it "String literals" $ do
      let i = StringConstant "Hello World"
      evalImmediate'' [] i `shouldBe` Success (StringVal "Hello World")
    it "Class literals" $ do
      let i = ClassConstant "java.lang.Object"
      evalImmediate'' [] i `shouldBe` Success (ClassVal "java.lang.Object")
    it "Null literals" $ do
      let i = NullConstant
      evalImmediate'' [] i `shouldBe` Success NullVal

  describe "Boolean expressions" $ do
    it "3 < 4" $ do
      let expr = BoolExpr (IntConstant 3) Cmplt (IntConstant 4)
      evalBool'' [] expr `shouldBe` Success True
    it "3 != 'three'" $ do
      let expr = BoolExpr (IntConstant 3) Cmpne (StringConstant "three")
      evalBool'' [] expr `shouldBe` Success True

  describe "Simple Expressions" $ do
    it "-3" $ do
      let expr = UnopExpr Neg (IntConstant 3)
      eval'' [] expr `shouldBe` Success (IntVal (-3))
    it "lengthof [1, 2, 3] = 3" $ do
      let expr = UnopExpr Lengthof (Local "x")
      let mem = [("x",ArrayVal [IntVal 1, IntVal 2, IntVal 3])]
      eval'' mem expr `shouldBe` Success (IntVal 3)
    it "8 + 2 = 10" $ do
      let expr = BinopExpr (IntConstant 8) Plus (IntConstant 2)
      eval'' [] expr `shouldBe` Success (IntVal 10)
    it "8 / 0 -> java.lang.ArithmeticException" $ do
      let expr = BinopExpr (IntConstant 8) Div (IntConstant 0)
      eval'' [] expr `shouldBe` dynamicException "java.lang.ArithmeticException" "/ by zero"
    it "3.0 / 0.0 = ∞" $ do
      let expr = BinopExpr (FloatConstant 3.0) Div (FloatConstant 0.0)
      eval'' [] expr `shouldBe` Success (FloatVal infinity)
    it "3.0 % 2.5 = .5" $ do
      let expr = BinopExpr (FloatConstant 3.0) Rem (FloatConstant 2.5)
      eval'' [] expr `shouldBe` Success (FloatVal 0.5)
    it "new boolean -> int 0" $ do
      let expr = NewExpr BooleanType
      eval'' [] expr `shouldBe` Success (IntVal 0)
    it "[1, 2, 3][2] = 2" $ do
      let expr = RefExpr (ArrayRef "xs" (IntConstant 2))
      let mem = [("xs",ArrayVal [IntVal 1, IntVal 2, IntVal 3])]
      eval'' mem expr `shouldBe` Success (IntVal 3)
    it "newmultiarray (float) [3][2] = [[0.0,0.0],[0.0,0.0],[0.0,0.0]]" $ do
      let expr = NewMultiArrayExpr FloatType [IntConstant 3, IntConstant 2]
      eval'' [] expr `shouldBe` Success (ArrayVal [ArrayVal [FloatVal 0.0, FloatVal 0.0],
                                                 ArrayVal [FloatVal 0.0, FloatVal 0.0],
                                                 ArrayVal [FloatVal 0.0, FloatVal 0.0]])

  describe "Simple Statements" $ do
    it "i0 = 2 + 3; return i0;" $ do
      let mem = [("i0",IntVal 0)]
      let stmts = [Assign (LocalVar "i0") (BinopExpr (IntConstant 2) Plus (IntConstant 3)),
                   Return (Just (Local "i0"))]
      runStatements'' mem stmts `shouldBe` Success (Just (IntVal 5))
    it "assign non-declared variable" $ do
      let stmts = [Assign (LocalVar "s") (ImmediateExpr (IntConstant 2))]
      runStatements'' [] stmts `shouldBe` staticException "Variable \"s\" not bound"
    it "s = 2; xs = newarray (int)[s]; y = lengthof xs; return xs;" $ do
      let mem = [("s",  IntVal 0),
                  ("xs", NullVal),
                  ("y",  IntVal 0)]
      let stmts = [Assign (LocalVar "s") (ImmediateExpr (IntConstant 2)),
                   Assign (LocalVar "xs") (NewArrayExpr IntType (Local "s")),
                   Assign (LocalVar "y") (UnopExpr Lengthof (Local "xs")),
                   Return (Just (Local "y"))]
      runStatements'' mem stmts `shouldBe` Success (Just (IntVal 2))
    it "if 2 <= 3 goto l2; l1: return 1; l2: return 0;" $ do
      let stmts = [If (BoolExpr (IntConstant 2) Cmple (IntConstant 3)) "l2",
                   Label "l1",
                   Return (Just (IntConstant 1)),
                   Label "l2",
                   Return (Just (IntConstant 0))]
      runStatements'' [] stmts `shouldBe` Success (Just (IntVal 0))
    it "lookupswitch(4) { case 0: goto l1; case 4: goto l2; default: goto l3;}; l1: return 1; l2: return 2; l3: return 3;" $ do
      let stmts = [Lookupswitch (IntConstant 4) [(ConstantCase 0, "l1"),
                                                 (ConstantCase 4, "l2"),
                                                 (DefaultCase, "l3")],
                   Label "l1",
                   Return (Just (IntConstant 1)),
                   Label "l2",
                   Return (Just (IntConstant 2)),
                   Label "l3",
                   Return (Just (IntConstant 3))]
      runStatements'' [] stmts `shouldBe` Success (Just (IntVal 2))
    it "lookupswitch(2) { case 0: goto l1; case 4: goto l2; default: goto l3;}; l1: return 1; l2: return 2; l3: return 3;" $ do
      let stmts = [Lookupswitch (IntConstant 2) [(ConstantCase 0, "l1"),
                                          (ConstantCase 4, "l2"),
                                          (DefaultCase, "l3")],
                   Label "l1",
                   Return (Just (IntConstant 1)),
                   Label "l2",
                   Return (Just (IntConstant 2)),
                   Label "l3",
                   Return (Just (IntConstant 3))]
      runStatements'' [] stmts `shouldBe` Success (Just (IntVal 3))
    it "f0 := @parameter0: float; f1 = f0 * 2.5; return f1; (@parameter0 = 2.0)" $ do
      let mem = [("@parameter0", FloatVal 2.0),
                 ("f0",          FloatVal 0.0),
                 ("f1",          FloatVal 0.0)]
      let stmts = [Identity "f0" (ParameterRef 0) FloatType,
                   Assign (LocalVar "f1") (BinopExpr (Local "f0") Mult (FloatConstant 2.5)),
                   Return (Just (Local "f1"))]
      runStatements'' mem stmts `shouldBe` Success (Just (FloatVal 5.0))

  describe "Complete program" $ do
    it "10! = 3628800" $
      runProgram'' factorialExampleFile [IntConstant 10] `shouldBe` Success (Just (IntVal 3628800))
    it "s = new SingleMethodExample; s.x = 2; return s.x" $
      runProgram'' singleMethodExampleFile [] `shouldBe` Success (Just (IntVal 2))
    it "(-10)! throws IllegalArgumentException" $
      runProgram'' factorialExampleFile [IntConstant (-10)] `shouldBe` dynamicException "java.lang.IllegalArgumentException" "Negative value for argument n"
    it "5 -> [5,10,5,10]" $
      runProgram'' arrayFieldExampleFile [IntConstant 5] `shouldBe` Success (Just (ArrayVal [IntVal 5, IntVal 10, IntVal 5, IntVal 10]))
    it "(new Person(10)).yearsToLive() = 90" $
      runProgram'' personExampleFile [] `shouldBe` Success (Just (IntVal 90))
    it "try { throw e } catch (e) { throw e' }" $
      runProgram'' tryCatchExampleFile [] `shouldBe` dynamicException "java.lang.ArrayIndexOutOfBoundsException" "b"

  where
    evalImmediate'' = evalImmediate' baseCompilationUnits
    evalBool'' = evalBool' baseCompilationUnits
    eval'' = eval' baseCompilationUnits
    runStatements'' = runStatements' baseCompilationUnits
    runProgram'' unit params = runProgram' (unit:baseCompilationUnits) (methodSignature unit (mainMethod unit),params)

    staticException msg = Fail (StaticException msg)
    dynamicException clzz msg = Fail (DynamicException (ObjectVal clzz (fromList [(throwableMessageSignature, StringVal msg)])))
