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

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

import Text.PrettyPrint (Doc, empty, hsep, nest, render, text, (<+>), ($+$), ($$))

type Argument = String

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

data PropertySuccess
  = Exist [Argument] PropertySuccess
  | ExistUnique [Argument] PropertySuccess
  | PropertyTrue (Maybe Reason)
  | Vacuously PropertyFailure
  deriving (PropertySuccess -> PropertySuccess -> Bool
(PropertySuccess -> PropertySuccess -> Bool)
-> (PropertySuccess -> PropertySuccess -> Bool)
-> Eq PropertySuccess
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 -> String
(Int -> PropertySuccess -> ShowS)
-> (PropertySuccess -> String)
-> ([PropertySuccess] -> ShowS)
-> Show PropertySuccess
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertySuccess] -> ShowS
$cshowList :: [PropertySuccess] -> ShowS
show :: PropertySuccess -> String
$cshow :: PropertySuccess -> String
showsPrec :: Int -> PropertySuccess -> ShowS
$cshowsPrec :: Int -> PropertySuccess -> ShowS
Show)

data PropertyFailure
  = NotExist
  | AtLeastTwo [Argument] PropertySuccess [Argument] PropertySuccess
  | CounterExample [Argument] PropertyFailure
  | PropertyFalse (Maybe Reason)
  deriving (PropertyFailure -> PropertyFailure -> Bool
(PropertyFailure -> PropertyFailure -> Bool)
-> (PropertyFailure -> PropertyFailure -> Bool)
-> Eq PropertyFailure
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 -> String
(Int -> PropertyFailure -> ShowS)
-> (PropertyFailure -> String)
-> ([PropertyFailure] -> ShowS)
-> Show PropertyFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyFailure] -> ShowS
$cshowList :: [PropertyFailure] -> ShowS
show :: PropertyFailure -> String
$cshow :: PropertyFailure -> String
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 = String -> Doc
text String
"argument does not exist"
  pretty (AtLeastTwo [String]
args1 PropertySuccess
s1 [String]
args2 PropertySuccess
s2) =
    String -> Doc
text String
"there are at least two" Doc -> Doc -> Doc
<+>
    [String] -> Doc -> Doc -> Doc
forall a b. [a] -> b -> b -> b
plural [String]
args1 Doc
empty (String -> Doc
text String
"sets of") Doc -> Doc -> Doc
<+>
    String -> Doc
text String
"arguments satisfying the property:" Doc -> Doc -> Doc
$$
      [String] -> PropertySuccess -> Doc
forall a. Pretty a => [String] -> a -> Doc
formatExample [String]
args1 PropertySuccess
s1 Doc -> Doc -> Doc
$$ [String] -> PropertySuccess -> Doc
forall a. Pretty a => [String] -> a -> Doc
formatExample [String]
args2 PropertySuccess
s2
    where
    formatExample :: [String] -> a -> Doc
formatExample [String]
args a
s = Int -> Doc -> Doc
nest Int
ind (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> [String] -> Doc
prettyArgs [String]
args Doc -> Doc -> Doc
</> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
s
  pretty (CounterExample [String]
args PropertyFailure
f) =
    String -> Doc
text String
"there" Doc -> Doc -> Doc
<+>
    String -> Doc
text ([String] -> String -> ShowS
forall a b. [a] -> b -> b -> b
plural [String]
args String
"exists" String
"exist") Doc -> Doc -> Doc
<+>
    [String] -> Doc
prettyArgs [String]
args Doc -> Doc -> Doc
<+>
    String -> Doc
text String
"such that"
    Doc -> Doc -> Doc
</> PropertyFailure -> Doc
forall a. Pretty a => a -> Doc
pretty PropertyFailure
f
  pretty (PropertyFalse Maybe String
Nothing)  = String -> Doc
text String
"condition is false"
  pretty (PropertyFalse (Just String
s)) = String -> Doc
text String
s

instance Pretty PropertySuccess where
  pretty :: PropertySuccess -> Doc
pretty (PropertyTrue Maybe String
Nothing)  = String -> Doc
text String
"condition is true"
  pretty (PropertyTrue (Just String
s)) = String -> Doc
text String
s
  pretty (Exist       [String]
args PropertySuccess
s) = Bool -> [String] -> PropertySuccess -> Doc
forall a. Pretty a => Bool -> [String] -> a -> Doc
existsMsg Bool
False [String]
args PropertySuccess
s
  pretty (ExistUnique [String]
args PropertySuccess
s) = Bool -> [String] -> PropertySuccess -> Doc
forall a. Pretty a => Bool -> [String] -> a -> Doc
existsMsg Bool
True [String]
args PropertySuccess
s
  pretty (Vacuously PropertyFailure
s) = String -> Doc
text String
"property is vacuously true because" Doc -> Doc -> Doc
</> PropertyFailure -> 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 :: [String] -> Doc
prettyArgs = [Doc] -> Doc
hsep ([Doc] -> Doc) -> ([String] -> [Doc]) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text

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

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

ppFailure :: PropertyFailure -> String
ppFailure :: PropertyFailure -> String
ppFailure = Doc -> String
render (Doc -> String)
-> (PropertyFailure -> Doc) -> PropertyFailure -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyFailure -> Doc
forall a. Pretty a => a -> Doc
pretty