-- |
-- Module      : Test.FitSpec.Report
-- Copyright   : (c) 2015-2017 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- Generate 'Test.FitSpec' reports.
module Test.FitSpec.Report
  ( report
  , reportWith
  , reportWithExtra
  , Args(..)
  , args
  , fixargs
  , Property
  , ShowMutantAs(..)
  )
where

import Data.List (intercalate, intersperse)
import Data.Maybe (fromMaybe)

import Test.FitSpec.Engine
import Test.FitSpec.Mutable
import Test.FitSpec.ShowMutable
import Test.FitSpec.Utils
import Test.FitSpec.PrettyPrint

-- | How to show mutants.  Use this to fill 'showMutantAs'.
data ShowMutantAs = Tuple      | NestedTuple
                  | Definition | Bindings

-- | Extra arguments / configuration for 'reportWith'.
--   See 'args' for default values.
data Args = Args
  { nMutants :: Int -- ^ (starting) number of function mutations
  , nTests   :: Int -- ^ (starting) number of test values (for each prop.)
  , timeout  :: Int -- ^ timeout in seconds, 0 for just 'nTests' * 'nMutants'
  , names    :: [String] -- ^ names of functions: @["foo x y","goo x y"]@

  -- advanced options:
  , verbose      :: Bool         -- ^ whether to show detailed results
  , showMutantAs :: ShowMutantAs -- ^ how to show mutants
  , rows         :: Maybe Int    -- ^ number of surviving mutants to show
  , extra        :: [String]     -- ^ ignored argument (user defined meaning)
  }

-- | 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", ...]
args :: Args
args = Args { nMutants     =  500
            , nTests       = 1000
            , timeout      = 5  -- seconds
            , names        = []
            , verbose      = False
            , showMutantAs = Tuple
            , rows         = Nothing
            , extra        = []
            }

-- | 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
fixargs :: Int -> Int -> Args
fixargs nm nt = args
  { nMutants = nm
  , nTests   = nt
  , timeout  = 0
  }

showMutant :: ShowMutable a => Args -> a -> a -> String
showMutant as = showMutantByType (showMutantAs as) (names as)
  where
    showMutantByType Tuple       = showMutantAsTuple
    showMutantByType NestedTuple = showMutantNested
    showMutantByType Definition  = showMutantDefinition
    showMutantByType Bindings    = showMutantBindings

-- | 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
report :: (Mutable a, ShowMutable a)
       => a -> (a -> [Property]) -> IO ()
report = reportWith args


-- | Same as 'report' but can be configured via 'Args' ('args' or 'fixargs'),
--   e.g.:
--
-- > reportWith args { timeout = 10 } fun properties
reportWith :: (Mutable a, ShowMutable a)
           => Args -> a -> (a -> [Property]) -> IO ()
reportWith = reportWithExtra []


