fitspec-0.4.10: refining property sets for testing Haskell programs
Copyright(c) 2015-2018 Rudy Matela
License3-Clause BSD (see the file LICENSE)
MaintainerRudy Matela <rudy@matela.com.br>
Safe HaskellNone
LanguageHaskell2010

Test.FitSpec

Description

FitSpec: refining property-sets for functional testing

FitSpec provides automated assistance in the task of refining test properties for Haskell functions. FitSpec tests mutant variations of functions under test against a given property set, recording any surviving mutants that pass all tests. FitSpec then reports:

  • surviving mutants: indicating incompleteness of properties, prompting the user to amend a property or to add a new one;
  • conjectures: indicating redundancy in the property set, prompting the user to remove properties so to reduce the cost of testing.

Example, refining a sort specification:

import Test.FitSpec
import Data.List (sort)

properties sort =
  [ property $ \xs   -> ordered (sort xs)
  , property $ \xs   -> length (sort xs) == length xs
  , property $ \x xs -> elem x (sort xs) == elem x xs
  , property $ \x xs -> notElem x (sort xs) == notElem x xs
  , property $ \x xs -> minimum (x:xs) == head (sort (x:xs))
  ]
  where
  ordered (x:y:xs) = x <= y && ordered (y:xs)
  ordered _        = True

main = mainWith args { names = ["sort xs"]
                     , nMutants = 4000
                     , nTests   = 4000
                     , timeout  = 0
                     }
                (sort::[Word2]->[Word2])
                properties

The above program reports the following:

Apparent incomplete and non-minimal specification based on
4000 test cases for each of properties 1, 2, 3, 4 and 5
for each of 4000 mutant variations.

3 survivors (99% killed), smallest:
  \xs -> case xs of
           [0,0,1] -> [0,1,1]
           _ -> sort xs

apparent minimal property subsets:  {1,2,3} {1,2,4}
conjectures:  {3}    =  {4}     96% killed (weak)
              {1,3} ==> {5}     98% killed (weak)
Synopsis

Encoding properties

type Property = [([String], Bool)] Source #

An encoded representation of a property suitable for use by FitSpec.

Each list of strings is a printable representation of one possible choice of argument values for the property. Each boolean indicate whether the property holds for this choice.

property :: Testable a => a -> Property Source #

Given a Testable type (as defined by Test.LeanCheck), returns a Property.

This function should be used on every property to create a property list to be passed to report, reportWith, mainDefault or mainWith.

property $ \x y -> x + y < y + (x::Int)

Configuring reports

data Args Source #

Extra arguments / configuration for reportWith. See args for default values.

Constructors

Args 

Fields

Instances

Instances details
Data Args Source # 
Instance details

Defined in Test.FitSpec.Main

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Args -> c Args #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Args #

toConstr :: Args -> Constr #

dataTypeOf :: Args -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Args) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Args) #

gmapT :: (forall b. Data b => b -> b) -> Args -> Args #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Args -> r #

gmapQ :: (forall d. Data d => d -> u) -> Args -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Args -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Args -> m Args #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Args -> m Args #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Args -> m Args #

data ShowMutantAs Source #

How to show mutants. Use this to fill showMutantAs.

Instances

Instances details
Data ShowMutantAs Source # 
Instance details

Defined in Test.FitSpec.Main

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ShowMutantAs -> c ShowMutantAs #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ShowMutantAs #

toConstr :: ShowMutantAs -> Constr #

dataTypeOf :: ShowMutantAs -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ShowMutantAs) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShowMutantAs) #

gmapT :: (forall b. Data b => b -> b) -> ShowMutantAs -> ShowMutantAs #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ShowMutantAs -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ShowMutantAs -> r #

gmapQ :: (forall d. Data d => d -> u) -> ShowMutantAs -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ShowMutantAs -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ShowMutantAs -> m ShowMutantAs #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ShowMutantAs -> m ShowMutantAs #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ShowMutantAs -> m ShowMutantAs #

args :: Args Source #

Default arguments for reportWith:

  • nMutants = 500, start with 500 mutants
  • nTests = 1000, start with 1000 test values
  • timeout = 5, keep incresing the number of mutants until 5 seconds elapse
  • names = [], default function call template:
["f x y z", "g x y z", "h x y z", ...]

fixargs :: Int -> Int -> Args Source #

