content: -- Copyright (c) 2015-2017 Rudy Matela.
  -- Distributed under the 3-Clause BSD licence (see the file LICENSE).
  {-# LANGUAGE NoMonomorphismRestriction #-}
  import System.Exit (exitFailure)
  import System.Environment (getArgs)
  import Data.List (elemIndices, sort)
  import Data.Tuple (swap)
  
  import Test.FitSpec
  import Test.FitSpec.ShowMutable
  import Test.FitSpec.PrettyPrint
  import Test.LeanCheck.Error (errorToNothing)
  import Test.LeanCheck.Utils.TypeBinding
  
  main :: IO ()
  main = do
    as <- System.Environment.getArgs
    let n = case as of []    -> 10
                       (s:_) -> read s
    -- n ==  10  --   1s on zero
    -- n ==  32  --   4s on zero
    -- n == 100  --  15s on zero
    -- n == 200  --  30s on zero
    case elemIndices False (tests n) of
      [] -> putStrLn "Tests passed!"
      is -> do putStrLn ("Failed tests:" ++ show is)
               exitFailure
  
  -- Below, some of the tests are marked as failing:
  -- They simply fail because there are too many values
  -- being tested (the showMutant function only approximates
  -- the printing of a mutant)
  -- There is a TODO in the other file related  to this
  -- to allow configuration of how many values should be
  -- tried when enumerating the mutants.
  tests n =
    [ True
  
    , holds n $ prop_0 -:> int
    , holds n $ prop_0 -:> bool
    , holds n $ prop_0 -:> char
    , holds n $ prop_0 -:> string
    , fails n $ prop_0 -:> (int,int)
  
    , holds n $ prop_00 -:> (int,int)
    , holds n $ prop_00 -:> (bool,int)
    , holds n $ prop_00 -:> (int,bool)
    , holds n $ prop_00 -:> (string,char)
    , holds n $ prop_00 -:> (char,string)
  
    , h1 $ id -:> int
    , h1 $ id -:> bool
    , h1 $ id -:> (int,int)
    , h1 $ id -:> (bool,int)
    , h1 $ id -:> (int,bool)
    , h1 $ id -:> (bool,bool)
    , h1 $ id -:> (int,int,int)
    , h1 $ id -:> (int,(int,int))
    , h1 $ id -:> ((int,int),int)
    , h1 $ const True     -:> int  -- fails (500 tests)!
    , h1 $ const (0::Int) -:> bool
    , h1 $ swap -:> (int,bool)
    , h1 $ swap -:> (bool,int)
    , h1 $ swap -:> (int,(int,int))
    , h1 $ swap -:> ((int,int),int)
  
    , h2 $ const -: int  >- int  >- und
    , h2 $ const -: int  >- bool >- und
    , h2 $ const -: bool >- int  >- und -- fails (1000 tests)!
    , h2 $ (+) -:> int
    , hI $ (+) -:> int
    , h2 $ (*) -:> int
    , h2 $ (&&)
    , h2 $ (||)
    , h2 $ (:) -:> int  -- fails (2000 tests)!
    , h2 $ (++) -:> [int]  -- fails (3000 tests)!
  
    , h11 (id -:> int)  (id ->: bool)
    , h11 (id -:> bool) (id ->: int)
    , h11 (swap -:> ((int,int),int)) (swap ->: (int,(int,int)))
  
    , h111 (id -:> int)  (id ->: bool) (id ->: char)
    , h111 (id -:> bool) (id ->: char) (id ->: int)
    , h111 (swap -:> ((int,int),(int,int)))
           (swap -:> ((int,int),int))
           (swap -:> (int,(int,int)))
  
    , h11' (id -:> int)  (id ->: bool) (id ->: char)
    , h11' (id -:> bool) (id ->: char) (id ->: int)
    , h11' (swap -:> ((int,int),(int,int)))
           (swap -:> ((int,int),int))
           (swap -:> (int,(int,int)))
    ]
    where h1 = holds n . prop_1
          h2 = holds n . prop_2
          hI = holds n . prop_I
          h11 f = holds n . prop_11 f
          h111 f g = holds n . prop_111 f g
          h11' f g = holds n . prop_11' f g
  
  -- prop_N, asserts the format of a mutation of a value of N arguments
  -- prop_MN, asserts the format of a pair of values of M and N arguments
  -- prop_MNO, asserts the format of a triple of values
  
  prop_0 :: (Eq a, Show a, Listable a, ShowMutable a)
          => a -> a -> Bool
  prop_0 x x' | x == x'   = s == "x"
              | otherwise = s == show x'
    where s = showMutantAsTuple ["x"] x x'
  
  prop_00 :: ( Eq a, Show a, Listable a, ShowMutable a
             , Eq b, Show b, Listable b, ShowMutable b )
          => (a,b) -> (a,b) -> Bool
  prop_00 (x,y) (x',y') | x == x' && y == y' = s == "(x,y)"
                        | x == x'            = s == "(x," ++ show y' ++ ")"
                        | y == y'            = s == "(" ++ show x' ++ ",y)"
                        | otherwise          = s == "(" ++ show x'
                                                 ++ "," ++ show y' ++ ")"
    where s = showMutantAsTuple ["x","y"] (x,y) (x',y')
  
  prop_1 :: ( Eq a, Show a, Listable a, ShowMutable a
            , Eq b, Show b, Listable b, ShowMutable b )
          => (a->b) -> a -> b -> Bool
  prop_1 f x fx = fx /= f x
             ==> showMutantAsTuple    ["f x"] f (mutate f x fx) == showMutantF "f" x fx
              && showMutantDefinition ["f x"] f (mutate f x fx) == showMutantB "f" x fx
  
  prop_11 :: ( Eq a, Show a, Listable a, ShowMutable a
             , Eq b, Show b, Listable b, ShowMutable b
             , Eq c, Show c, Listable c, ShowMutable c
             , Eq d, Show d, Listable d, ShowMutable d )
          => (a->b) -> (c->d) -> a -> b -> c -> d -> Bool
  prop_11 f g x fx y gy = fx /= f x && gy /= g y
                    ==> showMutantAsTuple    ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)
                     == showTuple [showMutantF "f" x fx, showMutantF "g" y gy]
                     && showMutantDefinition ["f x","g x"] (f,g) (mutate f x fx, mutate g y gy)
                     == concat    [showMutantB "f" x fx, showMutantB "g" y gy]
  
  prop_111 :: ( Eq a, Show a, Listable a, ShowMutable a
              , Eq b, Show b, Listable b, ShowMutable b
              , Eq c, Show c, Listable c, ShowMutable c
              , Eq d, Show d, Listable d, ShowMutable d
              , Eq e, Show e, Listable e, ShowMutable e
              , Eq f, Show f, Listable f, ShowMutable f )
           => (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool
  prop_111 f g h x fx y gy z hz = fx /= f x
                               && gy /= g y
                               && hz /= h z
                              ==> showMutantAsTuple ["f x","g x","h x"] (f,g,h)
                                                    ( mutate f x fx
                                                    , mutate g y gy
                                                    , mutate h z hz )
                               == showTuple [ showMutantF "f" x fx
                                            , showMutantF "g" y gy
                                            , showMutantF "h" z hz ]
                               && showMutantDefinition ["f x","g x","h x"] (f,g,h)
                                                       ( mutate f x fx
                                                       , mutate g y gy
                                                       , mutate h z hz )
                               == concat    [ showMutantB "f" x fx
                                            , showMutantB "g" y gy
                                            , showMutantB "h" z hz ]
  
  prop_11' :: ( Eq a, Show a, Listable a, ShowMutable a
              , Eq b, Show b, Listable b, ShowMutable b
              , Eq c, Show c, Listable c, ShowMutable c
              , Eq d, Show d, Listable d, ShowMutable d
              , Eq e, Show e, Listable e, ShowMutable e
              , Eq f, Show f, Listable f, ShowMutable f )
           => (a->b) -> (c->d) -> (e->f) -> a -> b -> c -> d -> e -> f -> Bool
  prop_11' f g h x fx y gy z hz = fx /= f x
                               && gy /= g y
                               && hz /= h z
                              ==> showMutantAsTuple ["f x","g x","h x"] (f,(g,h))
                                                    ( mutate f x fx
                                                    , ( mutate g y gy
                                                      , mutate h z hz ) )
                               == showTuple [ showMutantF "f" x fx
                                            , showTuple [ showMutantF "(??)" y gy
                                                        , showMutantF "(??)" z hz ] ]
                               && showMutantDefinition ["f x","g x","h x"] (f,(g,h))
                                                       ( mutate f x fx
                                                       , ( mutate g y gy
                                                         , mutate h z hz ) )
                               == concat [ showMutantB "f" x fx
                                         , "g' = "
                                  `beside` showTuple [ showMutantF "(??)" y gy
                                                     , showMutantF "(??)" z hz ] ]
  
  prop_2 :: ( Eq a, Show a, Listable a, ShowMutable a
            , Eq b, Show b, Listable b, ShowMutable b
            , Eq c, Show c, Listable c, ShowMutable c )
          => (a->b->c) -> a -> b -> c -> Bool
  prop_2 f x y fxy = fxy /= f x y ==>
    showMutantAsTuple    ["f x y"] f (mutate2 f x y fxy) == showMutantF2 "f" x y fxy &&
    showMutantDefinition ["f x y"] f (mutate2 f x y fxy) == showMutantB2 "f" x y fxy
  
  
  prop_I :: ( Eq a, Show a, Listable a, ShowMutable a
            , Eq b, Show b, Listable b, ShowMutable b
            , Eq c, Show c, Listable c, ShowMutable c )
          => (a->b->c) -> a -> b -> c -> Bool
  prop_I f x y fxy = fxy /= f x y ==>
    showMutantAsTuple    ["x + y"] f (mutate2 f x y fxy) == showMutantI  "+" x y fxy &&
    showMutantDefinition ["x + y"] f (mutate2 f x y fxy) == showMutantBI "+" x y fxy
  
  mutate :: Eq a => (a -> b) -> a -> b -> (a -> b)
  mutate f x y x' | x' == x   = y
                  | otherwise = f x'
  
  mutate2 :: (Eq a, Eq b) => (a -> b -> c) -> a -> b -> c -> (a -> b -> c)
  mutate2 f x y z = curry (mutate (uncurry f) (x,y) z)
  
  -- | Show a mutant of a function of one argument
  showMutantF :: (Show a, Show b)
              => String -> a -> b -> String
  showMutantF f x y = "\\x -> case x of\n"
                   ++ "        " ++ show x ++ " -> " ++ show y ++ "\n"
                   ++ "        _ -> " ++ f ++ " x\n"
  
  -- | Show a mutant of a function of two arguments
  showMutantF2 :: (Show a, Show b, Show c)
               => String -> a -> b -> c -> String
  showMutantF2 f x y z = "\\x y -> case (x,y) of\n"
                      ++ "          (" ++ show x ++ "," ++ show y ++ ") -> "
                                       ++ show z ++ "\n"
                      ++ "          _ -> " ++ f ++ " x y\n"
  
  showMutantB :: (Show a, Show b)
              => String -> a -> b -> String
  showMutantB f x fx = table " "
                    [ [f ++ "'", show x, "=", show fx]
                    , [f ++ "'", "x",    "=", f ++ " x"] ]
  
  showMutantB2 :: (Show a, Show b, Show c)
               => String -> a -> b -> c -> String
  showMutantB2 f x y fxy = table " "
                         [ [f ++ "'", show x, show y, "=", show fxy]
                         , [f ++ "'", "x",    "y",    "=", f ++ " x y"] ]
  
  -- | Show a mutant of an infix
  showMutantI :: (Show a, Show b, Show c)
              => String -> a -> b -> c -> String
  showMutantI o x y z = "\\x y -> case (x,y) of\n"
                     ++ "          (" ++ show x ++ "," ++ show y ++ ") -> "
                                      ++ show z ++ "\n"
                     ++ "          _ -> x " ++ o ++ " y\n"
  
  showMutantBI :: (Show a, Show b, Show c)
               => String -> a -> b -> c -> String
  showMutantBI o x y fxy = table " "
                         [ [show x, o ++ "-", show y, "=", show fxy]
                         , ["x",    o ++ "-", "y",    "=", "x " ++ o ++ " y"] ]
  