-- | -- Module : Test.FitSpec.ShowMutable -- Copyright : (c) 2015-2017 Rudy Matela -- License : 3-Clause BSD (see the file LICENSE) -- Maintainer : Rudy Matela <rudy@matela.com.br> -- -- Exports a typeclass to show mutant variations. module Test.FitSpec.ShowMutable ( ShowMutable (..) , mutantSEq , showMutantAsTuple , showMutantNested , showMutantDefinition , showMutantBindings , MutantS () , mutantSTuple ) where import Test.FitSpec.PrettyPrint import Test.LeanCheck.Error (errorToNothing, Listable(..)) import Data.Maybe (mapMaybe,isNothing) import Control.Monad (join) import Data.List (intercalate,tails) import Data.Char (isLetter) import Data.Ratio (Ratio) import Data.Word (Word) -- for GHC <= 7.10 -- | 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. showMutantAsTuple :: ShowMutable a => [String] -> a -> a -> String showMutantAsTuple :: [String] -> a -> a -> String showMutantAsTuple [String] names a f a f' = [String] -> MutantS -> String showMutantSAsTuple [String] names (MutantS -> String) -> MutantS -> String forall a b. (a -> b) -> a -> b $ MutantS -> MutantS flatten (MutantS -> MutantS) -> MutantS -> MutantS forall a b. (a -> b) -> a -> b $ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' -- | 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. showMutantBindings :: ShowMutable a => [String] -> a -> a -> String showMutantBindings :: [String] -> a -> a -> String showMutantBindings [String] names a f a f' = Bool -> [String] -> MutantS -> String showMutantSBindings Bool False [String] names (MutantS -> String) -> MutantS -> String forall a b. (a -> b) -> a -> b $ MutantS -> MutantS flatten (MutantS -> MutantS) -> MutantS -> MutantS forall a b. (a -> b) -> a -> b $ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' -- | 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 showMutantDefinition :: ShowMutable a => [String] -> a -> a -> String showMutantDefinition :: [String] -> a -> a -> String showMutantDefinition [String] names a f a f' = Bool -> [String] -> MutantS -> String showMutantSBindings Bool True [String] names (MutantS -> String) -> MutantS -> String forall a b. (a -> b) -> a -> b $ MutantS -> MutantS flatten (MutantS -> MutantS) -> MutantS -> MutantS forall a b. (a -> b) -> a -> b $ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' -- | 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. showMutantNested :: ShowMutable a => [String] -> a -> a -> String showMutantNested :: [String] -> a -> a -> String showMutantNested [String] names a f a f' = [String] -> MutantS -> String showMutantSAsTuple [String] names (MutantS -> String) -> MutantS -> String forall a b. (a -> b) -> a -> b $ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' -- | Show a Mutant without providing a default name. -- An alias for @showMutantAsTuple []@. showMutant :: ShowMutable a => a -> a -> String showMutant :: a -> a -> String showMutant = [String] -> a -> a -> String forall a. ShowMutable a => [String] -> a -> a -> String showMutantAsTuple [] -- | Default function names (when none given): -- -- > f g h f' g' h' f'' g'' h'' defaultFunctionNames :: [String] defaultFunctionNames :: [String] defaultFunctionNames = [String "f",String "g",String "h"] [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ (String -> String) -> [String] -> [String] forall a b. (a -> b) -> [a] -> [b] map (String -> String -> String forall a. [a] -> [a] -> [a] ++String "'") [String] defaultFunctionNames -- | Default names in a call (function and variables): -- -- > f x y z w x' y' z' w' x'' y'' z'' w'' ... defaultNames :: [String] defaultNames :: [String] defaultNames = [String] -> String forall a. [a] -> a head [String] defaultFunctionNames String -> [String] -> [String] forall a. a -> [a] -> [a] : [String] defVarNames where defVarNames :: [String] defVarNames = [String "x",String "y",String "z",String "w"] [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ (String -> String) -> [String] -> [String] forall a b. (a -> b) -> [a] -> [b] map (String -> String -> String forall a. [a] -> [a] -> [a] ++String "'") [String] defVarNames -- | 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'. class ShowMutable a where mutantS :: a -> a -> MutantS -- | For a given type @Type@ instance of @Eq@ and @Show@, -- define the 'ShowMutable' instance as: -- -- > instance ShowMutable Type -- > where mutantS = mutantSEq mutantSEq :: (Eq a, Show a) => a -> a -> MutantS mutantSEq :: a -> a -> MutantS mutantSEq a x a x' = if a x a -> a -> Bool forall a. Eq a => a -> a -> Bool == a x' then String -> MutantS Unmutated (String -> MutantS) -> String -> MutantS forall a b. (a -> b) -> a -> b $ a -> String forall a. Show a => a -> String show a x else String -> MutantS Atom (String -> MutantS) -> String -> MutantS forall a b. (a -> b) -> a -> b $ a -> String forall a. Show a => a -> String show a x' instance ShowMutable () where mutantS :: () -> () -> MutantS mutantS = () -> () -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Int where mutantS :: Int -> Int -> MutantS mutantS = Int -> Int -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Integer where mutantS :: Integer -> Integer -> MutantS mutantS = Integer -> Integer -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Char where mutantS :: Char -> Char -> MutantS mutantS = Char -> Char -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Bool where mutantS :: Bool -> Bool -> MutantS mutantS = Bool -> Bool -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance (Eq a, Show a) => ShowMutable [a] where mutantS :: [a] -> [a] -> MutantS mutantS = [a] -> [a] -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance (Eq a, Show a) => ShowMutable (Maybe a) where mutantS :: Maybe a -> Maybe a -> MutantS mutantS = Maybe a -> Maybe a -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance (Eq a, Show a, Eq b, Show b) => ShowMutable (Either a b) where mutantS :: Either a b -> Either a b -> MutantS mutantS = Either a b -> Either a b -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance (Eq a, Show a, Integral a) => ShowMutable (Ratio a) where mutantS :: Ratio a -> Ratio a -> MutantS mutantS = Ratio a -> Ratio a -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Float where mutantS :: Float -> Float -> MutantS mutantS = Float -> Float -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Double where mutantS :: Double -> Double -> MutantS mutantS = Double -> Double -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Ordering where mutantS :: Ordering -> Ordering -> MutantS mutantS = Ordering -> Ordering -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance ShowMutable Word where mutantS :: Word -> Word -> MutantS mutantS = Word -> Word -> MutantS forall a. (Eq a, Show a) => a -> a -> MutantS mutantSEq instance (Listable a, Show a, ShowMutable b) => ShowMutable (a->b) where -- TODO: let the user provide how many values should be tried when printing mutantS :: (a -> b) -> (a -> b) -> MutantS mutantS a -> b f a -> b f' = [([String], MutantS)] -> MutantS Function ([([String], MutantS)] -> MutantS) -> ([a] -> [([String], MutantS)]) -> [a] -> MutantS forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [([String], MutantS)] -> [([String], MutantS)] forall a. Int -> [a] -> [a] take Int 10 ([([String], MutantS)] -> [([String], MutantS)]) -> ([a] -> [([String], MutantS)]) -> [a] -> [([String], MutantS)] forall b c a. (b -> c) -> (a -> b) -> a -> c . (([String], MutantS) -> Bool) -> [([String], MutantS)] -> [([String], MutantS)] forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not (Bool -> Bool) -> (([String], MutantS) -> Bool) -> ([String], MutantS) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . MutantS -> Bool isUnmutated (MutantS -> Bool) -> (([String], MutantS) -> MutantS) -> ([String], MutantS) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ([String], MutantS) -> MutantS forall a b. (a, b) -> b snd) ([([String], MutantS)] -> [([String], MutantS)]) -> ([a] -> [([String], MutantS)]) -> [a] -> [([String], MutantS)] forall b c a. (b -> c) -> (a -> b) -> a -> c . (a -> Maybe ([String], MutantS)) -> [a] -> [([String], MutantS)] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe a -> Maybe ([String], MutantS) bindingFor ([a] -> [([String], MutantS)]) -> ([a] -> [a]) -> [a] -> [([String], MutantS)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [a] -> [a] forall a. Int -> [a] -> [a] take Int 200 ([a] -> MutantS) -> [a] -> MutantS forall a b. (a -> b) -> a -> b $ [a] forall a. Listable a => [a] list where bindingFor :: a -> Maybe ([String], MutantS) bindingFor a x = (MutantS -> ([String], MutantS)) -> Maybe MutantS -> Maybe ([String], MutantS) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((,) [a -> String forall a. Show a => a -> String show a x]) (Maybe MutantS -> Maybe ([String], MutantS)) -> Maybe MutantS -> Maybe ([String], MutantS) forall a b. (a -> b) -> a -> b $ MutantS -> Maybe MutantS forall a. a -> Maybe a errorToNothing (b -> b -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS (a -> b f a x) (a -> b f' a x)) instance (ShowMutable a, ShowMutable b) => ShowMutable (a,b) where mutantS :: (a, b) -> (a, b) -> MutantS mutantS (a f,b g) (a f',b g') = [MutantS] -> MutantS Tuple [ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' , b -> b -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS b g b g' ] instance (ShowMutable a, ShowMutable b, ShowMutable c) => ShowMutable (a,b,c) where mutantS :: (a, b, c) -> (a, b, c) -> MutantS mutantS (a f,b g,c h) (a f',b g',c h') = [MutantS] -> MutantS Tuple [ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' , b -> b -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS b g b g' , c -> c -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS c h c h' ] -- | (Show) Structure of a mutant. -- This format is intended for processing then pretty-printing. data MutantS = Unmutated String | Atom String | Tuple [MutantS] | Function [([String],MutantS)] deriving Int -> MutantS -> String -> String [MutantS] -> String -> String MutantS -> String (Int -> MutantS -> String -> String) -> (MutantS -> String) -> ([MutantS] -> String -> String) -> Show MutantS forall a. (Int -> a -> String -> String) -> (a -> String) -> ([a] -> String -> String) -> Show a showList :: [MutantS] -> String -> String $cshowList :: [MutantS] -> String -> String show :: MutantS -> String $cshow :: MutantS -> String showsPrec :: Int -> MutantS -> String -> String $cshowsPrec :: Int -> MutantS -> String -> String Show -- | Check if a 'MutantS' is null isUnmutated :: MutantS -> Bool isUnmutated :: MutantS -> Bool isUnmutated (Unmutated String _) = Bool True isUnmutated (Tuple [MutantS] ms) = (MutantS -> Bool) -> [MutantS] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all MutantS -> Bool isUnmutated [MutantS] ms isUnmutated (Function [([String], MutantS)] bs) = (([String], MutantS) -> Bool) -> [([String], MutantS)] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (MutantS -> Bool isUnmutated (MutantS -> Bool) -> (([String], MutantS) -> MutantS) -> ([String], MutantS) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ([String], MutantS) -> MutantS forall a b. (a, b) -> b snd) [([String], MutantS)] bs isUnmutated MutantS _ = Bool False -- | Check if a 'MutantS' is a function. isFunction :: MutantS -> Bool isFunction :: MutantS -> Bool isFunction (Function [([String], MutantS)] _) = Bool True isFunction MutantS _ = Bool False -- Flatten a MutantS by merging nested 'Function's. flatten :: MutantS -> MutantS flatten :: MutantS -> MutantS flatten (Tuple [MutantS] ms) = [MutantS] -> MutantS Tuple ([MutantS] -> MutantS) -> [MutantS] -> MutantS forall a b. (a -> b) -> a -> b $ (MutantS -> MutantS) -> [MutantS] -> [MutantS] forall a b. (a -> b) -> [a] -> [b] map MutantS -> MutantS flatten [MutantS] ms flatten (Function [([],MutantS s)]) = MutantS -> MutantS flatten MutantS s flatten (Function (([],MutantS s):[([String], MutantS)] _)) = String -> MutantS forall a. HasCallStack => String -> a error String "flatten: ambiguous value" flatten (Function [([String], MutantS)] bs) = let bs' :: [([String], MutantS)] bs' = (([String], MutantS) -> ([String], MutantS)) -> [([String], MutantS)] -> [([String], MutantS)] forall a b. (a -> b) -> [a] -> [b] map ((MutantS -> MutantS) -> ([String], MutantS) -> ([String], MutantS) forall a b c. (a -> b) -> (c, a) -> (c, b) mapSnd MutantS -> MutantS flatten) [([String], MutantS)] bs in if (([String], MutantS) -> Bool) -> [([String], MutantS)] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (Bool -> Bool not (Bool -> Bool) -> (([String], MutantS) -> Bool) -> ([String], MutantS) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . MutantS -> Bool isFunction (MutantS -> Bool) -> (([String], MutantS) -> MutantS) -> ([String], MutantS) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . ([String], MutantS) -> MutantS forall a b. (a, b) -> b snd) [([String], MutantS)] bs' then [([String], MutantS)] -> MutantS Function [([String], MutantS)] bs' else [([String], MutantS)] -> MutantS Function ([([String], MutantS)] -> MutantS) -> [([String], MutantS)] -> MutantS forall a b. (a -> b) -> a -> b $ Int -> [([String], MutantS)] -> [([String], MutantS)] forall a. Int -> [a] -> [a] take Int 10 ([([String], MutantS)] -> [([String], MutantS)]) -> [([String], MutantS)] -> [([String], MutantS)] forall a b. (a -> b) -> a -> b $ (([String], MutantS) -> [([String], MutantS)]) -> [([String], MutantS)] -> [([String], MutantS)] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (\([String] as,Function [([String], MutantS)] bs'') -> (([String], MutantS) -> ([String], MutantS)) -> [([String], MutantS)] -> [([String], MutantS)] forall a b. (a -> b) -> [a] -> [b] map (([String] -> [String]) -> ([String], MutantS) -> ([String], MutantS) forall a b c. (a -> b) -> (a, c) -> (b, c) mapFst ([String] as[String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++)) [([String], MutantS)] bs'') [([String], MutantS)] bs' flatten MutantS m = MutantS m -- | Show a nameless mutant. -- Functions should not (but can) be shown using this. showMutantS :: MutantS -> String showMutantS :: MutantS -> String showMutantS (Unmutated String s) = String s showMutantS (Atom String s) = String s showMutantS (Tuple [MutantS] ms) = [String] -> String showTuple ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ (MutantS -> String) -> [MutantS] -> [String] forall a b. (a -> b) -> [a] -> [b] map MutantS -> String showMutantS [MutantS] ms showMutantS (Function [([String], MutantS)] bs) = [String] -> [([String], MutantS)] -> String showLambda [String "??"] [([String], MutantS)] bs -- | Show top-level (maybe tuple) named 'MutantS' as a tuple. showMutantSAsTuple :: [String] -> MutantS -> String showMutantSAsTuple :: [String] -> MutantS -> String showMutantSAsTuple [String] ns (Tuple [MutantS] ms) = [String] -> String showTuple ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ (String -> MutantS -> String) -> [String] -> [MutantS] -> [String] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith String -> MutantS -> String show1 ([String] ns [String] -> [String] -> [String] forall a. Eq a => [a] -> [a] -> [a] +- [String] defaultFunctionNames) [MutantS] ms where show1 :: String -> MutantS -> String show1 String n (Unmutated String _) = String n show1 String n (Function [([String], MutantS)] bs) = [String] -> [([String], MutantS)] -> String showLambda (String -> [String] fvnames String n) [([String], MutantS)] bs show1 String _ MutantS m = MutantS -> String showMutantS MutantS m showMutantSAsTuple [String] ns MutantS m = [String] -> MutantS -> String showMutantSAsTuple [String] ns ([MutantS] -> MutantS Tuple [MutantS m]) -- Show top-level (maybe tuple) named 'MutantS' as a bindings. -- In general, you want to 'flatten' the 'MutantS' before applying this -- function. showMutantSBindings :: Bool -> [String] -> MutantS -> String showMutantSBindings :: Bool -> [String] -> MutantS -> String showMutantSBindings Bool new [String] ns (Tuple [MutantS] ms) = ((String, MutantS) -> String) -> [(String, MutantS)] -> String forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap ((String -> MutantS -> String) -> (String, MutantS) -> String forall a b c. (a -> b -> c) -> (a, b) -> c uncurry String -> MutantS -> String show1) ([(String, MutantS)] -> String) -> [(String, MutantS)] -> String forall a b. (a -> b) -> a -> b $ [String] -> [MutantS] -> [(String, MutantS)] forall a b. [a] -> [b] -> [(a, b)] zip ([String] ns [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String] defaultFunctionNames) [MutantS] ms where show1 :: String -> MutantS -> String show1 String _ (Unmutated String s) = String "" show1 String _ (Function []) = String "" show1 String n (Function [([String], MutantS)] bs) = Bool -> [String] -> [([String], MutantS)] -> String showBindings Bool new (String -> [String] fvnames String n) [([String], MutantS)] bs show1 String n MutantS m = let fn :: String fn = [String] -> String forall a. [a] -> a head ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ String -> [String] fvnames String n fn' :: String fn' | Bool new = String -> String prime String fn | Bool otherwise = String fn in (String -> [String] -> String apply String fn' [] String -> String -> String forall a. [a] -> [a] -> [a] ++ String " = ") String -> String -> String `beside` MutantS -> String showMutantS MutantS m showMutantSBindings Bool new [String] ns MutantS m = Bool -> [String] -> MutantS -> String showMutantSBindings Bool new [String] ns ([MutantS] -> MutantS Tuple [MutantS m]) -- | Given a list with the function and variable names and a list of bindings, -- show a function as a case expression enclosed in a lambda. showLambda :: [String] -> [([String],MutantS)] -> String showLambda :: [String] -> [([String], MutantS)] -> String showLambda [] [] = String "undefined {- (err?) unmutated -}" showLambda (String n:[String] _) [] = String -> [String] -> String apply String n [] showLambda [String] _ [([],MutantS m)] = MutantS -> String showMutantS MutantS m showLambda [String] _ (([],MutantS _):[([String], MutantS)] _) = String "undefined {- (err?) ambiguous value -}" showLambda [String] ns [([String], MutantS)] bs = ((String "\\" String -> String -> String forall a. [a] -> [a] -> [a] ++ [String] -> String unwords [String] bound String -> String -> String forall a. [a] -> [a] -> [a] ++ String " -> ") String -> String -> String `beside`) (String -> String) -> String -> String forall a b. (a -> b) -> a -> b $ String "case " String -> String -> String forall a. [a] -> [a] -> [a] ++ [String] -> String showTuple [String] bound String -> String -> String forall a. [a] -> [a] -> [a] ++ String " of\n" String -> String -> String forall a. [a] -> [a] -> [a] ++ String " " String -> String -> String `beside` String cases where cases :: String cases = (([String], MutantS) -> String) -> [([String], MutantS)] -> String forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (\([String] as,MutantS r) -> ([String] -> String showTuple [String] as String -> String -> String forall a. [a] -> [a] -> [a] ++ String " -> ") String -> String -> String `beside` MutantS -> String showResult MutantS r) [([String], MutantS)] bs String -> String -> String forall a. [a] -> [a] -> [a] ++ String "_ -> " String -> String -> String forall a. [a] -> [a] -> [a] ++ String -> [String] -> String apply String fn [String] bound showResult :: MutantS -> String showResult (Function [([String], MutantS)] bs') = [String] -> [([String], MutantS)] -> String showLambda (String -> [String] -> String apply String fn [String] boundString -> [String] -> [String] forall a. a -> [a] -> [a] :[String] unbound) [([String], MutantS)] bs' showResult MutantS m = MutantS -> String showMutantS MutantS m unbound :: [String] unbound = Int -> [String] -> [String] forall a. Int -> [a] -> [a] drop ([String] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [String] bound) [String] vns bound :: [String] bound = (String -> String -> String) -> [String] -> [String] -> [String] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith String -> String -> String forall a b. a -> b -> a const [String] vns (([String], MutantS) -> [String] forall a b. (a, b) -> a fst (([String], MutantS) -> [String]) -> ([String], MutantS) -> [String] forall a b. (a -> b) -> a -> b $ [([String], MutantS)] -> ([String], MutantS) forall a. [a] -> a head [([String], MutantS)] bs) (String fn:[String] vns) = [String] ns [String] -> [String] -> [String] forall a. Eq a => [a] -> [a] -> [a] +- [String] defaultNames -- | Given a list with the function and variable names and a list of bindings, -- show function binding declarations. -- -- The 'new' boolean argument indicates whether if the function should be shown -- as a new definition. showBindings :: Bool -> [String] -> [([String],MutantS)] -> String showBindings :: Bool -> [String] -> [([String], MutantS)] -> String showBindings Bool new [String] ns [([String], MutantS)] bs = String -> [[String]] -> String table String " " ([[String]] -> String) -> [[String]] -> String forall a b. (a -> b) -> a -> b $ (([String] -> MutantS -> [String]) -> ([String], MutantS) -> [String] forall a b c. (a -> b -> c) -> (a, b) -> c uncurry [String] -> MutantS -> [String] showBind (([String], MutantS) -> [String]) -> [([String], MutantS)] -> [[String]] forall a b. (a -> b) -> [a] -> [b] `map` [([String], MutantS)] bs) [[String]] -> [[String]] -> [[String]] forall a. [a] -> [a] -> [a] ++ [String -> [String] words (String -> [String] -> String apply String fn' [String] bound) [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String "=", String -> [String] -> String apply String fn [String] bound] | Bool new] where showBind :: [String] -> MutantS -> [String] showBind [String a1,String a2] MutantS r | String -> Bool isInfix String fn' = [String a1, String fn', String a2, String "=", MutantS -> String showMutantS MutantS r] showBind [String] as MutantS r = [String fn'] [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String] as [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String "=", MutantS -> String showMutantS MutantS r] fn' :: String fn' | Bool new = String -> String prime String fn | Bool otherwise = String fn bound :: [String] bound = (String -> String -> String) -> [String] -> [String] -> [String] forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith String -> String -> String forall a b. a -> b -> a const [String] vns (([String], MutantS) -> [String] forall a b. (a, b) -> a fst (([String], MutantS) -> [String]) -> ([String], MutantS) -> [String] forall a b. (a -> b) -> a -> b $ [([String], MutantS)] -> ([String], MutantS) forall a. [a] -> a head [([String], MutantS)] bs) (String fn:[String] vns) = [String] ns [String] -> [String] -> [String] forall a. Eq a => [a] -> [a] -> [a] +- [String] defaultNames -- | Separate function from variable names in a simple Haskell expr. -- -- > fvarnames "f x y" == ["f","x","y"] -- > fvarnames "aa bb cc dd" == ["aa","bb","cc","dd"] -- -- When there are three lexemes, the function checks for a potential infix -- operator in the middle. -- -- > fvarnames "x + y" == ["(+)","x","y"] -- -- This function always returns a "head" -- -- > fvarnames "" == ["f"] fvnames :: String -> [String] fvnames :: String -> [String] fvnames = [String] -> [String] fvns' ([String] -> [String]) -> (String -> [String]) -> String -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> [String] words where fvns' :: [String] -> [String] fvns' :: [String] -> [String] fvns' [String a,String o,String b] | String -> Bool isInfix String o = String oString -> [String] -> [String] forall a. a -> [a] -> [a] :[String a,String b] fvns' [] = [String] defaultNames fvns' [String] fvs = [String] fvs -- | Apply a function ('String') to a list of variables ('[String]'). -- -- For the sake of clarity, in the following examples, double-quotes are omitted: -- > apply f == f -- > apply f x == f x -- > apply f x y == f x y -- > apply (+) == (+) -- > apply (+) x == (+) x -- > apply (+) x y == (+) x y -- > apply + == (+) -- > apply + x == (+) x -- > apply + x y == (x + y) -- > apply + x y z == (+) x y z apply :: String -> [String] -> String apply :: String -> [String] -> String apply String f [String x,String y] | String -> Bool isInfix String f = [String] -> String unwords [String x,String f,String y] apply String f [String] xs = if String -> Bool isInfix String f then [String] -> String unwords (String -> String toPrefix String fString -> [String] -> [String] forall a. a -> [a] -> [a] :[String] xs) else [String] -> String unwords (String fString -> [String] -> [String] forall a. a -> [a] -> [a] :[String] xs) -- | Check if a function / operator is infix -- -- > isInfix "foo" == False -- > isInfix "(+)" == False -- > isInfix "`foo`" == True -- > isInfix "+" == True isInfix :: String -> Bool isInfix :: String -> Bool isInfix (Char c:String cs) = Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool /= Char '(' Bool -> Bool -> Bool && Bool -> Bool not (Char -> Bool isLetter Char c) -- | Transform an infix operator into an infix function: -- -- > toPrefix "`foo`" == "foo" -- > toPrefix "+" == "(+)" toPrefix :: String -> String toPrefix :: String -> String toPrefix (Char '`':String cs) = String -> String forall a. [a] -> [a] init String cs toPrefix String cs = Char '('Char -> String -> String forall a. a -> [a] -> [a] :String cs String -> String -> String forall a. [a] -> [a] -> [a] ++ String ")" -- Primeify the name of a function by appending prime @'@ to functions and -- minus @-@ to operators. -- -- > prime "(+)" == "(+-)" -- > prime "foo" == "foo'" -- > prime "`foo`" == "`foo'`" -- > prime "*" == "*- prime :: String -> String prime :: String -> String prime (Char '`':String cs) = Char '`'Char -> String -> String forall a. a -> [a] -> [a] :String -> String forall a. [a] -> [a] init String cs String -> String -> String forall a. [a] -> [a] -> [a] ++ String "'`" -- `foo` to `foo'` prime (Char '(':String cs) = Char '('Char -> String -> String forall a. a -> [a] -> [a] :String -> String forall a. [a] -> [a] init String cs String -> String -> String forall a. [a] -> [a] -> [a] ++ String "-)" -- (+) to (+-) prime String cs | String -> Bool isInfix String cs = String cs String -> String -> String forall a. [a] -> [a] -> [a] ++ String "-" -- + to +- | Bool otherwise = String cs String -> String -> String forall a. [a] -> [a] -> [a] ++ String "'" -- foo to foo' mapFst :: (a->b) -> (a,c) -> (b,c) mapFst :: (a -> b) -> (a, c) -> (b, c) mapFst a -> b f (a x,c y) = (a -> b f a x,c y) mapSnd :: (a->b) -> (c,a) -> (c,b) mapSnd :: (a -> b) -> (c, a) -> (c, b) mapSnd a -> b f (c x,a y) = (c x,a -> b f a y) -- | @xs +- ys@ superimposes @xs@ over @ys@. -- -- [1,2,3] +- [0,0,0,0,0,0,0] == [1,2,3,0,0,0,0] -- [x,y,z] +- [a,b,c,d,e,f,g] == [x,y,z,d,e,f,g] -- "asdf" +- "this is a test" == "asdf is a test" (+-) :: Eq a => [a] -> [a] -> [a] [a] xs +- :: [a] -> [a] -> [a] +- [a] ys = [a] xs [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ Int -> [a] -> [a] forall a. Int -> [a] -> [a] drop ([a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] xs) [a] ys -- Instances of ShowMutable for up to 6-tuples are given here: instance (ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d) => ShowMutable (a,b,c,d) where mutantS :: (a, b, c, d) -> (a, b, c, d) -> MutantS mutantS (a f,b g,c h,d i) (a f',b g',c h',d i') = [MutantS] -> MutantS Tuple [ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' , b -> b -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS b g b g' , c -> c -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS c h c h' , d -> d -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS d i d i' ] instance (ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e) => ShowMutable (a,b,c,d,e) where mutantS :: (a, b, c, d, e) -> (a, b, c, d, e) -> MutantS mutantS (a f,b g,c h,d i,e j) (a f',b g',c h',d i',e j') = [MutantS] -> MutantS Tuple [ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' , b -> b -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS b g b g' , c -> c -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS c h c h' , d -> d -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS d i d i' , e -> e -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS e j e j' ] instance (ShowMutable a, ShowMutable b, ShowMutable c, ShowMutable d, ShowMutable e, ShowMutable f) => ShowMutable (a,b,c,d,e,f) where mutantS :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> MutantS mutantS (a f,b g,c h,d i,e j,f k) (a f',b g',c h',d i',e j',f k') = [MutantS] -> MutantS Tuple [ a -> a -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS a f a f' , b -> b -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS b g b g' , c -> c -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS c h c h' , d -> d -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS d i d i' , e -> e -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS e j e j' , f -> f -> MutantS forall a. ShowMutable a => a -> a -> MutantS mutantS f k f k' ] mutantSTuple :: [MutantS] -> MutantS mutantSTuple :: [MutantS] -> MutantS mutantSTuple = [MutantS] -> MutantS Tuple