Lib.hs

{-# LANGUAGE NoImplicitPrelude #-}

module Test.Lib (spec) where

import Control.Monad.Except
import Data.Text (Text)
import qualified Data.Text as T
import System.Exit (ExitCode (..))
import System.Process (readProcessWithExitCode)
import Test.HUnit (assertEqual)
import Test.Hspec
import Test.Utils
import Prelude hiding (exp)

data LibTest = LibTest
  { libTestEntries :: [Text],
    libTestZephyrOptions :: Maybe [Text],
    libTestJs :: Text,
    -- | true if it should run without error, false if it should error
    libTestShouldPass :: Bool
  }

libTests :: [LibTest]
libTests =
  [ LibTest
      ["Unsafe.Coerce.Test.unsafeX"]
      Nothing
      ( "import { unsafeX } from './dce-output/Unsafe.Coerce.Test/index.js';"
          <> "unsafeX(1)(1);"
      )
      True,
    LibTest
      ["Foreign.Test.add"]
      Nothing
      ( "import { add } from './dce-output/Foreign.Test/index.js';"
          <> "add(1)(1);"
      )
      True,
    LibTest
      ["Foreign.Test.add"]
      Nothing
      ( "import { mult } from './dce-output/Foreign.Test/index.js';"
          <> "mult(1)(1);"
      )
      False,
    LibTest
      ["Foreign.Test.add"]
      Nothing
      "import { mult } from './dce-output/Foreign.Test/foreign.js';"
      False,
    LibTest
      ["Foreign.Test.snowflake"]
      Nothing
      ( "import { snowflake } from './dce-output/Foreign.Test/index.js';"
          <> "if(snowflake !== '❄'){console.error(`'${snowflake}' !== '❄'`); throw 'Error';}"
      )
      True,
    LibTest
      ["Foreign.Test.b"]
      Nothing
      ( "import { b } from './dce-output/Foreign.Test/index.js';"
          <> "if(b() !== 5) throw 'Error';"
      )
      True,
    LibTest
      ["Eval.makeAppQueue"]
      Nothing
      "import { makeAppQueue } from './dce-output/Eval/index.js';"
      True,
    LibTest
      ["Eval.evalUnderArrayLiteral"]
      Nothing
      "import { evalUnderArrayLiteral } from './dce-output/Eval/index.js';"
      True,
    LibTest
      ["Eval.evalUnderObjectLiteral"]
      Nothing
      "import { evalUnderObjectLiteral } from './dce-output/Eval/index.js';"
      True,
    LibTest
      ["Eval.evalVars"]
      Nothing
      "import { evalVars } from './dce-output/Eval/index.js';"
      True,
    LibTest
      ["Eval"]
      Nothing
      "import { evalVars } from './dce-output/Eval/index.js';"
      True,
    LibTest
      ["Eval.recordUpdate"]
      Nothing
      ( "import * as E from './dce-output/Eval/index.js';"
          <> "var foo = E.recordUpdate({ foo: '', bar: 0 })(E.Foo.create('foo'));"
          <> "if (foo.foo != 'foo') {"
          <> "  console.error(foo);"
          <> "  throw 'Error';"
          <> "}"
      )
      True,
    LibTest
      ["Literals.fromAnArray"]
      Nothing
      ( "import * as lits from './dce-output/Literals/index.js';"
          <> "if (lits.fromAnArray == null || lits.AStr == null || lits.AInt != null) {"
          <> "  throw 'Error';"
          <> "}"
      )
      True,
    LibTest
      ["Literals.fromAnObject"]
      Nothing
      ( "import * as lits from './dce-output/Literals/index.js';"
          <> "if (lits.fromAnObject == null || lits.AStr == null || lits.AInt != null) {"
          <> "  throw 'Error';"
          <> "}"
      )
      True,
    -- Control.Alt re-exports map from Data.Functor
    LibTest
      ["Control.Alt.map"]
      Nothing
      "import { map } from './dce-output/Control.Alt/index.js';"
      True,
    LibTest
      ["Data.Array.span"]
      Nothing
      ( "import { span } from './dce-output/Data.Array/index.js';"
          <> "const a = [1, 3, 2, 4, 5];"
          <> "const p = (x) => x % 2 === 1;"
          <> "const r = span(p)(a);"
          <> "const expected = { init: [1, 3], rest: [2, 4, 5] };"
          <> "console.log(r);"
          <> "if (!r.init.every((e, i) => e === expected.init[i])) throw 'Error';"
          <> "if (!r.rest.every((e, i) => e === expected.rest[i])) throw 'Error';"
      )
      True
  ]

assertLib :: LibTest -> Expectation
assertLib l = do
  res <- runExceptT . runLibTest $ l
  assertEqual "lib should run" (Right ()) res

runLibTest :: LibTest -> ExceptT TestError IO ()
runLibTest
  LibTest
    { libTestEntries,
      libTestZephyrOptions,
      libTestJs,
      libTestShouldPass
    } = do
    spagoBuild "LibTest"
    runZephyr "LibTest" libTestEntries libTestZephyrOptions
    (ecNode, stdNode, errNode) <-
      lift $
        readProcessWithExitCode
          "node"
          [ "--input-type=module",
            "-e",
            T.unpack libTestJs
          ]
          ""
    when
      (libTestShouldPass && ecNode /= ExitSuccess)
      (throwError $ NodeError "LibTest (should pass)" ecNode stdNode errNode)
    when
      (not libTestShouldPass && ecNode == ExitSuccess)
      (throwError $ NodeError "LibTest (should fail)" ecNode stdNode errNode)

spec :: Spec
spec =
  changeDir "test/lib-tests" $
    context "test-lib" $
      forM_ libTests $ \l ->
        specify (T.unpack $ T.intercalate (T.pack " ") $ libTestEntries l) $ assertLib l