{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#endif

module Test.SmallCheck.Property.Result
  ( PropertySuccess(..)
  , PropertyFailure(..)
  , ppFailure
  , Reason
  , Argument
  ) where

import Data.Bool (Bool (False, True))
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Int (Int)
import Data.List (map)
import Data.Maybe (Maybe (Nothing, Just))
import Prelude (String)
import Text.PrettyPrint (Doc, empty, hsep, nest, render, text, (<+>), ($+$), ($$))
import Text.Show (Show)

-- | @since 1.0
type Argument = String

-- | An explanation for the test outcome.
--
-- @since 1.1
type Reason = String

-- | @since 1.0
data PropertySuccess
  = Exist [Argument] PropertySuccess
  | ExistUnique [Argument] PropertySuccess
  | PropertyTrue (Maybe Reason) -- ^ @since 1.1
  | Vacuously PropertyFailure
  deriving (PropertySuccess -> PropertySuccess -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertySuccess -> PropertySuccess -> Bool
$c/= :: PropertySuccess -> PropertySuccess -> Bool
== :: PropertySuccess -> PropertySuccess -> Bool
$c== :: PropertySuccess -> PropertySuccess -> Bool
Eq, Int -> PropertySuccess -> ShowS
[PropertySuccess] -> ShowS
PropertySuccess -> Argument
forall a.
(Int -> a -> ShowS) -> (a -> Argument) -> ([a] -> ShowS) -> Show a
showList :: [PropertySuccess] -> ShowS
$cshowList :: [PropertySuccess] -> ShowS
show :: PropertySuccess -> Argument
$cshow :: PropertySuccess -> Argument
showsPrec :: Int -> PropertySuccess -> ShowS
$cshowsPrec :: Int -> PropertySuccess -> ShowS
Show)

-- | @since 1.0
data PropertyFailure
  = NotExist
  | AtLeastTwo [Argument] PropertySuccess [Argument] PropertySuccess
  | CounterExample [Argument] PropertyFailure
  | PropertyFalse (Maybe Reason) -- ^ @since 1.1
  deriving (PropertyFailure -> PropertyFailure -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyFailure -> PropertyFailure -> Bool
$c/= :: PropertyFailure -> PropertyFailure -> Bool
== :: PropertyFailure -> PropertyFailure -> Bool
$c== :: PropertyFailure -> PropertyFailure -> Bool
Eq, Int -> PropertyFailure -> ShowS
[PropertyFailure] -> ShowS
PropertyFailure -> Argument
forall a.
(Int -> a -> ShowS) -> (a -> Argument) -> ([a] -> ShowS) -> Show a
showList :: [PropertyFailure] -> ShowS
$cshowList :: [PropertyFailure] -> ShowS
show :: PropertyFailure -> Argument
$cshow :: PropertyFailure -> Argument
showsPrec :: Int -> PropertyFailure -> ShowS
$cshowsPrec :: Int -> PropertyFailure -> ShowS
Show)

class Pretty a where
  pretty :: a -> Doc

instance Pretty PropertyFailure where
  pretty :: PropertyFailure -> Doc
pretty PropertyFailure
NotExist = Argument -> Doc
text Argument
"argument does not exist"
  pretty (AtLeastTwo [Argument]
args1 PropertySuccess
s1 [Argument]
args2 PropertySuccess
s2) =
    Argument -> Doc
text Argument
"there are at least two" Doc -> Doc -> Doc
<+>
    forall a b. [a] -> b -> b -> b
plural [Argument]
args1 Doc
empty (Argument -> Doc
text Argument
"sets of") Doc -> Doc -> Doc
<+>
    Argument -> Doc
text Argument
"arguments satisfying the property:" Doc -> Doc -> Doc
$$
      forall {a}. Pretty a => [Argument] -> a -> Doc
formatExample [Argument]
args1 PropertySuccess
s1 Doc -> Doc -> Doc
$$ forall {a}. Pretty a => [Argument] -> a -> Doc
formatExample [Argument]
args2 PropertySuccess
s2
    where
    formatExample :: [Argument] -> a -> Doc
formatExample [Argument]
args a
s = Int -> Doc -> Doc
nest Int
ind forall a b. (a -> b) -> a -> b
$ Argument -> Doc
text Argument
"for" Doc -> Doc -> Doc
<+> [Argument] -> Doc
prettyArgs [Argument]
args Doc -> Doc -> Doc
</> forall a. Pretty a => a -> Doc
pretty a
s
  pretty (CounterExample [Argument]
args PropertyFailure
f) =
    Argument -> Doc
text Argument
"there" Doc -> Doc -> Doc
<+>
    Argument -> Doc
text (forall a b. [a] -> b -> b -> b
plural [Argument]
args Argument
"exists" Argument
"exist") Doc -> Doc -> Doc
<+>
    [Argument] -> Doc
prettyArgs [Argument]
args Doc -> Doc -> Doc
<+>
    Argument -> Doc
text Argument
"such that"
    Doc -> Doc -> Doc
</> forall a. Pretty a => a -> Doc
pretty PropertyFailure
f
  pretty (PropertyFalse Maybe Argument
Nothing)  = Argument -> Doc
text Argument
"condition is false"
  pretty (PropertyFalse (Just Argument
s)) = Argument -> Doc
text Argument
s

instance Pretty PropertySuccess where
  pretty :: PropertySuccess -> Doc
pretty (PropertyTrue Maybe Argument
Nothing)  = Argument -> Doc
text Argument
"condition is true"
  pretty (PropertyTrue (Just Argument
s)) = Argument -> Doc
text Argument
s
  pretty (Exist       [Argument]
args PropertySuccess
s) = forall a. Pretty a => Bool -> [Argument] -> a -> Doc
existsMsg Bool
False [Argument]
args PropertySuccess
s
  pretty (ExistUnique [Argument]
args PropertySuccess
s) = forall a. Pretty a => Bool -> [Argument] -> a -> Doc
existsMsg Bool
True [Argument]
args PropertySuccess
s
  pretty (Vacuously PropertyFailure
s) = Argument -> Doc
text Argument
"property is vacuously true because" Doc -> Doc -> Doc
</> forall a. Pretty a => a -> Doc
pretty PropertyFailure
s

ind :: Int
ind :: Int
ind = Int
2

infixl 5 </>
(</>) :: Doc -> Doc -> Doc
Doc
a </> :: Doc -> Doc -> Doc
</> Doc
b = Doc
a Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
ind Doc
b

prettyArgs :: [Argument] -> Doc
prettyArgs :: [Argument] -> Doc
prettyArgs = [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Argument -> Doc
text

existsMsg :: Pretty a => Bool -> [Argument] -> a -> Doc
existsMsg :: forall a. Pretty a => Bool -> [Argument] -> a -> Doc
existsMsg Bool
unique [Argument]
args a
s =
  Argument -> Doc
text Argument
"there" Doc -> Doc -> Doc
<+> Argument -> Doc
text (forall a b. [a] -> b -> b -> b
plural [Argument]
args Argument
"exists" Argument
"exist") Doc -> Doc -> Doc
<+>
  (if Bool
unique then Argument -> Doc
text Argument
"unique" else Doc
empty) Doc -> Doc -> Doc
<+>
  [Argument] -> Doc
prettyArgs [Argument]
args Doc -> Doc -> Doc
<+>
  Argument -> Doc
text Argument
"such that" Doc -> Doc -> Doc
</>
  forall a. Pretty a => a -> Doc
pretty a
s

plural :: [a] -> b -> b -> b
plural :: forall a b. [a] -> b -> b -> b
plural [a]
lst b
sing b
pl =
  case [a]
lst of
    a
_:a
_:[a]
_ -> b
pl
    [a]
_ -> b
sing

-- | @since 1.0
ppFailure :: PropertyFailure -> String
ppFailure :: PropertyFailure -> Argument
ppFailure = Doc -> Argument
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty