module Gyehoek.Test.CPS.Eval where

import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit
import Gyehoek.CPS.Syntax (cps, Obj(..), Hob(..), Imm(..))
import Gyehoek.CPS.Eval qualified as Sut
import Data.List (List)
import Test.Tasty.ExpectedFailure (ignoreTestBecause, expectFail)
import System.Directory (listDirectory)
import Test.Tasty.Silver
import System.FilePath
import Control.Exception
import qualified Gyehoek.Driver as Driver
import Control.DeepSeq (($!!))
import System.Exit (ExitCode(..))
import qualified Data.Text as T
import Data.Function (applyWhen)
import Gyehoek.Prelude


brokenEvalTests :: List String
brokenEvalTests =
  []
  -- [ "adder"
  -- , "apply2"
  -- , "apply-twice"
  -- , "arith"
  -- , "begin-1"
  -- , "callcc-constant"
  -- , "callcc-discard"
  -- , "callcc-early-exit-1"
  -- , "callcc-early-exit-2"
  -- , "callcc-early-exit-3"
  -- , "callcc-early-exit-4"
  -- , "callcc-early-exit-5"
  -- , "callcc-early-exit-6"
  -- , "callcc-nested-1"
  -- , "callcc-nested-2"
  -- , "complicated-1"
  -- , "cons-1"
  -- , "factorial"
  -- , "false"
  -- , "fn-of-fn"
  -- , "if-false"
  -- , "if-number"
  -- , "if-true"
  -- , "lambda"
  -- , "letrec-fn"
  -- , "let-fn"
  -- , "lit-int"
  -- , "square"
  -- , "true"
  -- ]

test_eval :: IO TestTree
test_eval = do
  cs <- listDirectory "golden/exec"
      <&> fmap ("golden/exec" </>)
  pure $ testGroup "cps interpreter"
    [ testGroup "higher-order" $ cpsCase Driver.eval_cps2_e2e <$> cs
    , testGroup "first-order" $ cpsCase Driver.eval_cps_e2e <$> cs
    ]

maybeBroken name broken = applyWhen (name `elem` broken) expectFail

cpsCase :: (FilePath -> IO Text) -> FilePath -> TestTree
cpsCase f test =
  maybeBroken testName brokenEvalTests $
    goldenVsAction testName resultFile action printProcResult
  where
    testName = takeFileName test
    resultFile = test </> "exec"
    sourceFile = test </> "source.scm"
    action = catch @SomeException
      (do r <- f sourceFile
          pure $!! ( ExitSuccess
                   , r
                   , "" ))
      \e -> pure (ExitFailure 1, "", T.pack $ displayException e)