-- | Abstract test case mutants and their concretization.
module Test.Mutagen.Mutant
  ( -- * Abstract mutants
    Mutant (..)
  , MutantKind (..)

    -- * Concretized test cases
  , Concretized (..)
  , concretize

    -- * Re-exports
  , Gen
  , FragmentStore
  )
where

import Control.Monad (replicateM)
import Data.Typeable (Typeable)
import Test.Mutagen.Fragment.Store (FragmentStore)
import Test.QuickCheck (Gen, generate, resize)

{-------------------------------------------------------------------------------
-- * Abstract mutants
-------------------------------------------------------------------------------}

-- | Mutants representing possibly unrealized mutations over values of type @a@.
data Mutant a
  = -- | A pure mutation obtained after applying a deterministic transformation
    Pure a
  | -- | A random mutation obtained by sampling from a generator
    Rand (Gen a)
  | -- | A fragment-based mutation obtained by sampling from a fragment store
    Frag (FragmentStore -> Gen [a])

instance Show (Mutant a) where
  show :: Mutant a -> String
show (Pure a
_) = String
"Pure(..)"
  show (Rand Gen a
_) = String
"Rand(..)"
  show (Frag FragmentStore -> Gen [a]
_) = String
"Frag(..)"

instance Functor Mutant where
  fmap :: forall a b. (a -> b) -> Mutant a -> Mutant b
fmap a -> b
f (Pure a
mut) = b -> Mutant b
forall a. a -> Mutant a
Pure (a -> b
f a
mut)
  fmap a -> b
f (Rand Gen a
gen) = Gen b -> Mutant b
forall a. Gen a -> Mutant a
Rand ((a -> b) -> Gen a -> Gen b
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Gen a
gen)
  fmap a -> b
f (Frag FragmentStore -> Gen [a]
fun) = (FragmentStore -> Gen [b]) -> Mutant b
forall a. (FragmentStore -> Gen [a]) -> Mutant a
Frag ((Gen [a] -> Gen [b])
-> (FragmentStore -> Gen [a]) -> FragmentStore -> Gen [b]
forall a b. (a -> b) -> (FragmentStore -> a) -> FragmentStore -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> [b]) -> Gen [a] -> Gen [b]
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) FragmentStore -> Gen [a]
fun)

{-------------------------------------------------------------------------------
-- * Concretized test cases
-------------------------------------------------------------------------------}

-- | Kinds of concretized mutants.
data MutantKind = PureMutant | RandMutant | FragMutant
  deriving (Int -> MutantKind -> ShowS
[MutantKind] -> ShowS
MutantKind -> String
(Int -> MutantKind -> ShowS)
-> (MutantKind -> String)
-> ([MutantKind] -> ShowS)
-> Show MutantKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MutantKind -> ShowS
showsPrec :: Int -> MutantKind -> ShowS
$cshow :: MutantKind -> String
show :: MutantKind -> String
$cshowList :: [MutantKind] -> ShowS
showList :: [MutantKind] -> ShowS
Show)

-- | Values obtained by concretizing a mutant.
data Concretized a = Concretized MutantKind a
  deriving (Int -> Concretized a -> ShowS
[Concretized a] -> ShowS
Concretized a -> String
(Int -> Concretized a -> ShowS)
-> (Concretized a -> String)
-> ([Concretized a] -> ShowS)
-> Show (Concretized a)
forall a. Show a => Int -> Concretized a -> ShowS
forall a. Show a => [Concretized a] -> ShowS
forall a. Show a => Concretized a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Concretized a -> ShowS
showsPrec :: Int -> Concretized a -> ShowS
$cshow :: forall a. Show a => Concretized a -> String
show :: Concretized a -> String
$cshowList :: forall a. Show a => [Concretized a] -> ShowS
showList :: [Concretized a] -> ShowS
Show)

-- | Turn an abstract mutant into a concrete set of values.
concretize
  :: (Typeable a)
  => (Int, Int)
  -- ^ Count and max generation size for random mutants
  -> (Int, FragmentStore)
  -- ^ Count and fragment store for fragment mutants
  -> Mutant a
  -- ^ Mutant to concretize
  -> IO [Concretized a]
concretize :: forall a.
Typeable a =>
(Int, Int)
-> (Int, FragmentStore) -> Mutant a -> IO [Concretized a]
concretize (Int, Int)
_ (Int, FragmentStore)
_ (Pure a
mut) = do
  (a -> Concretized a) -> [a] -> [Concretized a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MutantKind -> a -> Concretized a
forall a. MutantKind -> a -> Concretized a
Concretized MutantKind
PureMutant) ([a] -> [Concretized a]) -> IO [a] -> IO [Concretized a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [a
mut]
concretize (Int
n, Int
s) (Int, FragmentStore)
_ (Rand Gen a
gen) = do
  (a -> Concretized a) -> [a] -> [Concretized a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MutantKind -> a -> Concretized a
forall a. MutantKind -> a -> Concretized a
Concretized MutantKind
RandMutant) ([a] -> [Concretized a]) -> IO [a] -> IO [Concretized a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO a -> IO [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Gen a -> IO a
forall a. Gen a -> IO a
generate (Int -> Gen a -> Gen a
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
s Gen a
gen))
concretize (Int, Int)
_ (Int
n, FragmentStore
fs) (Frag FragmentStore -> Gen [a]
fun) = do
  (a -> Concretized a) -> [a] -> [Concretized a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MutantKind -> a -> Concretized a
forall a. MutantKind -> a -> Concretized a
Concretized MutantKind
FragMutant) ([a] -> [Concretized a]) -> IO [a] -> IO [Concretized a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n) (Gen [a] -> IO [a]
forall a. Gen a -> IO a
generate (FragmentStore -> Gen [a]
fun FragmentStore
fs))