-----------------------------------------------------------------------------
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Test
-- Copyright   :  (C) 2016-2025 David M. Johnson (@dmjio)
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- An hspec-like [miso](https://github.com/dmjio/miso) testing framework. Meant for testing @miso@ @Component@.
-- The testing framework operates in the jsaddle t'Language.Javascript.JSaddle.Types.JSM' monad and has access
-- to the DOM courtesy of [JSDOM](https://github.com/jsdom/jsdom) and [Playwright](https://playwright.dev/).
--
-- @
--
-- main :: IO ()
-- main = runTests $ do
--   describe "Arithmetic tests" $ do
--     it "2 + 2 = 4" $ do
--       (2 + 2) \`shouldBe\` 4
-- @
--
----------------------------------------------------------------------------
module Miso.Test
  ( -- * Test Combinators
    describe
  , it
  , expect
  , beforeEach
  , afterEach
  , shouldBe
  , shouldNotBe
  , runTests
  -- * Utils
  , jsm
  , choose
  -- * Types
  , Test
  , TestState
  ) where
-----------------------------------------------------------------------------
import           Control.Exception (SomeException)
import           Language.Javascript.JSaddle.Monad
import           Text.Printf
import           Control.Monad.State
import           Control.Monad
import           Language.Javascript.JSaddle
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 :: MisoString -> Test () -> Test ()
describe MisoString
name Test ()
tests = do
  Lens TestState MisoString
currentTestGroup Lens TestState MisoString -> MisoString -> Test ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= MisoString
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 :: MisoString -> Test () -> Test ()
it MisoString
name Test ()
action = do
  preamble <- Lens TestState (JSM ()) -> StateT TestState JSM (JSM ())
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens TestState (JSM ())
beforeAction
  jsm 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
    jsm $ prettyTest CurrentTest
      { duration = time
      , ..
      }
  conclusion <- use afterAction
  jsm conclusion
  currentTestResult .= True
  currentErrorMessage .= mempty
  caughtException .= False
-----------------------------------------------------------------------------
data CurrentTest
  = CurrentTest
  { CurrentTest -> MisoString
testGroup :: MisoString
  , CurrentTest -> MisoString
name :: MisoString
  , CurrentTest -> Bool
successful :: Bool
  , CurrentTest -> MisoString
errorMessage :: MisoString
  , CurrentTest -> Double
duration :: Double
  } deriving (Int -> CurrentTest -> ShowS
[CurrentTest] -> ShowS
CurrentTest -> String
(Int -> CurrentTest -> ShowS)
-> (CurrentTest -> String)
-> ([CurrentTest] -> ShowS)
-> Show CurrentTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurrentTest -> ShowS
showsPrec :: Int -> CurrentTest -> ShowS
$cshow :: CurrentTest -> String
show :: CurrentTest -> String
$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 JSM a
-----------------------------------------------------------------------------
-- | Internal type for managing test state
data TestState
  = TestState
  { TestState -> MisoString
_currentTestGroup :: MisoString
  , TestState -> MisoString
_currentErrorMessage :: MisoString
  , TestState -> MisoString
_currentTestName :: MisoString
  , TestState -> Double
_currentTestTime :: Double
  , TestState -> Int
_expects :: Int
  , TestState -> Int
_failed :: Int
  , TestState -> Int
_passed :: Int
  , TestState -> Int
_total :: Int
  , TestState -> Double
_totalDuration :: Double
  , TestState -> Bool
_currentTestResult :: Bool
  , TestState -> JSM ()
_beforeAction :: JSM ()
  , TestState -> JSM ()
_afterAction :: JSM ()
  , TestState -> Bool
_caughtException :: Bool
  }
-----------------------------------------------------------------------------
emptyTestState :: TestState
emptyTestState :: TestState
emptyTestState = MisoString
-> MisoString
-> MisoString
-> Double
-> Int
-> Int
-> Int
-> Int
-> Double
-> Bool
-> JSM ()
-> JSM ()
-> Bool
-> TestState
TestState MisoString
forall a. Monoid a => a
mempty MisoString
forall a. Monoid a => a
mempty MisoString
forall a. Monoid a => a
mempty Double
0 Int
0 Int
0 Int
0 Int
0 Double
0 Bool
True (() -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> JSM ()
forall a. a -> JSM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Bool
False
-----------------------------------------------------------------------------
beforeAction :: Lens TestState (JSM ())
beforeAction :: Lens TestState (JSM ())
beforeAction = (TestState -> JSM ())
-> (TestState -> JSM () -> TestState) -> Lens TestState (JSM ())
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> JSM ()
_beforeAction ((TestState -> JSM () -> TestState) -> Lens TestState (JSM ()))
-> (TestState -> JSM () -> TestState) -> Lens TestState (JSM ())
forall a b. (a -> b) -> a -> b
$ \TestState
r JSM ()
x -> TestState
r { _beforeAction = x }
-----------------------------------------------------------------------------
afterAction :: Lens TestState (JSM ())
afterAction :: Lens TestState (JSM ())
afterAction = (TestState -> JSM ())
-> (TestState -> JSM () -> TestState) -> Lens TestState (JSM ())
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> JSM ()
_afterAction ((TestState -> JSM () -> TestState) -> Lens TestState (JSM ()))
-> (TestState -> JSM () -> TestState) -> Lens TestState (JSM ())
forall a b. (a -> b) -> a -> b
$ \TestState
r JSM ()
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 MisoString
currentTestName = (TestState -> MisoString)
-> (TestState -> MisoString -> TestState)
-> Lens TestState MisoString
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> MisoString
_currentTestName ((TestState -> MisoString -> TestState)
 -> Lens TestState MisoString)
-> (TestState -> MisoString -> TestState)
-> Lens TestState MisoString
forall a b. (a -> b) -> a -> b
$ \TestState
r MisoString
x -> TestState
r { _currentTestName = x }
-----------------------------------------------------------------------------
currentErrorMessage :: Lens TestState MisoString
currentErrorMessage :: Lens TestState MisoString
currentErrorMessage = (TestState -> MisoString)
-> (TestState -> MisoString -> TestState)
-> Lens TestState MisoString
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> MisoString
_currentErrorMessage ((TestState -> MisoString -> TestState)
 -> Lens TestState MisoString)
-> (TestState -> MisoString -> TestState)
-> Lens TestState MisoString
forall a b. (a -> b) -> a -> b
$ \TestState
r MisoString
x -> TestState
r { _currentErrorMessage = x }
-----------------------------------------------------------------------------
currentTestGroup :: Lens TestState MisoString
currentTestGroup :: Lens TestState MisoString
currentTestGroup = (TestState -> MisoString)
-> (TestState -> MisoString -> TestState)
-> Lens TestState MisoString
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens TestState -> MisoString
_currentTestGroup ((TestState -> MisoString -> TestState)
 -> Lens TestState MisoString)
-> (TestState -> MisoString -> TestState)
-> Lens TestState MisoString
forall a b. (a -> b) -> a -> b
$ \TestState
r MisoString
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)
  -> a
  -> a
  -> 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 MisoString -> StateT TestState JSM MisoString
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens TestState MisoString
currentTestName
  start <- use currentTestTime
  groupName <- use currentTestGroup
  expects += 1
  currentTestResult %= (&& succeeded)
  when (not succeeded) $ jsm $ do
    stop <- now
    prettyTest (CurrentTest groupName name succeeded expectationMessage (stop - start))
      where
        expectationMessage :: MisoString
expectationMessage = [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat
          [ MisoString
"Expecting: "
          , MisoString
yellow
          , String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (a -> String
forall a. Show a => a -> String
show a
y)
          , MisoString
"\n"
          , MisoString
reset
          , MisoString
"      "
          , MisoString
cyan MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"↳ " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
reset MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"Received:  "
          , MisoString
red
          , String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (a -> String
forall a. Show a => a -> String
show a
x)
          , MisoString
" \n"
          , MisoString
reset
          ]
-----------------------------------------------------------------------------
-- | Perform an expectation in an 'it' block.
--
-- The complement of 'shouldBe'.
--
shouldNotBe
  :: (Show a, Eq a)
  => a
  -> a
  -> 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
  -> a
  -> 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'Language.Javascript.JSaddle.Types.JSM' action before each 'it' block.
--
-- This is useful for scenarios like clearing the global t'Component' state.
--
beforeEach
  :: JSM ()
  -> Test ()
  -> Test ()
beforeEach :: JSM () -> Test () -> Test ()
beforeEach JSM ()
action Test ()
x = do
  Lens TestState (JSM ())
beforeAction Lens TestState (JSM ()) -> (JSM () -> JSM ()) -> Test ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= \JSM ()
f -> JSM ()
f JSM () -> JSM () -> JSM ()
forall a b. JSM a -> JSM b -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSM ()
action
  Test ()
x
-----------------------------------------------------------------------------
-- | Execute a t'Language.Javascript.JSaddle.Types.JSM' after each 'it' block.
--
-- This is useful for scenarios like clearing the global t'Component' state.
--
afterEach
  :: JSM ()
  -> Test ()
  -> Test ()
afterEach :: JSM () -> Test () -> Test ()
afterEach JSM ()
action Test ()
x = do
  Lens TestState (JSM ())
afterAction Lens TestState (JSM ()) -> (JSM () -> JSM ()) -> Test ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= \JSM ()
f -> JSM ()
f JSM () -> JSM () -> JSM ()
forall a b. JSM a -> JSM b -> JSM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JSM ()
action
  Test ()
x
-----------------------------------------------------------------------------
data Clocked a
  = Clocked
  { forall a. Clocked a -> Double
time :: Double
  , forall a. Clocked a -> Either String a
result :: Either String a
  } deriving (Int -> Clocked a -> ShowS
[Clocked a] -> ShowS
Clocked a -> String
(Int -> Clocked a -> ShowS)
-> (Clocked a -> String)
-> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([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 -> String
show :: Clocked a -> String
$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 <- JSM Double -> StateT TestState JSM Double
forall a. JSM a -> Test a
jsm JSM Double
now
  currentTestTime .= start
  -- dmj: ^ we set current to start here for use w/ expect() failures
  result <- (Right <$> action) `catch`
    (\(SomeException
e :: SomeException) -> do
        stop <- JSM Double -> StateT TestState JSM Double
forall a. JSM a -> Test a
jsm JSM Double
now
        currentErrorMessage .= ms e
        caughtException .= True
        currentTestResult %= (&& False)
        currentTestTime .= stop - start
        pure $ Left (show e))
  stop <- jsm now
  let time = Double
stop Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start
  currentTestTime .= time
  pure Clocked {..}
-----------------------------------------------------------------------------
-- | Executes a block of tests in 'describe' blocks.
runTests :: Test a -> IO ()
runTests :: forall a. Test a -> IO ()
runTests Test a
ts = JSM () -> IO ()
run (JSM () -> IO ()) -> JSM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
#ifdef JSDOM
  _ <- global # ("initJSDOM" :: String) $ ()
#endif
  summary <- Test a -> TestState -> JSM 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 -> MisoString
formatMillis Double
duration = String -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.3f ms" Double
duration :: String)
-----------------------------------------------------------------------------
prettyTest :: CurrentTest -> JSM ()
prettyTest :: CurrentTest -> JSM ()
prettyTest CurrentTest {Bool
Double
MisoString
duration :: CurrentTest -> Double
testGroup :: CurrentTest -> MisoString
name :: CurrentTest -> MisoString
successful :: CurrentTest -> Bool
errorMessage :: CurrentTest -> MisoString
testGroup :: MisoString
name :: MisoString
successful :: Bool
errorMessage :: MisoString
duration :: Double
..} = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$
  if Bool
successful
    then
      MisoString -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (MisoString
"console" :: MisoString) JSM JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"log" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
         [ MisoString
green
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"✓"
         , MisoString
reset MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
testGroup
         , MisoString
">"
         , MisoString
white
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
name
         , MisoString
gray
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"["
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Double -> MisoString
formatMillis Double
duration
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"]"
         ]
    else
      MisoString -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (MisoString
"console" :: MisoString) JSM JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"log" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
         [ MisoString
red MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"✗"
         , MisoString
reset MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
testGroup
         , MisoString
">"
         , MisoString
white
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
name
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
gray
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" ["
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Double -> MisoString
formatMillis Double
duration
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"]"
         , MisoString
cyan
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"\n      ↳ "
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
reset
             MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
errorMessage
         ]
-----------------------------------------------------------------------------
printSummary :: TestState -> JSM ()
printSummary :: TestState -> JSM ()
printSummary TestState {Bool
Double
Int
MisoString
JSM ()
_currentTestGroup :: TestState -> MisoString
_currentErrorMessage :: TestState -> MisoString
_currentTestName :: TestState -> MisoString
_currentTestTime :: TestState -> Double
_expects :: TestState -> Int
_failed :: TestState -> Int
_passed :: TestState -> Int
_total :: TestState -> Int
_totalDuration :: TestState -> Double
_currentTestResult :: TestState -> Bool
_beforeAction :: TestState -> JSM ()
_afterAction :: TestState -> JSM ()
_caughtException :: TestState -> Bool
_currentTestGroup :: MisoString
_currentErrorMessage :: MisoString
_currentTestName :: MisoString
_currentTestTime :: Double
_expects :: Int
_failed :: Int
_passed :: Int
_total :: Int
_totalDuration :: Double
_currentTestResult :: Bool
_beforeAction :: JSM ()
_afterAction :: JSM ()
_caughtException :: Bool
..} = JSM JSVal -> JSM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (JSM JSVal -> JSM ()) -> JSM JSVal -> JSM ()
forall a b. (a -> b) -> a -> b
$
  MisoString -> JSM JSVal
forall a. ToJSString a => a -> JSM JSVal
jsg (MisoString
"console" :: MisoString) JSM JSVal -> MisoString -> [MisoString] -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"log" :: MisoString) ([MisoString] -> JSM JSVal) -> [MisoString] -> JSM JSVal
forall a b. (a -> b) -> a -> b
$
    [ MisoString
"\n  "
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
green
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Int
_passed
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" passed"
    , MisoString
"\n  "
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
red
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Int
_failed
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" failed"
    , MisoString
"\n  "
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
reset
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"Ran "
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Int
_total
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" tests"
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
gray
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" ["
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Double -> MisoString
formatMillis Double
_totalDuration
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"]"
    , MisoString
"\n  "
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
reset
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Int
_expects
        MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
" expect() calls"
    ]
-----------------------------------------------------------------------------
-- | colors
green, cyan, yellow, red, reset, white, gray :: MisoString
green :: MisoString
green = MisoString
"\x1b[32m"
gray :: MisoString
gray = MisoString
"\x1b[90m"
red :: MisoString
red = MisoString
"\x1b[31m"
reset :: MisoString
reset = MisoString
"\x1b[0m"
yellow :: MisoString
yellow = MisoString
"\x1b[33m"
cyan :: MisoString
cyan = MisoString
"\x1b[36m"
white :: MisoString
white = MisoString
"\x1b[37m"
-----------------------------------------------------------------------------
-- | Convenience for calling 'liftJSM'
jsm :: JSM a -> Test a
jsm :: forall a. JSM a -> Test a
jsm = JSM a -> StateT TestState JSM a
forall (m :: * -> *) a. MonadJSM m => JSM a -> m a
liftJSM
-----------------------------------------------------------------------------
-- | 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
  -> JSM Int
choose :: Int -> Int -> JSM Int
choose Int
x Int
y = JSVal -> JSM Int
forall a. FromJSVal a => JSVal -> JSM a
fromJSValUnchecked (JSVal -> JSM Int) -> JSM JSVal -> JSM Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  Object
global Object -> MisoString -> (Int, Int) -> JSM JSVal
forall this name args.
(MakeObject this, ToJSString name, MakeArgs args) =>
this -> name -> args -> JSM JSVal
# (MisoString
"getRandomNumber" :: MisoString) ((Int, Int) -> JSM JSVal) -> (Int, Int) -> JSM JSVal
forall a b. (a -> b) -> a -> b
$ (Int
x,Int
y)
-----------------------------------------------------------------------------