{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

-- | Test drivers for Mutagen properties, mirrored from QuickCheck.
module Test.Mutagen.Test.Driver
  ( -- * Test drivers
    mutagen
  , mutagenVerbose
  , mutagenVerboseReport
  , mutagenReport
  , mutagenWith
  , mutagenWithReport
  )
where

import Control.Monad (void)
import Test.Mutagen.Config (Config (..), defaultConfig)
import Test.Mutagen.Property (Testable (..))
import Test.Mutagen.Report (Report)
import Test.Mutagen.Test.Loop (loop)
import Test.Mutagen.Test.State (initMutagenState)
import Test.Mutagen.Test.Terminal (brickTUI, stdoutTUI, withTerminalT)

{-------------------------------------------------------------------------------
-- * Test drivers
-------------------------------------------------------------------------------}

-- | Run Mutagen with default configuration.
mutagen :: (Testable p) => p -> IO ()
mutagen :: forall p. Testable p => p -> IO ()
mutagen = Config -> p -> IO ()
forall p. Testable p => Config -> p -> IO ()
mutagenWith Config
defaultConfig

-- | Run Mutagen with default configuration in verbose mode.
mutagenVerbose :: (Testable p) => p -> IO ()
mutagenVerbose :: forall p. Testable p => p -> IO ()
mutagenVerbose = Config -> p -> IO ()
forall p. Testable p => Config -> p -> IO ()
mutagenWith Config
defaultConfig{chatty = True}

-- | Run Mutagen with default configuration in verbose mode, returning a report.
mutagenVerboseReport :: (Testable p) => p -> IO Report
mutagenVerboseReport :: forall p. Testable p => p -> IO Report
mutagenVerboseReport = Config -> p -> IO Report
forall p. Testable p => Config -> p -> IO Report
mutagenWithReport Config
defaultConfig{chatty = True}

-- | Run Mutagen with default configuration, returning a report.
mutagenReport :: (Testable p) => p -> IO Report
mutagenReport :: forall p. Testable p => p -> IO Report
mutagenReport = Config -> p -> IO Report
forall p. Testable p => Config -> p -> IO Report
mutagenWithReport Config
defaultConfig

-- | Run Mutagen with a custom configuration.
mutagenWith :: (Testable p) => Config -> p -> IO ()
mutagenWith :: forall p. Testable p => Config -> p -> IO ()
mutagenWith Config
cfg p
p = IO Report -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Config -> p -> IO Report
forall p. Testable p => Config -> p -> IO Report
mutagenWithReport Config
cfg p
p)

-- | Run Mutagen with a custom configuration, returning a report.
mutagenWithReport :: (Testable p) => Config -> p -> IO Report
mutagenWithReport :: forall p. Testable p => Config -> p -> IO Report
mutagenWithReport Config
cfg p
p = do
  st <- Config -> Property -> IO MutagenState
initMutagenState Config
cfg (p -> Property
forall a. Testable a => a -> Property
property p
p)
  ui <- if tui cfg then brickTUI else stdoutTUI
  withTerminalT ui (loop st)