    {-# 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
    (PropertySuccess -> PropertySuccess -> Bool)
    -> (PropertySuccess -> PropertySuccess -> Bool)
    -> Eq PropertySuccess
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PropertySuccess -> PropertySuccess -> Bool
    == :: PropertySuccess -> PropertySuccess -> Bool
    $c/= :: PropertySuccess -> PropertySuccess -> Bool
    /= :: PropertySuccess -> PropertySuccess -> Bool
    Eq, Int -> PropertySuccess -> ShowS
    [PropertySuccess] -> ShowS
    PropertySuccess -> Argument
    (Int -> PropertySuccess -> ShowS)
    -> (PropertySuccess -> Argument)
    -> ([PropertySuccess] -> ShowS)
    -> Show PropertySuccess
    forall a.
    (Int -> a -> ShowS) -> (a -> Argument) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PropertySuccess -> ShowS
    showsPrec :: Int -> PropertySuccess -> ShowS
    $cshow :: PropertySuccess -> Argument
    show :: PropertySuccess -> Argument
    $cshowList :: [PropertySuccess] -> ShowS
    showList :: [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
    (PropertyFailure -> PropertyFailure -> Bool)
    -> (PropertyFailure -> PropertyFailure -> Bool)
    -> Eq PropertyFailure
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PropertyFailure -> PropertyFailure -> Bool
    == :: PropertyFailure -> PropertyFailure -> Bool
    $c/= :: PropertyFailure -> PropertyFailure -> Bool
    /= :: PropertyFailure -> PropertyFailure -> Bool
    Eq, Int -> PropertyFailure -> ShowS
    [PropertyFailure] -> ShowS
    PropertyFailure -> Argument
    (Int -> PropertyFailure -> ShowS)
    -> (PropertyFailure -> Argument)
    -> ([PropertyFailure] -> ShowS)
    -> Show PropertyFailure
    forall a.
    (Int -> a -> ShowS) -> (a -> Argument) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PropertyFailure -> ShowS
    showsPrec :: Int -> PropertyFailure -> ShowS
    $cshow :: PropertyFailure -> Argument
    show :: PropertyFailure -> Argument
    $cshowList :: [PropertyFailure] -> ShowS
    showList :: [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
    <+>
        [Argument] -> 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
    $$
          [Argument] -> PropertySuccess -> Doc
    forall {a}. Pretty a => [Argument] -> a -> Doc
    formatExample [Argument]
    args1 PropertySuccess
    s1 Doc -> Doc -> Doc
    $$ [Argument] -> PropertySuccess -> 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 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ Argument -> Doc
    text Argument
    "for" Doc -> Doc -> Doc
    <+> [Argument] -> Doc
    prettyArgs [Argument]
    args Doc -> Doc -> Doc
    </> a -> 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 ([Argument] -> Argument -> ShowS
    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
    </> PropertyFailure -> 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) = Bool -> [Argument] -> PropertySuccess -> Doc
    forall a. Pretty a => Bool -> [Argument] -> a -> Doc
    existsMsg Bool
    False [Argument]
    args PropertySuccess
    s
      pretty (ExistUnique [Argument]
    args PropertySuccess
    s) = Bool -> [Argument] -> PropertySuccess -> Doc
    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
    </> 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 :: [Argument] -> Doc
    prettyArgs = [Doc] -> Doc
    hsep ([Doc] -> Doc) -> ([Argument] -> [Doc]) -> [Argument] -> Doc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Argument -> Doc) -> [Argument] -> [Doc]
    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 ([Argument] -> Argument -> ShowS
    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
    </>
      a -> 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 (Doc -> Argument)
    -> (PropertyFailure -> Doc) -> PropertyFailure -> Argument
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PropertyFailure -> Doc
    forall a. Pretty a => a -> Doc
    pretty