{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Configuration options for Mutagen.
module Test.Mutagen.Config
  ( -- * Configuration options
    Config (..)
  , defaultConfig

    -- * Helpers
  , allow
  , allow'
  , deny
  , deny'
  , example
  , LazyPruningMode (..)
  , EvaluationOrder (..)
  , DebugMode (..)

    -- * Re-exports
  , FragmentTypeFilter
  , TraceBackend (..)
  )
where

import qualified Data.Set as Set
import Data.Typeable (Proxy (..), Typeable, typeRep)
import Test.Mutagen.Fragment.Store (FragmentTypeFilter (..))
import Test.Mutagen.Mutation (MutationOrder, levelorder)
import Test.Mutagen.Property (Args (..), IsArgs)
import Test.Mutagen.Tracer.Store (TraceBackend (..))

{-------------------------------------------------------------------------------
-- * Configuration options
-------------------------------------------------------------------------------}

-- | Configuration options for Mutagen.
data Config
  = Config
  { Config -> Int
maxSuccess :: Int
  -- ^ Max number of passed tests.
  , Config -> Int
maxDiscardRatio :: Int
  -- ^ Max discard ratio.
  , Config -> Maybe Integer
timeout :: Maybe Integer
  -- ^ Campaign time budget in seconds (has precedence over maxSuccess).
  , Config -> Bool
expect :: Bool
  -- ^ Whether the property is expected to hold (True) or to fail (False).
  , Config -> Int
maxGenSize :: Int
  -- ^ Max generation size passed to a generator. It uses the same formula for
  -- computing sizes as vanilla QuickCheck when in generation mode. Random
  -- mutations are generated using the maximum size.
  , Config -> Int
randomMutations :: Int
  -- ^ Number of times to sample the generator associated to a random mutant.
  -- It can be automatically increased over time if `autoResetAfter` is not set
  -- to `Nothing`.
  , Config -> Maybe Int
maxMutationDepth :: Maybe Int
  -- ^ The maximum number of ancestors a test case can have before being
  -- discarded. Useful to avoid mutating recursive structures indefinetely.
  -- Defaults to `maxGenSize` if set to `Nothing`.
  , Config -> Maybe Int
autoResetAfter :: Maybe Int
  -- ^ Reset the global trace log if no interesting test case is found after a
  -- certain number of tests. If not set to `Nothing`, this will duplicate the
  -- current limit on every reset. Additionally, it also duplicates the
  -- `randomMutations` parameter.
  , Config -> LazyPruningMode
lazyPruning :: LazyPruningMode
  -- ^ Use lazy pruning to avoid mutating unevaluated subexpressions. The
  -- target mutable subexpressions are ordered by last evaluated first.
  , Config -> MutationOrder
mutationOrder :: MutationOrder
  -- ^ If `lazyPruning` is set to `False`, *every* subexpression of an
  -- interesting test case is mutated regardless whether it was evaluated or
  -- not. These subexpressions are ordered using a generic tree traversal order
  -- (level order by default). The provided options are:
  -- `Test.Mutagen.Mutation.levelorder`, `Test.Mutagen.Mutation.preorder`, and
  -- `Test.Mutagen.Mutation.postorder`, but you're free to define your own
  -- tree traversal order if needed.
  , Config -> Bool
useFragments :: Bool
  -- ^ Explode the interesting test cases found during the test loop into typed
  -- fragments. These fragments can be used to concretize fragment mutants.
  , Config -> Int
randomFragments :: Int
  -- ^ The amount of fragments sampled from the global fragment store when
  -- concretizing a fragment mutant. Can return less than `randomFragments` test
  -- cases if there are not enough fragments of the type of the target
  -- subexpression to sample from.
  , Config -> FragmentTypeFilter
filterFragments :: FragmentTypeFilter
  -- ^ Filter to allow or deny values of certain types from being saved in the
  -- fragment store.
  , Config -> [Args]
examples :: [Args]
  -- ^ Initial inputs examples used to populate the global fragment store before
  -- the testing loop starts.
  , Config -> TraceBackend
traceBackend :: TraceBackend
  -- ^ The tracing mechanism. Either `Tree` or `Bitmap`. `Tree` uses
  -- prefix-based traces (quite expensive but more precise). `Bitmap` uses
  -- edge-based traces (cheaper but less precise).
  , Config -> Maybe Int
maxTraceLength :: Maybe Int
  -- ^ The maximim trace length to consider. Nodes added beyond this limit will
  -- be ignored. This is useful to limit memory consumption when using the
  -- `Tree` 'TraceBackend' while testing lengthy properties.
  , Config -> Bool
keepGoing :: Bool
  -- ^ Whether to keep searching for more counterexamples after finding the
  -- first one. If set, Mutagen will stop only when reaching the maximum number
  -- of successful tests or the timeout, without giving up in the presence of
  -- too many discards. Reports will always be a 'Test.Mutagen.Report.Success'.
  --
  -- NOTE: you probably want to set 'saveCounterexamples' when enabling this.
  , Config -> Maybe FilePath
saveCounterexamples :: Maybe FilePath
  -- ^ If set to a 'FilePath', save found counterexamples to the given path.
  -- Accepts templated file paths via \@, e.g., "counterexample_\@.hs", where
  -- \@ is be replaced by a counter. This is useful in combination with
  -- 'keepGoing' to save multiple counterexamples over a long testing campaign.
  --
  -- NOTE: if 'keepGoing' is enabled and the counterexample path does not
  -- contain @, then the counter is appended at the end.
  , Config -> Bool
chatty :: Bool
  -- ^ Print extra info.
  , Config -> DebugMode
debug :: DebugMode
  -- ^ Whether to enable interactive debugging mode.
  , Config -> Bool
tui :: Bool
  -- ^ Whether to use a terminal user interface (TUI) for displaying progress.
  }

-- | Default configuration options for Mutagen.
defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
  Config
    { maxSuccess :: Int
maxSuccess = Int
1000000
    , maxDiscardRatio :: Int
maxDiscardRatio = Int
1000
    , timeout :: Maybe Integer
timeout = Maybe Integer
forall a. Maybe a
Nothing
    , expect :: Bool
expect = Bool
True
    , maxGenSize :: Int
maxGenSize = Int
10
    , randomMutations :: Int
randomMutations = Int
1
    , maxMutationDepth :: Maybe Int
maxMutationDepth = Maybe Int
forall a. Maybe a
Nothing
    , autoResetAfter :: Maybe Int
autoResetAfter = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1000
    , lazyPruning :: LazyPruningMode
lazyPruning = EvaluationOrder -> LazyPruningMode
LazyPruning EvaluationOrder
Forward
    , mutationOrder :: MutationOrder
mutationOrder = Tree a -> [a]
MutationOrder
levelorder
    , useFragments :: Bool
useFragments = Bool
False
    , randomFragments :: Int
randomFragments = Int
10
    , filterFragments :: FragmentTypeFilter
filterFragments = FragmentTypeFilter
forall a. Monoid a => a
mempty
    , examples :: [Args]
examples = []
    , traceBackend :: TraceBackend
traceBackend = TraceBackend
Bitmap
    , maxTraceLength :: Maybe Int
maxTraceLength = Maybe Int
forall a. Maybe a
Nothing
    , keepGoing :: Bool
keepGoing = Bool
False
    , saveCounterexamples :: Maybe FilePath
saveCounterexamples = Maybe FilePath
forall a. Maybe a
Nothing
    , chatty :: Bool
chatty = Bool
False
    , debug :: DebugMode
debug = DebugMode
NoDebug
    , tui :: Bool
tui = Bool
False
    }

{-------------------------------------------------------------------------------
-- * Helpers
-------------------------------------------------------------------------------}

-- | Allow a type to be saved in the fragment store.
allow :: forall a. (Typeable a) => FragmentTypeFilter
allow :: forall a. Typeable a => FragmentTypeFilter
allow = Set TypeRep -> Set TypeRep -> FragmentTypeFilter
FragmentTypeFilter (TypeRep -> Set TypeRep
forall a. a -> Set a
Set.singleton (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))) Set TypeRep
forall a. Monoid a => a
mempty

