{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module ConcreteSpec where

import           Concrete
import           ConcreteInterpreter
import           Data

import qualified Data.ByteString.Lazy as LBS
import           Data.Concrete.Error
import           Data.Either(isRight)
import           Data.Text.Lazy (pack)

import           Language.Wasm
import qualified Language.Wasm.Interpreter as Wasm
import           Language.Wasm.Script (runScript')

import           Test.Hspec

main :: IO ()
main = hspec spec

getFunctionBody :: Function -> Expression
getFunctionBody (Function _ _ b) = b

runFunc :: String -> String -> [Value] -> IO Result
runFunc modName funcName args = do
    let path = "test/samples/" ++ modName ++ ".wast"
    content <- LBS.readFile path
    let Right m = parse content
    let Right validMod = validate m
    Right (modInst, staticS, mems, tabs) <- instantiateConcrete validMod
    return $ invokeExported staticS mems tabs modInst (pack funcName) args

succResult :: Result -> [Value]
succResult (Success (_,(_,(_,(_,Success (_,result)))))) = result
succResult _ = error "not defined"

runScriptInterp :: String -> IO ()
runScriptInterp scriptName = do
    let path = "test/samples/" ++ scriptName ++ ".wast"
    content <- LBS.readFile path
    let s = parseScript content
    s `shouldSatisfy` isRight
    let (Right script) = s
    let onAssert msg ass = putStrLn $ "Failed assert: " ++ msg ++ ". Assert: " ++ show ass
    () <- runScript' invokeExported' onAssert script
    return ()

spec :: Spec
spec = do
    it "run noop" $ do
        result <- runFunc "simple" "noop" []
        succResult result `shouldBe` [Value $ Wasm.VI32 0]

    it "run const" $ do
        result <- runFunc "simple" "const" [Value $ Wasm.VI32 5]
        succResult result `shouldBe` [Value $ Wasm.VI32 5]

    it "run fac-rec" $ do
        let params = map (singleton . Value . Wasm.VI64) [0 .. 8]
        results <- mapM (runFunc "fact" "fac-rec") params
        let rs = map succResult results
        rs `shouldBe` map (singleton . Value . Wasm.VI64) [1,1,2,6,24,120,720,5040,40320]

    it "run fac-rec2" $ do
        result <- runFunc "fact" "fac-rec" [Value $ Wasm.VI64 25]
        succResult result `shouldBe` [Value $ Wasm.VI64 7034535277573963776]

    it "run fac-iter" $ do
        result <- runFunc "fact" "fac-iter" [Value $ Wasm.VI64 25]
        succResult result `shouldBe` [Value $ Wasm.VI64 7034535277573963776]

    it "run fac-rec-named" $ do
        result <- runFunc "fact" "fac-rec-named" [Value $ Wasm.VI64 25]
        succResult result `shouldBe` [Value $ Wasm.VI64 7034535277573963776]

    it "run fac-iter-named" $ do
        result <- runFunc "fact" "fac-iter-named" [Value $ Wasm.VI64 25]
        succResult result `shouldBe` [Value $ Wasm.VI64 7034535277573963776]

    it "run fac-opt" $ do
        result <- runFunc "fact" "fac-opt" [Value $ Wasm.VI64 25]
        succResult result `shouldBe` [Value $ Wasm.VI64 7034535277573963776]

--    it "run fac-ssa" $ do
--        result <- runFunc "fact" "fac-ssa" [Value $ Wasm.VI64 2]
--        --print result
--        succResult result `shouldBe` [Value $ Wasm.VI64 2]

    it "run test-mem" $ do
        -- result <- runFunc "simple" "test-mem" [Value $ Wasm.VI32 42]
        -- succResult result `shouldBe` [Value $ Wasm.VI32 43]
        result <- runFunc "simple" "test-mem" [Value $ Wasm.VI32 (2^(32::Int)-2)]
        succResult result `shouldBe` [Value $ Wasm.VI32 (2^(32::Int)-1)]

    it "run test-size" $ do
        result <- runFunc "simple" "test-size" []
        succResult result `shouldBe` [Value $ Wasm.VI32 1]

    it "run test-memgrow" $ do
        result <- runFunc "simple" "test-memgrow" []
        succResult result `shouldBe` [Value $ Wasm.VI32 1, Value $ Wasm.VI32 2]

    it "run test-call-indirect" $ do
        result <- runFunc "simple" "test-call-indirect" []
        succResult result `shouldBe` [Value $ Wasm.VI32 0]

--    it "run block script" $ do
--        () <- runScriptInterp "block"
--        () `shouldBe` ()
--
    it "run first" $ do
        result <- runFunc "simple" "first" [Value $ Wasm.VI32 0, Value $ Wasm.VI32 1]
        succResult result `shouldBe` [Value $ Wasm.VI32 0]

    it "run call-first" $ do
        result <- runFunc "simple" "call-first" []
        succResult result `shouldBe` [Value $ Wasm.VI32 0]

    it "run nesting" $ do
        result <- runFunc "simple" "nesting" [Value $ Wasm.VF32 1, Value $ Wasm.VF32 2]
        succResult result `shouldBe` [Value $ Wasm.VF32 2]

--    it "run params-break" $ do
--        result <- runFunc "simple" "params-break" []
--        succResult result `shouldBe` [Value $ Wasm.VI32 12]
--
--    it "run loop script" $ do
--        () <- runScriptInterp "loop"
--        () `shouldBe` ()
--
--    it "run fac script" $ do
--        () <- runScriptInterp "fac"
--        () `shouldBe` ()

  where
    singleton :: a -> [a]
    singleton x = [x]
