{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Monad.Control.Mutants where
import Control.Monad.State
import Control.Monad.Trans.Control
import Test.Mutants
mutantLiftWith
:: (Monad m, MonadTransControl t)
=> (RunDefault (Mutant v t) t -> m a) -> Mutant v t m a
mutantLiftWith = defaultLiftWith Mutant mutate
mutantRestoreT :: (Monad m, MonadTransControl t) => m (StT t a) -> Mutant v t m a
mutantRestoreT = defaultRestoreT Mutant
data LiftWithTwice
instance
MonadTransControl t => MonadTransControl (Mutant LiftWithTwice t) where
type StT (Mutant LiftWithTwice t) a = StT t a
restoreT = mutantRestoreT
liftWith f = mutantLiftWith (\run -> f run >> f run)
data RunTwice
instance
MonadTransControl t => MonadTransControl (Mutant RunTwice t) where
type StT (Mutant RunTwice t) a = StT t a
restoreT = mutantRestoreT
liftWith f = mutantLiftWith (\run -> f (\t -> run t >> run t))
data RestoreTwice
instance
MonadTransControl t => MonadTransControl (Mutant RestoreTwice t) where
type StT (Mutant RestoreTwice t) a = StT t a
liftWith = mutantLiftWith
restoreT m = mutantRestoreT (m >> m)
data LiftWithDropState
instance MonadTransControl (Mutant LiftWithDropState (StateT s)) where
type StT (Mutant LiftWithDropState (StateT s)) a = StT (StateT s) a
restoreT = mutantRestoreT
liftWith f = Mutant . StateT $ \s ->
fmap
(\a -> (a, s))
(f (\(Mutant (StateT m)) ->
fmap
(\(a, _) -> (a, s))
(m s)))
data RestoreDropState
instance MonadTransControl (Mutant RestoreDropState (StateT s)) where
type StT (Mutant RestoreDropState (StateT s)) a = StT (StateT s) a
liftWith = mutantLiftWith
restoreT m = Mutant . StateT $ \s -> fmap (\(a, _) -> (a, s)) m