-- | Like 'allow' but taking a t'Proxy' argument.
allow' :: forall a. (Typeable a) => Proxy a -> FragmentTypeFilter
allow' :: forall a. Typeable a => Proxy a -> FragmentTypeFilter
allow' Proxy a
_ = forall a. Typeable a => FragmentTypeFilter
allow @a

-- | Deny a type from being saved in the fragment store.
deny :: forall a. (Typeable a) => FragmentTypeFilter
deny :: forall a. Typeable a => FragmentTypeFilter
deny = Set TypeRep -> Set TypeRep -> FragmentTypeFilter
FragmentTypeFilter Set TypeRep
forall a. Monoid a => a
mempty (TypeRep -> Set TypeRep
forall a. a -> Set a
Set.singleton (Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)))

-- | Like 'deny' but taking a t'Proxy' argument.
deny' :: forall a. (Typeable a) => Proxy a -> FragmentTypeFilter
deny' :: forall a. Typeable a => Proxy a -> FragmentTypeFilter
deny' Proxy a
_ = forall a. Typeable a => FragmentTypeFilter
deny @a

-- | Helper to create an example input of any supported argument type.
example :: forall a. (IsArgs a) => a -> Args
example :: forall a. IsArgs a => a -> Args
example = a -> Args
forall a. IsArgs a => a -> Args
Args

