-----------------------------------------------------------------------------
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      : Miso.Test
-- Copyright   : (C) 2016-2026 David M. Johnson
-- License     : BSD3-style (see the file LICENSE)
-- Maintainer  : David M. Johnson <code@dmj.io>
-- Stability   : experimental
-- Portability : non-portable
--
-- = Overview
--
-- "Miso.Test" is a lightweight hspec-style testing framework for miso
-- 'Miso.Types.Component' integration tests. It runs in the browser (or a
-- JSDOM environment) via
-- <https://playwright.dev/ Playwright>, giving each test full access to
-- the live DOM.
--
-- Tests are written as @'StateT' 'TestState' IO@, which means they can call
-- any 'IO' action — including miso DOM operations and 'Miso.FFI' calls — directly.
-- Each 'it' block is timed and its result is printed with coloured output.
-- After all tests run, 'runTests' prints a summary and calls
-- @'System.Exit.exitSuccess'@ or @'System.Exit.exitFailure'@ so the process
-- exit code reflects the test outcome.
--
-- = Quick start
--
-- @
-- import "Miso.Test"
-- import "Miso.Runtime.Internal" (components)
-- import Data.IORef (writeIORef)
-- import qualified Data.IntMap.Strict as IM
--
-- main :: IO ()
-- main = 'runTests' $ do
--   'describe' \"Arithmetic\" $ do
--     'it' \"2 + 2 = 4\" $
--       (2 + 2) \`'shouldBe'\` (4 :: Int)
--     'it' \"3 /= 4\" $
--       (3 :: Int) \`'shouldNotBe'\` 4
--
--   'describe' \"Component\" $
--     'beforeEach' (writeIORef components IM.empty) $ do
--       'it' \"mounts without error\" $ do
--         -- mount a component and assert on DOM state
--         pure ()
-- @
--
-- = Combinators
--
-- * 'describe' — group related tests under a label.
-- * 'it' — declare a single named test; times it and records pass\/fail.
-- * 'beforeEach' — run an 'IO' action before every 'it' in the wrapped block.
-- * 'afterEach' — run an 'IO' action after every 'it' in the wrapped block.
--
-- = Assertion primitives
--
-- * @x \`'shouldBe'\` y@ — assert @x == y@; pretty-prints a diff on failure.
-- * @x \`'shouldNotBe'\` y@ — assert @x \/= y@.
-- * @x \`'shouldSatisfy'\` p@ — assert that the predicate @p x@ holds.
-- * @'expect' f x y@ — assert @f x y@; the most general form.
--
-- Multiple assertions within a single 'it' block are all evaluated; the
-- block is marked as failed if any assertion fails.
--
-- = Running tests
--
-- @'runTests' :: 'Test' a -> IO ()@ is the entry point. It executes the
-- test tree, prints per-test results and a final summary (pass count,
-- fail count, total tests, total duration, and @expect()@ call count),
-- then exits:
--
-- * @'System.Exit.exitSuccess'@ — all tests passed.
-- * @'System.Exit.exitFailure'@ — one or more tests failed.
--
-- When compiled with @-DJSDOM@, 'runTests' additionally calls
-- @globalThis.initJSDOM()@ before running any tests, enabling headless
-- DOM testing outside a real browser.
--
-- = Utilities
--
-- * 'choose' @min max@ — returns a uniformly random @Int@ in @[min, max)@
--   using the JS @getRandomNumber@ global. Useful for property-style tests
--   that need random inputs.
--
-- = Types
--
-- * @'Test' a = 'Control.Monad.State.StateT' 'TestState' IO a@ — the test monad.
-- * 'TestState' — internal state tracking per-test timing, pass\/fail counts,
--   before\/after hooks, and error messages.
--
-- = See also
--
-- * "Miso.Runtime.Internal" — 'Miso.Runtime.Internal.components' IORef for resetting state between tests
-- * "Miso.Random" — 'Miso.Random.newStdGen', 'Miso.Random.replicateRM' for random values
-- * "Miso" — the component and effect API under test
----------------------------------------------------------------------------
module Miso.Test
  ( -- * Test Combinators
    describe
  , it
  , expect
  , beforeEach
  , afterEach
  , shouldBe
  , shouldSatisfy
  , shouldNotBe
  , runTests
  -- * Utils
  , choose
  -- * Types
  , Test
  , TestState
  ) where
-----------------------------------------------------------------------------
import           Control.Exception (IOException)
import           Control.Monad.Except (catchError)
import           Text.Printf
import           Control.Monad.State
import           Control.Monad
import           System.Exit
-----------------------------------------------------------------------------
import           Miso
import           Miso.Lens
-----------------------------------------------------------------------------
-- | Used to group a bunch of expectations using 'it'. Testing out
-- will include the test description in its output.
describe
  :: MisoString
  -- ^ Description of test group
  -> Test ()
  -- ^ Group of tests to run
  -> Test ()
describe :: Text -> Test () -> Test ()
describe Text
name Test ()
tests = do
  Lens TestState Text
currentTestGroup Lens TestState Text -> Text -> Test ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Text
name
  Test ()
tests
-----------------------------------------------------------------------------
-- | Used to make multiple expectations using 'shouldBe' / 'shouldNotBe'.
--
it
  :: MisoString
  -- ^ Name of test to execute
  -> Test ()
  -- ^ Test holding multiple expectations
  -> Test ()
it :: Text -> Test () -> Test ()
it Text
name Test ()
action = do
  preamble <- Lens TestState (IO ()) -> StateT TestState IO (IO ())
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens TestState (IO ())
beforeAction
  liftIO preamble
  total += 1
  currentTestName .= name
  Clocked {..} <- clock action
  currentTestTime .= time
  totalDuration += time
  successful <- use currentTestResult
  errorMessage <- use currentErrorMessage
  if successful
    then passed += 1
    else failed += 1
  testGroup <- use currentTestGroup
  caughtEx <- use caughtException
  when (successful || caughtEx) $ do
    liftIO $ prettyTest CurrentTest
      { duration = time
      , ..
      }
  conclusion <- use afterAction
  liftIO conclusion
  currentTestResult .= True
  currentErrorMessage .= mempty
  caughtException .= False
-----------------------------------------------------------------------------
data CurrentTest
  = CurrentTest
  { CurrentTest -> Text
testGroup :: MisoString
  -- ^ Name of the enclosing 'describe' group
  , CurrentTest -> Text
name :: MisoString
  -- ^ Name of the 'it' test case
  , CurrentTest -> Bool
successful :: Bool
  -- ^ 'True' if all assertions in the test passed
  , CurrentTest -> Text
errorMessage :: MisoString
  -- ^ Human-readable failure message, empty on success
  , CurrentTest -> Double
duration :: Double
  -- ^ Wall-clock execution time in milliseconds
  } deriving (Int -> CurrentTest -> ShowS
[CurrentTest] -> ShowS
CurrentTest -> [Char]
(Int -> CurrentTest -> ShowS)
-> (CurrentTest -> [Char])
-> ([CurrentTest] -> ShowS)
-> Show CurrentTest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurrentTest -> ShowS
showsPrec :: Int -> CurrentTest -> ShowS
$cshow :: CurrentTest -> [Char]
show :: CurrentTest -> [Char]
$cshowList :: [CurrentTest] -> ShowS
showList :: [CurrentTest] -> ShowS
Show, CurrentTest -> CurrentTest -> Bool
(CurrentTest -> CurrentTest -> Bool)
-> (CurrentTest -> CurrentTest -> Bool) -> Eq CurrentTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurrentTest -> CurrentTest -> Bool
== :: CurrentTest -> CurrentTest -> Bool
$c/= :: CurrentTest -> CurrentTest -> Bool
/= :: CurrentTest -> CurrentTest -> Bool
Eq)
-----------------------------------------------------------------------------
-- | The monad that executes tests
type Test a = StateT TestState IO a
-----------------------------------------------------------------------------
-- | Internal type for managing test state
data TestState
  = TestState
  { TestState -> Text
_currentTestGroup :: MisoString
  -- ^ Label of the current 'describe' group
  , TestState -> Text
_currentErrorMessage :: MisoString
  -- ^ Accumulated failure message for the current 'it' block
  , TestState -> Text
_currentTestName :: MisoString
  -- ^ Name of the currently executing 'it' block
  , TestState -> Double
_currentTestTime :: Double
  -- ^ Start time (or elapsed time) of the current 'it' block in milliseconds
  , TestState -> Int
_expects :: Int
  -- ^ Total number of 'expect' calls made across all tests
  , TestState -> Int
_failed :: Int
  -- ^ Count of 'it' blocks that had at least one failing assertion
  , TestState -> Int
_passed :: Int
  -- ^ Count of 'it' blocks where all assertions passed
  , TestState -> Int
_total :: Int
  -- ^ Total number of 'it' blocks registered
  , TestState -> Double
_totalDuration :: Double
  -- ^ Cumulative wall-clock time for all 'it' blocks in milliseconds
  , TestState -> Bool
_currentTestResult :: Bool
  -- ^ 'True' while no assertion has failed in the current 'it' block
  , TestState -> IO ()
_beforeAction :: IO ()
  -- ^ Action run before each 'it' block (registered via 'beforeEach')
  , TestState -> IO ()
_afterAction :: IO ()
  -- ^ Action run after each 'it' block (registered via 'afterEach')
  , TestState -> Bool
_caughtException :: Bool
  -- ^ 'True' if the current 'it' block threw an 'Control.Exception.IOException'
  }
-----------------------------------------------------------------------------
emptyTestState :: TestState
emptyTestState :: TestState
emptyTestState = Text
-> Text
-> Text
-> Double
-> Int
-> Int
-> Int
-> Int
-> Double
-> Bool
-> IO ()
-> IO ()
-> Bool
-> TestState
TestState Text
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty Text
forall a. Monoid a => a
mempty Double
0 Int
0 Int
0 Int
0 Int
0 Double
0 Bool
True (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Bool
False
-----------------------------------------------------------------------------
beforeAction :: Lens TestState (IO ())
beforeAction :: Lens TestState (IO ())
beforeAction = (TestState -> IO ())
-> (TestState -> IO () -> TestState) -> Lens TestState (IO ())
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> IO ()
_beforeAction ((TestState -> IO () -> TestState) -> Lens TestState (IO ()))
-> (TestState -> IO () -> TestState) -> Lens TestState (IO ())
forall a b. (a -> b) -> a -> b
$ \TestState
r IO ()
x -> TestState
r { _beforeAction = x }
-----------------------------------------------------------------------------
afterAction :: Lens TestState (IO ())
afterAction :: Lens TestState (IO ())
afterAction = (TestState -> IO ())
-> (TestState -> IO () -> TestState) -> Lens TestState (IO ())
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> IO ()
_afterAction ((TestState -> IO () -> TestState) -> Lens TestState (IO ()))
-> (TestState -> IO () -> TestState) -> Lens TestState (IO ())
forall a b. (a -> b) -> a -> b
$ \TestState
r IO ()
x -> TestState
r { _afterAction = x }
-----------------------------------------------------------------------------
expects :: Lens TestState Int
expects :: Lens TestState Int
expects = (TestState -> Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Int
_expects ((TestState -> Int -> TestState) -> Lens TestState Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall a b. (a -> b) -> a -> b
$ \TestState
r Int
x -> TestState
r { _expects = x }
-----------------------------------------------------------------------------
caughtException :: Lens TestState Bool
caughtException :: Lens TestState Bool
caughtException = (TestState -> Bool)
-> (TestState -> Bool -> TestState) -> Lens TestState Bool
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Bool
_caughtException ((TestState -> Bool -> TestState) -> Lens TestState Bool)
-> (TestState -> Bool -> TestState) -> Lens TestState Bool
forall a b. (a -> b) -> a -> b
$ \TestState
r Bool
x -> TestState
r { _caughtException = x }
-----------------------------------------------------------------------------
totalDuration :: Lens TestState Double
totalDuration :: Lens TestState Double
totalDuration = (TestState -> Double)
-> (TestState -> Double -> TestState) -> Lens TestState Double
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Double
_totalDuration ((TestState -> Double -> TestState) -> Lens TestState Double)
-> (TestState -> Double -> TestState) -> Lens TestState Double
forall a b. (a -> b) -> a -> b
$ \TestState
r Double
x -> TestState
r { _totalDuration = x }
-----------------------------------------------------------------------------
passed :: Lens TestState Int
passed :: Lens TestState Int
passed = (TestState -> Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Int
_passed ((TestState -> Int -> TestState) -> Lens TestState Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall a b. (a -> b) -> a -> b
$ \TestState
r Int
x -> TestState
r { _passed = x }
-----------------------------------------------------------------------------
failed :: Lens TestState Int
failed :: Lens TestState Int
failed = (TestState -> Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Int
_failed ((TestState -> Int -> TestState) -> Lens TestState Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall a b. (a -> b) -> a -> b
$ \TestState
r Int
x -> TestState
r { _failed = x }
-----------------------------------------------------------------------------
total :: Lens TestState Int
total :: Lens TestState Int
total = (TestState -> Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Int
_total ((TestState -> Int -> TestState) -> Lens TestState Int)
-> (TestState -> Int -> TestState) -> Lens TestState Int
forall a b. (a -> b) -> a -> b
$ \TestState
r Int
x -> TestState
r { _total = x }
-----------------------------------------------------------------------------
currentTestResult :: Lens TestState Bool
currentTestResult :: Lens TestState Bool
currentTestResult = (TestState -> Bool)
-> (TestState -> Bool -> TestState) -> Lens TestState Bool
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Bool
_currentTestResult ((TestState -> Bool -> TestState) -> Lens TestState Bool)
-> (TestState -> Bool -> TestState) -> Lens TestState Bool
forall a b. (a -> b) -> a -> b
$ \TestState
r Bool
x -> TestState
r { _currentTestResult = x }
-----------------------------------------------------------------------------
currentTestName :: Lens TestState MisoString
currentTestName :: Lens TestState Text
currentTestName = (TestState -> Text)
-> (TestState -> Text -> TestState) -> Lens TestState Text
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Text
_currentTestName ((TestState -> Text -> TestState) -> Lens TestState Text)
-> (TestState -> Text -> TestState) -> Lens TestState Text
forall a b. (a -> b) -> a -> b
$ \TestState
r Text
x -> TestState
r { _currentTestName = x }
-----------------------------------------------------------------------------
currentErrorMessage :: Lens TestState MisoString
currentErrorMessage :: Lens TestState Text
currentErrorMessage = (TestState -> Text)
-> (TestState -> Text -> TestState) -> Lens TestState Text
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Text
_currentErrorMessage ((TestState -> Text -> TestState) -> Lens TestState Text)
-> (TestState -> Text -> TestState) -> Lens TestState Text
forall a b. (a -> b) -> a -> b
$ \TestState
r Text
x -> TestState
r { _currentErrorMessage = x }
-----------------------------------------------------------------------------
currentTestGroup :: Lens TestState MisoString
currentTestGroup :: Lens TestState Text
currentTestGroup = (TestState -> Text)
-> (TestState -> Text -> TestState) -> Lens TestState Text
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Text
_currentTestGroup ((TestState -> Text -> TestState) -> Lens TestState Text)
-> (TestState -> Text -> TestState) -> Lens TestState Text
forall a b. (a -> b) -> a -> b
$ \TestState
r Text
x -> TestState
r { _currentTestGroup = x }
-----------------------------------------------------------------------------
currentTestTime :: Lens TestState Double
currentTestTime :: Lens TestState Double
currentTestTime = (TestState -> Double)
-> (TestState -> Double -> TestState) -> Lens TestState Double
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> Double
_currentTestTime ((TestState -> Double -> TestState) -> Lens TestState Double)
-> (TestState -> Double -> TestState) -> Lens TestState Double
forall a b. (a -> b) -> a -> b
$ \TestState
r Double
x -> TestState
r { _currentTestTime = x }
-----------------------------------------------------------------------------
-- | Primitive for performing expectations in an 'it' block.
expect
  :: (Eq a, Show a)
  => (a -> a -> Bool)
  -- ^ Comparison predicate; the test passes when this returns 'True'
  -> a
  -- ^ Actual value (shown in failure output as "Received")
  -> a
  -- ^ Expected value (shown in failure output as "Expecting")
  -> Test ()
expect :: forall a. (Eq a, Show a) => (a -> a -> Bool) -> a -> a -> Test ()
expect a -> a -> Bool
f a
x a
y = do
  let succeeded :: Bool
succeeded = a -> a -> Bool
f a
x a
y
  name <- Lens TestState Text -> StateT TestState IO Text
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens TestState Text
currentTestName
  start <- use currentTestTime
  groupName <- use currentTestGroup
  expects += 1
  currentTestResult %= (&& succeeded)
  unless succeeded $ liftIO $ do
    stop <- now
    prettyTest (CurrentTest groupName name succeeded expectationMessage (stop - start))
      where
        expectationMessage :: Text
expectationMessage = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Expecting: "
          , Text
yellow
          , [Char] -> Text
forall str. ToMisoString str => str -> Text
ms (a -> [Char]
forall a. Show a => a -> [Char]
show a
y)
          , Text
"\n"
          , Text
reset
          , Text
"      "
          , Text
cyan Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"↳ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reset Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Received:  "
          , Text
red
          , [Char] -> Text
forall str. ToMisoString str => str -> Text
ms (a -> [Char]
forall a. Show a => a -> [Char]
show a
x)
          , Text
" \n"
          , Text
reset
          ]
-----------------------------------------------------------------------------
-- | Primitive for performing expectations in an 'it' block.
shouldSatisfy
  :: (Eq a, Show a)
  => a
  -- ^ Actual value to test
  -> (a -> Bool)
  -- ^ Predicate that must hold for the assertion to pass
  -> Test ()
shouldSatisfy :: forall a. (Eq a, Show a) => a -> (a -> Bool) -> Test ()
shouldSatisfy a
x a -> Bool
f = do
  let succeeded :: Bool
succeeded = a -> Bool
f a
x
  name <- Lens TestState Text -> StateT TestState IO Text
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens TestState Text
currentTestName
  start <- use currentTestTime
  groupName <- use currentTestGroup
  expects += 1
  currentTestResult %= (&& succeeded)
  unless succeeded $ liftIO $ do
    stop <- now
    prettyTest (CurrentTest groupName name succeeded expectationMessage (stop - start))
      where
        expectationMessage :: Text
expectationMessage = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
          [ Text
"Expecting: "
          , Text
yellow
          , [Char] -> Text
forall str. ToMisoString str => str -> Text
ms (a -> [Char]
forall a. Show a => a -> [Char]
show a
x)
          , Text
" to satisfy predicate"
          , Text
"\n"
          , Text
reset
          , Text
"      "
          , Text
cyan Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"↳ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reset Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Received:  "
          , Text
red
          , [Char] -> Text
forall str. ToMisoString str => str -> Text
ms (a -> [Char]
forall a. Show a => a -> [Char]
show a
x)
          , Text
" \n"
          , Text
reset
          ]
-----------------------------------------------------------------------------
-- | Perform an expectation in an 'it' block.
--
-- The complement of 'shouldBe'.
--
shouldNotBe
  :: (Show a, Eq a)
  => a
  -- ^ Actual value
  -> a
  -- ^ Value it must NOT equal
  -> Test ()
shouldNotBe :: forall a. (Show a, Eq a) => a -> a -> Test ()
shouldNotBe = (a -> a -> Bool) -> a -> a -> Test ()
forall a. (Eq a, Show a) => (a -> a -> Bool) -> a -> a -> Test ()
expect a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
-----------------------------------------------------------------------------
-- | Performs an expectation in an 'it' block.
--
shouldBe
  :: (Show a, Eq a)
  => a
  -- ^ Actual value
  -> a
  -- ^ Expected value it must equal
  -> Test ()
shouldBe :: forall a. (Show a, Eq a) => a -> a -> Test ()
shouldBe = (a -> a -> Bool) -> a -> a -> Test ()
forall a. (Eq a, Show a) => (a -> a -> Bool) -> a -> a -> Test ()
expect a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
-----------------------------------------------------------------------------
-- | Execute a t'IO' action before each 'it' block.
--
-- This is useful for scenarios like clearing the global t'Component' state.
--
beforeEach
  :: IO ()
  -- ^ Action to run before each 'it' block in the wrapped group
  -> Test ()
  -- ^ Test group to wrap
  -> Test ()
beforeEach :: IO () -> Test () -> Test ()
beforeEach IO ()
action Test ()
x = do
  Lens TestState (IO ())
beforeAction Lens TestState (IO ()) -> (IO () -> IO ()) -> Test ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= \IO ()
f -> IO ()
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
action
  Test ()
x
-----------------------------------------------------------------------------
-- | Execute a t'IO' after each 'it' block.
--
-- This is useful for scenarios like clearing the global t'Component' state.
--
afterEach
  :: IO ()
  -- ^ Action to run after each 'it' block in the wrapped group
  -> Test ()
  -- ^ Test group to wrap
  -> Test ()
afterEach :: IO () -> Test () -> Test ()
afterEach IO ()
action Test ()
x = do
  Lens TestState (IO ())
afterAction Lens TestState (IO ()) -> (IO () -> IO ()) -> Test ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= \IO ()
f -> IO ()
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
action
  Test ()
x
-----------------------------------------------------------------------------
data Clocked a
  = Clocked
  { forall a. Clocked a -> Double
time :: Double
  -- ^ Wall-clock duration in milliseconds
  , forall a. Clocked a -> Either [Char] a
result :: Either String a
  -- ^ @'Left' errMsg@ if an exception was caught; @'Right' a@ on success
  } deriving (Int -> Clocked a -> ShowS
[Clocked a] -> ShowS
Clocked a -> [Char]
(Int -> Clocked a -> ShowS)
-> (Clocked a -> [Char])
-> ([Clocked a] -> ShowS)
-> Show (Clocked a)
forall a. Show a => Int -> Clocked a -> ShowS
forall a. Show a => [Clocked a] -> ShowS
forall a. Show a => Clocked a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Clocked a -> ShowS
showsPrec :: Int -> Clocked a -> ShowS
$cshow :: forall a. Show a => Clocked a -> [Char]
show :: Clocked a -> [Char]
$cshowList :: forall a. Show a => [Clocked a] -> ShowS
showList :: [Clocked a] -> ShowS
Show, Clocked a -> Clocked a -> Bool
(Clocked a -> Clocked a -> Bool)
-> (Clocked a -> Clocked a -> Bool) -> Eq (Clocked a)
forall a. Eq a => Clocked a -> Clocked a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Clocked a -> Clocked a -> Bool
== :: Clocked a -> Clocked a -> Bool
$c/= :: forall a. Eq a => Clocked a -> Clocked a -> Bool
/= :: Clocked a -> Clocked a -> Bool
Eq)
-----------------------------------------------------------------------------
clock :: Test a -> Test (Clocked a)
clock :: forall a. Test a -> Test (Clocked a)
clock Test a
action = do
  start <- IO Double -> StateT TestState IO Double
forall a. IO a -> StateT TestState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
now
  currentTestTime .= start
  -- dmj: ^ we set current to start here for use w/ expect() failures
  result <- (Right <$> action) `catchError` errorHandler start
  stop <- liftIO now
  let time = Double
stop Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start
  currentTestTime .= time
  pure Clocked {..}
    where
      errorHandler :: Double -> IOException -> m (Either [Char] b)
errorHandler Double
start (IOException
e :: IOException) = do
        stop <- IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Double
now
        currentErrorMessage .= ms e
        caughtException .= True
        currentTestResult %= (&& False)
        currentTestTime .= stop - start
        pure $ Left (show e)
-----------------------------------------------------------------------------
-- | Executes a block of tests in 'describe' blocks.
runTests
  :: Test a
  -- ^ The test tree to execute (built from 'describe' \/ 'it' blocks)
  -> IO ()
runTests :: forall a. Test a -> IO ()
runTests Test a
ts = do
#ifdef JSDOM
  _ <- global # ("initJSDOM" :: String) $ ()
#endif
  summary <- Test a -> TestState -> IO TestState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Test a
ts TestState
emptyTestState
  printSummary summary
  when (summary ^. failed > 0) $ do
    consoleLog "ERROR"
    liftIO exitFailure
  consoleLog "SUCCESS"
  liftIO exitSuccess
-----------------------------------------------------------------------------
formatMillis :: Double -> MisoString
formatMillis :: Double -> Text
formatMillis Double
duration = [Char] -> Text
forall str. ToMisoString str => str -> Text
ms ([Char] -> Double -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%.3f ms" Double
duration :: String)
-----------------------------------------------------------------------------
prettyTest :: CurrentTest -> IO ()
prettyTest :: CurrentTest -> IO ()
prettyTest CurrentTest {Bool
Double
Text
duration :: CurrentTest -> Double
testGroup :: CurrentTest -> Text
name :: CurrentTest -> Text
successful :: CurrentTest -> Bool
errorMessage :: CurrentTest -> Text
testGroup :: Text
name :: Text
successful :: Bool
errorMessage :: Text
duration :: Double
..} = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$
  if Bool
successful
    then
      Text -> IO JSVal
jsg (Text
"console" :: MisoString) IO JSVal -> Text -> [Text] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> Text -> args -> IO JSVal
# (Text
"log" :: MisoString) ([Text] -> IO JSVal) -> [Text] -> IO JSVal
forall a b. (a -> b) -> a -> b
$
         [ Text
green
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"✓"
         , Text
reset Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. ToMisoString str => str -> Text
ms Text
testGroup
         , Text
">"
         , Text
white
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. ToMisoString str => str -> Text
ms Text
name
         , Text
gray
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"["
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
formatMillis Double
duration
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
         ]
    else
      Text -> IO JSVal
jsg (Text
"console" :: MisoString) IO JSVal -> Text -> [Text] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> Text -> args -> IO JSVal
# (Text
"log" :: MisoString) ([Text] -> IO JSVal) -> [Text] -> IO JSVal
forall a b. (a -> b) -> a -> b
$
         [ Text
red Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"✗"
         , Text
reset Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
testGroup
         , Text
">"
         , Text
white
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gray
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ["
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
formatMillis Double
duration
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
         , Text
cyan
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n      ↳ "
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reset
             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errorMessage
         ]
-----------------------------------------------------------------------------
printSummary :: TestState -> IO ()
printSummary :: TestState -> IO ()
printSummary TestState {Bool
Double
Int
IO ()
Text
_currentTestGroup :: TestState -> Text
_currentErrorMessage :: TestState -> Text
_currentTestName :: TestState -> Text
_currentTestTime :: TestState -> Double
_expects :: TestState -> Int
_failed :: TestState -> Int
_passed :: TestState -> Int
_total :: TestState -> Int
_totalDuration :: TestState -> Double
_currentTestResult :: TestState -> Bool
_beforeAction :: TestState -> IO ()
_afterAction :: TestState -> IO ()
_caughtException :: TestState -> Bool
_currentTestGroup :: Text
_currentErrorMessage :: Text
_currentTestName :: Text
_currentTestTime :: Double
_expects :: Int
_failed :: Int
_passed :: Int
_total :: Int
_totalDuration :: Double
_currentTestResult :: Bool
_beforeAction :: IO ()
_afterAction :: IO ()
_caughtException :: Bool
..} = IO JSVal -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO JSVal -> IO ()) -> IO JSVal -> IO ()
forall a b. (a -> b) -> a -> b
$
  Text -> IO JSVal
jsg (Text
"console" :: MisoString) IO JSVal -> Text -> [Text] -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> Text -> args -> IO JSVal
# (Text
"log" :: MisoString) ([Text] -> IO JSVal) -> [Text] -> IO JSVal
forall a b. (a -> b) -> a -> b
$
    [ Text
"\n  "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
green
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall str. ToMisoString str => str -> Text
ms Int
_passed
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" passed"
    , Text
"\n  "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
red
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall str. ToMisoString str => str -> Text
ms Int
_failed
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed"
    , Text
"\n  "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reset
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Ran "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall str. ToMisoString str => str -> Text
ms Int
_total
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" tests"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gray
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ["
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
formatMillis Double
_totalDuration
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
    , Text
"\n  "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reset
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall str. ToMisoString str => str -> Text
ms Int
_expects
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" expect() calls"
    ]
-----------------------------------------------------------------------------
-- | colors
green, cyan, yellow, red, reset, white, gray :: MisoString
green :: Text
green = Text
"\x1b[32m"
gray :: Text
gray = Text
"\x1b[90m"
red :: Text
red = Text
"\x1b[31m"
reset :: Text
reset = Text
"\x1b[0m"
yellow :: Text
yellow = Text
"\x1b[33m"
cyan :: Text
cyan = Text
"\x1b[36m"
white :: Text
white = Text
"\x1b[37m"
-----------------------------------------------------------------------------
-- | Return a random integer between the first two provided [min, max)
--
-- The maximum is exclusive and the minimum is inclusive
--
choose
  :: Int
  -- ^ min
  -> Int
  -- ^ max
  -> IO Int
choose :: Int -> Int -> IO Int
choose Int
x Int
y = JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  JSVal
global JSVal -> Text -> (Int, Int) -> IO JSVal
forall object args.
(ToObject object, ToArgs args) =>
object -> Text -> args -> IO JSVal
# Text
"getRandomNumber" ((Int, Int) -> IO JSVal) -> (Int, Int) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ (Int
x,Int
y)
-----------------------------------------------------------------------------