Non timed-out default arguments. Make conjectures based on a fixed number of mutants and tests, e.g.:

reportWith (fixargs 100 200) f pmap

This is just a shorthand, see:

fixargs nm nt  =  args { nMutants = nm, nTests = nt, timeout = 0 }
(fixargs nm nt) { nMutants = 500, nTests = 1000, timeout = 5 }  =  args

Reporting results

report :: (Mutable a, ShowMutable a) => a -> (a -> [Property]) -> IO () Source #

Report results generated by FitSpec. Uses standard configuration (see args). Needs a function to be mutated and a property map. Example (specification of boolean negation):

properties not =
  [ property $ \p -> not (not p) == p
  , property $ \p -> not (not (not p)) == not p
  ]

main = report not properties

reportWith :: (Mutable a, ShowMutable a) => Args -> a -> (a -> [Property]) -> IO () Source #

Same as report but can be configured via Args (args or fixargs), e.g.:

reportWith args { timeout = 10 } fun properties

reportWithExtra :: (Mutable a, ShowMutable a) => [a] -> Args -> a -> (a -> [Property]) -> IO () Source #

Same as reportWith, but accepts a list of manually defined (extra) mutants to be tested alongside those automatically generated.

Parsing command line arguments

mainWith :: (Mutable a, ShowMutable a) => Args -> a -> (a -> [Property]) -> IO () Source #

Same as reportWith, but allow overriding of configuration via command line arguments.

defaultMain :: (Mutable a, ShowMutable a) => a -> (a -> [Property]) -> IO () Source #

Same as report, but allow configuration via command line arguments.

Mutable types

class Mutable a where Source #

This typeclass is similar to Listable.

A type is Mutable when there exists a function that is able to list mutations of a value. Ideally: list all possible values without repetitions.

Instances are usually defined by a mutiers function that given a value, returns tiers of mutants of that value: the first tier contains the equivalent mutant, of size 0, the second tier contains mutants of size 1, the third tier contains mutants of size 2, and so on.

The equivalent mutant is the actual function without mutations.

The size of a mutant is given by the sum of: the number of mutated points (relations) and the sizes of mutated arguments and results.

To get only inequivalent mutants, just take the tail of either mutants or mutiers:

tail mutants
tail mutiers

Given that the underlying Listable enumeration has no repetitions, parametric instances defined in this file will have no repeated mutants.

Minimal complete definition

mutants | mutiers

Methods

mutiers :: a -> [[a]] Source #

mutants :: a -> [a] Source #

Instances

Instances details
Mutable Bool Source #
mutants True = [True,False]
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Bool -> [[Bool]] Source #

mutants :: Bool -> [Bool] Source #

Mutable Char Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Char -> [[Char]] Source #

mutants :: Char -> [Char] Source #

Mutable Double Source # 
Instance details

Defined in Test.FitSpec.Mutable

Mutable Float Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Float -> [[Float]] Source #

mutants :: Float -> [Float] Source #

Mutable Int Source #
mutants 3 = [3,0,1,2,4,5,6,7,8,...]
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Int -> [[Int]] Source #

mutants :: Int -> [Int] Source #

Mutable Integer Source # 
Instance details

Defined in Test.FitSpec.Mutable

Mutable Ordering Source # 
Instance details

Defined in Test.FitSpec.Mutable

Mutable Word Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Word -> [[Word]] Source #

mutants :: Word -> [Word] Source #

Mutable () Source #
mutants () = [()]
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: () -> [[()]] Source #

mutants :: () -> [()] Source #

Mutable Int1 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Int1 -> [[Int1]] Source #

mutants :: Int1 -> [Int1] Source #

Mutable Int2 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Int2 -> [[Int2]] Source #

mutants :: Int2 -> [Int2] Source #

Mutable Int3 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Int3 -> [[Int3]] Source #

mutants :: Int3 -> [Int3] Source #

Mutable Int4 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Int4 -> [[Int4]] Source #

mutants :: Int4 -> [Int4] Source #

Mutable Word1 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Word1 -> [[Word1]] Source #

mutants :: Word1 -> [Word1] Source #

Mutable Word2 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Word2 -> [[Word2]] Source #

mutants :: Word2 -> [Word2] Source #

Mutable Word3 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Word3 -> [[Word3]] Source #

mutants :: Word3 -> [Word3] Source #

Mutable Word4 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Word4 -> [[Word4]] Source #