-- | Lazy pruning mode.
--
-- Used to dictate whether lazy pruning is used or not, and in which order
-- subexpressions are mutated.
data LazyPruningMode
  = -- | Do not use lazy pruning; mutate all subexpressions.
    NoLazyPruning
  | -- | Use lazy pruning; mutate only evaluated subexpressions, following the
    -- order in which they were evaluated.
    LazyPruning EvaluationOrder
  deriving (LazyPruningMode -> LazyPruningMode -> Bool
(LazyPruningMode -> LazyPruningMode -> Bool)
-> (LazyPruningMode -> LazyPruningMode -> Bool)
-> Eq LazyPruningMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LazyPruningMode -> LazyPruningMode -> Bool
== :: LazyPruningMode -> LazyPruningMode -> Bool
$c/= :: LazyPruningMode -> LazyPruningMode -> Bool
/= :: LazyPruningMode -> LazyPruningMode -> Bool
Eq, Int -> LazyPruningMode -> ShowS
[LazyPruningMode] -> ShowS
LazyPruningMode -> FilePath
(Int -> LazyPruningMode -> ShowS)
-> (LazyPruningMode -> FilePath)
-> ([LazyPruningMode] -> ShowS)
-> Show LazyPruningMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LazyPruningMode -> ShowS
showsPrec :: Int -> LazyPruningMode -> ShowS
$cshow :: LazyPruningMode -> FilePath
show :: LazyPruningMode -> FilePath
$cshowList :: [LazyPruningMode] -> ShowS
showList :: [LazyPruningMode] -> ShowS
Show)

-- | Evaluation order for lazy pruning.
--
-- Used to dictate how to order the evaluated subexpressions to be mutated.
data EvaluationOrder
  = -- | Mutate the least recently evaluated subexpressions first.
    Forward
  | -- | Mutate the most recently evaluated subexpressions first.
    Backward
  deriving (EvaluationOrder -> EvaluationOrder -> Bool
(EvaluationOrder -> EvaluationOrder -> Bool)
-> (EvaluationOrder -> EvaluationOrder -> Bool)
-> Eq EvaluationOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EvaluationOrder -> EvaluationOrder -> Bool
== :: EvaluationOrder -> EvaluationOrder -> Bool
$c/= :: EvaluationOrder -> EvaluationOrder -> Bool
/= :: EvaluationOrder -> EvaluationOrder -> Bool
Eq, Int -> EvaluationOrder -> ShowS
[EvaluationOrder] -> ShowS
EvaluationOrder -> FilePath
(Int -> EvaluationOrder -> ShowS)
-> (EvaluationOrder -> FilePath)
-> ([EvaluationOrder] -> ShowS)
-> Show EvaluationOrder
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvaluationOrder -> ShowS
showsPrec :: Int -> EvaluationOrder -> ShowS
$cshow :: EvaluationOrder -> FilePath
show :: EvaluationOrder -> FilePath
$cshowList :: [EvaluationOrder] -> ShowS
showList :: [EvaluationOrder] -> ShowS
Show)

-- | Debugging mode.
--
-- Allows stopping the loop between test cases to inspect the internal state.
data DebugMode
  = -- | Run normally without stopping between tests.
    NoDebug
  | -- | Stop after every passed test case.
    StopOnPassed
  | -- | Stop after every test case (passed or discarded).
    AlwaysStop
  deriving (DebugMode -> DebugMode -> Bool
(DebugMode -> DebugMode -> Bool)
-> (DebugMode -> DebugMode -> Bool) -> Eq DebugMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DebugMode -> DebugMode -> Bool
== :: DebugMode -> DebugMode -> Bool
$c/= :: DebugMode -> DebugMode -> Bool
/= :: DebugMode -> DebugMode -> Bool
Eq, Int -> DebugMode -> ShowS
[DebugMode] -> ShowS
DebugMode -> FilePath
(Int -> DebugMode -> ShowS)
-> (DebugMode -> FilePath)
-> ([DebugMode] -> ShowS)
-> Show DebugMode
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DebugMode -> ShowS
showsPrec :: Int -> DebugMode -> ShowS
$cshow :: DebugMode -> FilePath
show :: DebugMode -> FilePath
$cshowList :: [DebugMode] -> ShowS
showList :: [DebugMode] -> ShowS
Show)