-- | Same as 'reportWith', but accepts a list of manually defined (extra)
--   mutants to be tested alongside those automatically generated.
reportWithExtra :: (Mutable a, ShowMutable a)
                => [a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra extraMutants args f properties = do
  let nm = nMutants args
      nt = nTests args
  case propertiesCE nt (properties f) of
    Nothing -> reportWithExtra' extraMutants args f properties
    Just ce -> do
      putStrLn $ "ERROR: The original function-set does not follow property set for "
              ++ show nt ++ " tests"
      putStrLn $ "Counter-example to property " ++ ce
      putStrLn $ "Aborting."

-- | Same as 'reportWithExtra', does not abort if the original function does not
--   follow the property set.
reportWithExtra' :: (Mutable a, ShowMutable a)
                 => [a] -> Args -> a -> (a -> [Property]) -> IO ()
reportWithExtra' extraMutants args f properties = do
  results <- getResultsExtraTimeout (timeout args)
                                    extraMutants
                                    f properties
                                    (nMutants args) (nTests args)

  let nm = totalMutants $ head results
      nt = maxTests $ head results
      nts = propertiesNTests nt (properties f)
      tex = and $ propertiesTestsExhausted nt (properties f)
      mex = mutantsExhausted $ head results
      apparent | tex && mex = ""
               | otherwise  = "apparent "
  putStrLn . headToUpper $ apparent ++ qualifyCM results ++ " specification based on"
  putStrLn $ showNumberOfTestsAndMutants tex mex nts nm False

  let showR | verbose args = showDetailedResults
            | otherwise    = showResults
  putStrLn $ showR (rows args) (showMutant args f) results


showResults :: Maybe Int -> (a -> String)
            -> [Result a] -> String
showResults mlimit showMutant rs@(r:_) = completeness
                              ++ "\n" ++ minimality
  where
    showMutants ms = init . unlines $ map showMutant ms
    completeness = show (nSurvivors r) ++ " survivors ("
                ++ show (score r) ++ "% killed)"
                ++ case take (fromMaybe 1 mlimit) $ survivors r of
                     [] -> ".\n"
                     [m] -> ", smallest:\n"
                         ++ "  " `beside` showMutant m
                     ms  -> ", " ++ show (length ms) ++ " smallest:\n"
                         ++ "  " `beside` showMutants ms
    minimality = "apparent minimal property subsets:  "
              ++ (unwords . map showPropertySet $ sets r) ++ "\n"
              ++ case showConjectures False rs of
                   "" -> "No conjectures.\n"
                   cs -> "conjectures:  " `beside` cs


showDetailedResults :: Maybe Int -> (a -> String)
                    -> [Result a] -> String
showDetailedResults mlimit showMutant rs = completeness
                                ++ "\n" ++ minimality
  where
    completeness = table "   " . intersperse ["\n"]
                 . ([ "Property\n sets"
                    , "#Survivors\n (%Killed)"
                    , "Smallest or simplest\n surviving mutant"
                    ]:)
                 . map showResult
                 . maybe id take mlimit
                 $ rs
    showResult r = [ unwords . map showPropertySet $ sets r
                   , show  (nSurvivors r) ++ " (" ++ show (score r) ++ "%)"
                   , maybe "" showMutant $ smallestSurvivor r
                   ]
    minimality = case showConjectures True rs of
                   "" -> "No conjectures.\n"
                   cs -> "Conjectures:\n" ++ cs


showNumberOfTestsAndMutants :: Bool -> Bool -> [Int] -> Int -> Bool -> String
showNumberOfTestsAndMutants tex mex nts nm ssum = numTests ++ numMutants
  where
    mexS | mex = " (exhausted)"
         | otherwise = ""
    numMutants = "for each of " ++ showQuantity nm "mutant variation" ++ mexS ++ ".\n"
    numTests | ssum = showQuantity (sum nts) "test case"
                   ++ (if tex then " (exhausted)" else "")
                   ++ "\n"
             | otherwise = unlines
                         . (++ ["(test cases exhausted)" | tex])
                         . sortGroupAndCollapse fst snd testsForProps
                         $ zip nts [1..]
    testsForProps n ps = showQuantity n "test case"
                      ++ " for " ++ showEach "property" ps

showPropertySet :: Show i => [i] -> String
showPropertySet = (\s -> "{" ++ s ++ "}") . intercalate "," . map show


-- | Show conjectures derived from results
showConjectures :: Bool -> [Result a] -> String
showConjectures showVeryWeak = table " "
                             . map showConjecture
                             . filter (\r -> showVeryWeak
                                          || cnKilled r    /= 0
                                          && cnSurvivors r /= 0)
                             . conjectures

showConjecture :: Conjecture -> [String]
showConjecture Conjecture {isEq=eq, cleft=l, cright=r, cscore=s} =
  [ showPropertySet l
  , if eq then " = " else "==>"
  , showPropertySet r
  , "   "
  , show s ++ "% killed"
  , sMeaning
  ]
  where sMeaning | s < 1  || 99 < s = "(very weak)"
                 | s < 11 || 89 < s = "(weak)"
                 | s < 33 || 67 < s = "(mild)"
                 | otherwise        = "(strong)" -- the closer to 50 the better

qualifyCM :: Results a -> String
qualifyCM rs | c && m    = "complete and minimal"
             | c         = "complete but non-minimal"
             |      m    = "minimal but incomplete"
             | otherwise = "incomplete and non-minimal"
  where c = complete rs
        m = minimal rs