mutants :: Word4 -> [Word4] Source #

Mutable Nat Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutiers :: Nat -> [[Nat]] Source #

mutants :: Nat -> [Nat] Source #

(Eq a, Listable a) => Mutable [a] Source #
mutants [0] = [ [0], [], [0,0], [1], ...
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: [a] -> [[[a]]] Source #

mutants :: [a] -> [[a]] Source #

(Eq a, Listable a) => Mutable (Maybe a) Source #
mutants (Just 0) = [Just 0, Nothing, ...
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Maybe a -> [[Maybe a]] Source #

mutants :: Maybe a -> [Maybe a] Source #

(Eq a, Listable a, Integral a) => Mutable (Ratio a) Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Ratio a -> [[Ratio a]] Source #

mutants :: Ratio a -> [Ratio a] Source #

(Eq a, Listable a, Mutable b) => Mutable (a -> b) Source #
mutants not =
  [ not
  , \p -> case p of False -> False; _ -> not p
  , \p -> case p of True  -> True;  _ -> not p
  , \p -> case p of False -> False; True -> True
  ]
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: (a -> b) -> [[a -> b]] Source #

mutants :: (a -> b) -> [a -> b] Source #

(Eq a, Listable a, Eq b, Listable b) => Mutable (Either a b) Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: Either a b -> [[Either a b]] Source #

mutants :: Either a b -> [Either a b] Source #

(Mutable a, Mutable b) => Mutable (a, b) Source #
mutants (0,1) = [(0,1),(0,0),(1,1),(0,-1),...]
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: (a, b) -> [[(a, b)]] Source #

mutants :: (a, b) -> [(a, b)] Source #

(Mutable a, Mutable b, Mutable c) => Mutable (a, b, c) Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: (a, b, c) -> [[(a, b, c)]] Source #

mutants :: (a, b, c) -> [(a, b, c)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d) => Mutable (a, b, c, d) Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: (a, b, c, d) -> [[(a, b, c, d)]] Source #

mutants :: (a, b, c, d) -> [(a, b, c, d)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e) => Mutable (a, b, c, d, e) Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: (a, b, c, d, e) -> [[(a, b, c, d, e)]] Source #

mutants :: (a, b, c, d, e) -> [(a, b, c, d, e)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f) => Mutable (a, b, c, d, e, f) Source # 
Instance details

Defined in Test.FitSpec.Mutable

Methods

mutiers :: (a, b, c, d, e, f) -> [[(a, b, c, d, e, f)]] Source #

mutants :: (a, b, c, d, e, f) -> [(a, b, c, d, e, f)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f, Mutable g) => Mutable (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Test.FitSpec.Mutable.Tuples

Methods

mutiers :: (a, b, c, d, e, f, g) -> [[(a, b, c, d, e, f, g)]] Source #

mutants :: (a, b, c, d, e, f, g) -> [(a, b, c, d, e, f, g)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f, Mutable g, Mutable h) => Mutable (a, b, c, d, e, f, g, h) Source # 
Instance details

Defined in Test.FitSpec.Mutable.Tuples

Methods

mutiers :: (a, b, c, d, e, f, g, h) -> [[(a, b, c, d, e, f, g, h)]] Source #

mutants :: (a, b, c, d, e, f, g, h) -> [(a, b, c, d, e, f, g, h)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f, Mutable g, Mutable h, Mutable i) => Mutable (a, b, c, d, e, f, g, h, i) Source # 
Instance details

Defined in Test.FitSpec.Mutable.Tuples

Methods

mutiers :: (a, b, c, d, e, f, g, h, i) -> [[(a, b, c, d, e, f, g, h, i)]] Source #

mutants :: (a, b, c, d, e, f, g, h, i) -> [(a, b, c, d, e, f, g, h, i)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f, Mutable g, Mutable h, Mutable i, Mutable j) => Mutable (a, b, c, d, e, f, g, h, i, j) Source # 
Instance details

Defined in Test.FitSpec.Mutable.Tuples

Methods

mutiers :: (a, b, c, d, e, f, g, h, i, j) -> [[(a, b, c, d, e, f, g, h, i, j)]] Source #

mutants :: (a, b, c, d, e, f, g, h, i, j) -> [(a, b, c, d, e, f, g, h, i, j)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f, Mutable g, Mutable h, Mutable i, Mutable j, Mutable k) => Mutable (a, b, c, d, e, f, g, h, i, j, k) Source # 
Instance details

Defined in Test.FitSpec.Mutable.Tuples

Methods

mutiers :: (a, b, c, d, e, f, g, h, i, j, k) -> [[(a, b, c, d, e, f, g, h, i, j, k)]] Source #

mutants :: (a, b, c, d, e, f, g, h, i, j, k) -> [(a, b, c, d, e, f, g, h, i, j, k)] Source #

(Mutable a, Mutable b, Mutable c, Mutable d, Mutable e, Mutable f, Mutable g, Mutable h, Mutable i, Mutable j, Mutable k, Mutable l) => Mutable (a, b, c, d, e, f, g, h, i, j, k, l) Source # 
Instance details

Defined in Test.FitSpec.Mutable.Tuples

Methods

mutiers :: (a, b, c, d, e, f, g, h, i, j, k, l) -> [[(a, b, c, d, e, f, g, h, i, j, k, l)]] Source #

mutants :: (a, b, c, d, e, f, g, h, i, j, k, l) -> [(a, b, c, d, e, f, g, h, i, j, k, l)] Source #

mutiersEq :: (Listable a, Eq a) => a -> [[a]] Source #

Implementation of mutiers for non-functional data types. Use this to create instances for user-defined data types, e.g.:

instance MyData
  where mutiers = mutiersEq

and for parametric datatypes:

instance (Eq a, Eq b) => MyDt a b
  where mutiers = mutiersEq

Examples:

mutiersEq True = [[True], [False]]
mutiersEq 2   = [[2], [0], [1], [], [3], [4], [5], [6], [7], [8], [9], ...]
mutiersEq [1] = [[[1]], [[]], [[0]], [[0,0]], [[0,0,0],[0,1],[1,0],[-1]], ...]

class ShowMutable a where Source #

Types that can have their mutation shown. Has only one function mutantS that returns a simple AST (MutantS) representing the mutant. A standard implementation of mutantS for Eq types is given by mutantSEq.

Methods

mutantS :: a -> a -> MutantS Source #

Instances

Instances details
ShowMutable Bool Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Bool -> Bool -> MutantS Source #

ShowMutable Char Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Char -> Char -> MutantS Source #

ShowMutable Double Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

ShowMutable Float Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Float -> Float -> MutantS Source #

ShowMutable Int Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Int -> Int -> MutantS Source #

ShowMutable Integer Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

ShowMutable Ordering Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

ShowMutable Word Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Word -> Word -> MutantS Source #

ShowMutable () Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: () -> () -> MutantS Source #

ShowMutable Int1 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Int1 -> Int1 -> MutantS Source #

ShowMutable Int2 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Int2 -> Int2 -> MutantS Source #

ShowMutable Int3 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Int3 -> Int3 -> MutantS Source #

ShowMutable Int4 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Int4 -> Int4 -> MutantS Source #

ShowMutable Word1 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Word1 -> Word1 -> MutantS Source #

ShowMutable Word2 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Word2 -> Word2 -> MutantS Source #

ShowMutable Word3 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Word3 -> Word3 -> MutantS Source #

ShowMutable Word4 Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Word4 -> Word4 -> MutantS Source #

ShowMutable Nat Source # 
Instance details

Defined in Test.FitSpec.TestTypes

Methods

mutantS :: Nat -> Nat -> MutantS Source #

(Eq a, Show a) => ShowMutable [a] Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: [a] -> [a] -> MutantS Source #

(Eq a, Show a) => ShowMutable (Maybe a) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Maybe a -> Maybe a -> MutantS Source #

(Eq a, Show a, Integral a) => ShowMutable (Ratio a) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Ratio a -> Ratio a -> MutantS Source #

(Listable a, Show a, ShowMutable b) => ShowMutable (a -> b) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: (a -> b) -> (a -> b) -> MutantS Source #

(Eq a, Show a, Eq b, Show b) => ShowMutable (Either a b) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: Either a b -> Either a b -> MutantS Source #

(ShowMutable a, ShowMutable b) => ShowMutable (a, b) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: (a, b) -> (a, b) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c) => ShowMutable (a, b, c) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: (a, b, c) -> (a, b, c) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d) => ShowMutable (a, b, c, d) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: (a, b, c, d) -> (a, b, c, d) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e) => ShowMutable (a, b, c, d, e) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: (a, b, c, d, e) -> (a, b, c, d, e) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f) => ShowMutable (a, b, c, d, e, f) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable

