{-# LANGUAGE OverloadedStrings #-}
module ConcreteSpec where

import           Prelude hiding (succ,pred)

import           Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as M

import           Syntax as S hiding (Nil)
import           Parser
import           ConcreteInterpreter

import           Test.Hspec

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "miscellaneous tests" $ do
    let run = evalConcrete''

    it "test set! " $
      run [define "x" (lit $ S.Int 2),
          define "y" (lit $ S.Int 3),
          set "y" (lit $ S.Int 3)] `shouldBe` Right VoidVal

    it "test simple let" $ do
      let es' = [let_ [("y", lit $ S.Int 3)] ["y"] ]
      run es' `shouldBe` Right (IntVal 3)

    it "test simple letrec" $ do
      let es' = [let_rec [("y", lit $ S.Int 3)] ["y"] ]
      run es' `shouldBe` Right (IntVal 3)

    it "test simple lambda" $ do
      let es' = [app (lam ["x"] ["x"]) [lit $ S.Int 3]]
      run es' `shouldBe` Right (IntVal 3)


    it "test define with lambda body  " $ do
      let es' = [let_rec [("y", lam ["y"] ["y"])]
                      [app "y" [lit $ S.Int 3]]]
      run es' `shouldBe` Right (IntVal 3)

    it "test define with lambda body  " $ do
      let es' = [let_ [("x", lam ["y"] ["y"])]
                      [app "x" [lit $ S.Int 3]]]
      run es' `shouldBe` Right (IntVal 3)


    it "demonstrate need for stepwise evaluation of letrec bindings" $ do
      let es' = [let_rec [("x", lit $ S.Int 4),
                          ("y", "x")]
                      --  [lam ["x"] ["x"]]]
                          ["y"]]
      run es' `shouldBe` Right (IntVal 4)

    it "test define with lambda body  " $ do
      let es = [define "y" (lam ["x"] ["x"]),
                define "z" (lit $ S.Int 4),
                define "z1" (lit $ S.Int 5),
                define "k" (lit $ S.Int 6),
                app "y" [lit $ S.Int 3]]
      run es `shouldBe` Right (IntVal 3)

    it "test define with lambda body  " $
      run [define "x" (lam ["n"] [app (lam ["x"] ["x"]) ["n"]]),
          app "x" [lit $ S.Int 2],
          app "x" [lit $ S.Int 3]] `shouldBe` Right (IntVal 3)

    it "test define with lambda body  " $ do
      let es = [define "x" (lam ["x"] ["x"]),
                app "x" [lit $ S.Int 3]]
      run es `shouldBe` Right (IntVal 3)

    it "test define with lambda body  " $ do
      let es = [let_ [("y", lam ["y"] ["y"])]
                     [define "x" (lam ["x"] ["x"]),
                     app "x" [lit $ S.Int 3]]]
      run es `shouldBe` Right (IntVal 3)

    it "illustrate necessity of store" $
      run [define "x" (lit $ S.Int 2),
          app
            (lam [] [set "x" (lit $ S.Int 3)])
            [],
            "x"] `shouldBe` Right (IntVal 3)

    it "correctly evaluate sequential letrec" $
      run [let_rec [("x", lit $ S.Int 3),
                    ("y", lam [] ["x"])]
              [app "y" []]] `shouldBe` Right (IntVal 3)

    it "correctly evaluate mutually recursive letrec" $
      run [let_rec [("y", lam [] ["x"]),
                    ("x", lit $ S.Int 3)]
              [app "y" []]] `shouldBe` Right (IntVal 3)

    it "should fail define the same var twice" $ do
      pendingWith "need to fix check in define "
      run [define "x" (lit $ S.Int 2),
          define "x" (lit $ S.Int 3)] `shouldBe` Left (M.fromList [], "Variable \"x\" already exists")

  -----------------GABRIEL BENCHMARKS---------------------------------------------
  describe "Gabriel-Benchmarks" $ do

    it "boyer" $ do
      pendingWith "no random"
      "gabriel/boyer.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "browse" $ do
      pendingWith "currently returns left"
      "gabriel/browse.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "cpstak" $
      "gabriel/cpstak.scm" `shouldEvaluateTo` Right (IntVal 6)

    it "destruc" $ do
      pendingWith "currently returns false"
      "gabriel/destruc.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "deriv" $
      "gabriel/deriv.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "dderiv" $
      "gabriel/dderiv.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "diviter" $
      "gabriel/diviter.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "divrec" $
      "gabriel/divrec.scm" `shouldEvaluateTo` Right (BoolVal True)

    it "takl" $
      "gabriel/takl.scm" `shouldEvaluateTo` Right (BoolVal True)

  -------------------SCALA-AM BENCHMARKS------------------------------------------
  describe "Scala-AM-Benchmarks" $ do
    it "collatz" $
      "scala-am/collatz.scm" `shouldEvaluateTo` Right (IntVal 5)

    it "gcipd" $
      "scala-am/gcipd.scm" `shouldEvaluateTo` Right (IntVal 36)

    it "nqueens" $
      "scala-am/nqueens.scm" `shouldEvaluateTo` Right (IntVal 92)

    it "rsa" $
      "scala-am/rsa.scm" `shouldEvaluateTo` Right (BoolVal True)

  ------------------------------------------CUSTOMS--------------------------------------------
  describe "Custom_Tests" $ do
      it "recursion and union with empty list" $
        "test_rec_empty.scm" `shouldEvaluateTo` Right (ListVal Nil)

      it "recursion and union with non-empty list" $
        "test_rec_nonempty.scm" `shouldEvaluateTo` Right (IntVal 1)

      it "should return 3 for (car (cdr '(2 3 4)))" $
        "test_cdr.scm" `shouldEvaluateTo` Right (IntVal 3)

      it "should return correct val for car" $
        "test_car.scm" `shouldEvaluateTo` Right (IntVal 1)

      it "should return true for null? cdr cdr '(1 2)" $
        "test_null.scm" `shouldEvaluateTo` Right (BoolVal True)

      -- it "unifying two list of nums of different size should result in an error" $ do
      --   let inFile = "test_faulty_list"
      --   let expRes = Terminating (Fail "{\"cannot unify lists of differing lengths| List [Int: {1}], List [Int: {1},Int: {2}]\"}")
      --   helper_test inFile expRes

      it "test_if" $
        "test_if.scm" `shouldEvaluateTo` Right (BoolVal False)

      it "test_opvars" $
        "test_opvars.scm" `shouldEvaluateTo` Right (IntVal 10)

      it "test_equal" $
        "test_equal.scm" `shouldEvaluateTo` Right (BoolVal True)

      it "test_cons" $
        "test_cons.scm" `shouldEvaluateTo` Right (BoolVal True)

      it "test_closures_gc" $
        "test_closure_gc.scm" `shouldEvaluateTo` Right (IntVal 16)

      it "lang_scheme_test" $
        "lang_scheme_test.scm" `shouldEvaluateTo` Right (IntVal 8)

      it "test_inner_define" $
        "test_inner_define.scm" `shouldEvaluateTo` Right (IntVal 10)

      it "test_subtraction" $
        "test_subtraction.scm" `shouldEvaluateTo` Right (IntVal (-4))

      it "test_lits" $
        "test_lits.scm" `shouldEvaluateTo` Right (IntVal 3)

      it "test_simple_floats" $
        "test_simple_floats.scm" `shouldEvaluateTo` Right (BoolVal False)

      it "test_rec_defines" $
        "test_rec_defines.scm" `shouldEvaluateTo` Right (IntVal 720)

      -- it "test_random" $ do
      --   let inFile = "test_random"
      --   let expRes = Right $ IntVal 1
      --   helper_test run inFile expRes


shouldEvaluateTo :: String -> Either (HashMap Addr Val, String) Val -> IO ()
shouldEvaluateTo inFile expRes = do
  prog <- loadSchemeFile inFile
  evalConcrete'' [prog] `shouldBe` expRes
