purerl_test

module PurerlTest.Reporter
  ( startLink
  , report
  ) where

import Prelude

import Data.Array as Array
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Class.Console as Console
import Erl.Atom as Atom
import Pinto (RegistryName(..), RegistryReference(..), StartLinkResult)
import Pinto.GenServer (CastFn, InfoFn, InitFn, InitResult(..), ServerSpec)
import Pinto.GenServer as GenServer
import PurerlTest.Reporter.Bus as ReporterBus
import PurerlTest.Reporter.Types (Message, Pid, ServerType', State)
import PurerlTest.Types (AssertionFailure, SuiteName, SuiteStatus(..), TestName)

serverName :: RegistryName ServerType'
serverName = "PurerlTest.Reporter" # Atom.atom # Local

startLink :: Effect (StartLinkResult Pid)
startLink = do
  GenServer.startLink spec

spec :: ServerSpec Unit Unit Message State
spec =
  (GenServer.defaultSpec init) { name = Just serverName, handleInfo = Just handleInfo }

init :: InitFn Unit Unit Message State
init = do
  _subscriptionRef <- ReporterBus.subscribe identity
  { suitesInFlight: [], failures: 0 } # InitOk # pure

report
  :: { suiteName :: SuiteName
     , testCount :: Int
     , successes :: Int
     , failures :: Array { test :: TestName, assertions :: Array AssertionFailure }
     }
  -> Effect Unit
report r = do
  GenServer.cast (ByName serverName) (handleReport r)

handleReport
  :: { suiteName :: SuiteName
     , testCount :: Int
     , successes :: Int
     , failures :: Array { test :: TestName, assertions :: Array AssertionFailure }
     }
  -> CastFn Unit Unit Message State
handleReport { suiteName, testCount, successes, failures } state = do
  [ "🧪 ", unwrap suiteName ] # Array.fold # Console.log
  [ "  ", show successes, "/", show testCount, " successes" ] # Array.fold # Console.log
  failures # traverse_ printFailedTest # liftEffect
  { name: suiteName } # SuiteDone # ReporterBus.SuiteMessage # ReporterBus.send # liftEffect
  let failureCount = Array.length failures
  state { failures = state.failures + failureCount } # GenServer.return # pure

handleInfo :: InfoFn Unit Unit Message State
handleInfo (ReporterBus.SuiteMessage (SuiteStarted { name })) state = do
  state { suitesInFlight = state.suitesInFlight `Array.snoc` name } # GenServer.return # pure
handleInfo (ReporterBus.SuiteMessage (SuiteDone { name })) state = do
  let suitesInFlight = Array.delete name state.suitesInFlight
  liftEffect $ when (Array.null suitesInFlight) $ do
    let exitCode = if state.failures > 0 then 1 else 0
    ReporterBus.send (ReporterBus.AllDone exitCode)
  state { suitesInFlight = suitesInFlight } # GenServer.return # pure
handleInfo (ReporterBus.AllDone _exitCode) state = do
  state # GenServer.return # pure

printFailedTest :: { test :: TestName, assertions :: Array AssertionFailure } -> Effect Unit
printFailedTest { test, assertions } = do
  [ "  ❌ ", unwrap test ] # Array.fold # Console.log
  traverse_ printAssertionFailure assertions

printAssertionFailure :: AssertionFailure -> Effect Unit
printAssertionFailure { message } = do
  [ "    ", message ] # Array.fold # Console.log