Methods

mutantS :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f, ShowMutable g) => ShowMutable (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable.Tuples

Methods

mutantS :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f, ShowMutable g, ShowMutable h) => ShowMutable (a, b, c, d, e, f, g, h) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable.Tuples

Methods

mutantS :: (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f, ShowMutable g, ShowMutable h, ShowMutable i) => ShowMutable (a, b, c, d, e, f, g, h, i) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable.Tuples

Methods

mutantS :: (a, b, c, d, e, f, g, h, i) -> (a, b, c, d, e, f, g, h, i) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f, ShowMutable g, ShowMutable h, ShowMutable i, ShowMutable j) => ShowMutable (a, b, c, d, e, f, h, g, i, j) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable.Tuples

Methods

mutantS :: (a, b, c, d, e, f, h, g, i, j) -> (a, b, c, d, e, f, h, g, i, j) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f, ShowMutable g, ShowMutable h, ShowMutable i, ShowMutable j, ShowMutable k) => ShowMutable (a, b, c, d, e, f, g, h, i, j, k) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable.Tuples

Methods

mutantS :: (a, b, c, d, e, f, g, h, i, j, k) -> (a, b, c, d, e, f, g, h, i, j, k) -> MutantS Source #

(ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f, ShowMutable g, ShowMutable h, ShowMutable i, ShowMutable j, ShowMutable k, ShowMutable l) => ShowMutable (a, b, c, d, e, f, g, h, i, j, k, l) Source # 
Instance details

Defined in Test.FitSpec.ShowMutable.Tuples

Methods

mutantS :: (a, b, c, d, e, f, g, h, i, j, k, l) -> (a, b, c, d, e, f, g, h, i, j, k, l) -> MutantS Source #

mutantSEq :: (Eq a, Show a) => a -> a -> MutantS Source #

For a given type Type instance of Eq and Show, define the ShowMutable instance as:

instance ShowMutable Type
  where mutantS = mutantSEq

showMutantAsTuple :: ShowMutable a => [String] -> a -> a -> String Source #

Show a Mutant as a tuple of lambdas.

> putStrLn $ showMutantAsTuple ["p && q","not p"] ((&&),not) ((||),id)
( \p q -> case (p,q) of
           (False,False) -> True
           _ -> p && q
, \p -> case p of
          False -> False
          True -> True
          _ -> not p )

Can be easily copy pasted into an interactive session for manipulation. On GHCi, use :{ and :} to allow multi-line expressions and definitions.

showMutantDefinition :: ShowMutable a => [String] -> a -> a -> String Source #

Show a Mutant as a new complete top-level definition, with a prime appended to the name of the mutant.

> putStrLn $ showMutantDefinition ["p && q","not p"] ((&&),not) ((==),id)
False &&- False = True
p     &&- q     = p && q
not' False = False
not' True  = True
not' p     = not p

showMutantNested :: ShowMutable a => [String] -> a -> a -> String Source #

Show a Mutant as a tuple of nested lambdas. Very similar to showMutantAsTuple, but the underlying data structure is not flatten: so the output is as close as possible to the underlying representation.

showMutantBindings :: ShowMutable a => [String] -> a -> a -> String Source #

Show a Mutant as the list of bindings that differ from the original function(s).

> putStrLn $ showMutantBindings ["p && q","not p"] ((&&),not) ((==),id)
False && False = True
not False = False
not True  = True

Can possibly be copied into the source of the original function for manipulation.

Automatic derivation

deriveMutable :: Name -> DecsQ Source #

Derives Mutable, ShowMutable and (optionally) Listable instances for a given type Name.

Consider the following Stack datatype:

data Stack a = Stack a (Stack a) | Empty

Writing

deriveMutable ''Stack

will automatically derive the following Listable, Mutable and ShowMutable instances:

instance Listable a => Listable (Stack a) where
  tiers = cons2 Stack \/ cons0 Empty

instance (Eq a, Listable a) => Mutable a
  where mutiers = mutiersEq

instance (Eq a, Show a) => ShowMutable a
  where mutantS = mutantSEq

If a Listable instance already exists, it is not derived. (cf.: deriveListable)

Needs the TemplateHaskell extension.

deriveMutableE :: [Name] -> Name -> DecsQ Source #

Derives a Mutable instance for a given type Name using a given context for all type variables.

Re-export modules