    -- |
    -- Module      : Test.QuickCheck.Simple
    -- Copyright   : 2015-2019 Kei Hibino
    -- License     : BSD3
    --
    -- Maintainer  : ex8k.hibino@gmail.com
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- This module contains definitions of test properties and default-mains
    -- using QuickCheck library.
    module Test.QuickCheck.Simple
           ( Property (..)
           , boolTest', boolTest
           , eqTest', eqTest
           , qcTest

           , Test, TestError (..)
           , runTest_, runTest
           , defaultMain_, defaultMain, verboseMain

           , defaultMain'
           ) where

    import Control.Applicative ((<$>))
    import Control.Monad (unless)
    import Data.Maybe (catMaybes)
    import Data.Monoid ((<>))
    import Test.QuickCheck
      (Testable, Result (..), quickCheckResult, label)
    import qualified Test.QuickCheck as QC

    -- | Property type. 'Bool' or 'Testable' of QuickCheck.
    data Property
      = Bool (Maybe String {- verbose error message -}) Bool
      | QuickCheck QC.Property

    -- | Property with label string
    type Test = (String {- label -}, Property)

    mkBoolTest :: String -> Maybe String -> Bool -> Test
    mkBoolTest :: String -> Maybe String -> Bool -> Test
    mkBoolTest String
    n Maybe String
    m = ((,) String
    n) (Property -> Test) -> (Bool -> Property) -> Bool -> Test
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe String -> Bool -> Property
    Bool Maybe String
    m

    -- | 'Bool' specialized property with message for False case
    boolTest' :: String
              -> String
              -> Bool
              -> Test
    boolTest' :: String -> String -> Bool -> Test
    boolTest' String
    n String
    m = String -> Maybe String -> Bool -> Test
    mkBoolTest String
    n (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    m)

    -- | 'Bool' specialized property
    boolTest :: String
             -> Bool
             -> Test
    boolTest :: String -> Bool -> Test
    boolTest String
    n = String -> Maybe String -> Bool -> Test
    mkBoolTest String
    n Maybe String
    forall a. Maybe a
    Nothing

    -- | 'Eq' specialized property with explicit passing
    eqTest' :: (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
    eqTest' :: forall a.
    (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
    eqTest' a -> a -> Bool
    eq a -> String
    show' String
    n a
    x a
    y = String -> String -> Bool -> Test
    boolTest' String
    n String
    msg (Bool -> Test) -> Bool -> Test
    forall a b. (a -> b) -> a -> b
    $ a
    x a -> a -> Bool
    `eq` a
    y where
      msg :: String
    msg = [String] -> String
    unlines [a -> String
    show' a
    x, String
    "** NOT EQUALS **", a -> String
    show' a
    y]

    -- | 'Eq' specialized property
    eqTest :: (Eq a, Show a) => String -> a -> a -> Test
    eqTest :: forall a. (Eq a, Show a) => String -> a -> a -> Test
    eqTest = (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
    forall a.
    (a -> a -> Bool) -> (a -> String) -> String -> a -> a -> Test
    eqTest' a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) a -> String
    forall a. Show a => a -> String
    show

    -- | QuickCheck 'Testable' property
    qcTest :: Testable prop
           => String
           -> prop
           -> Test
    qcTest :: forall prop. Testable prop => String -> prop -> Test
    qcTest String
    n = ((,) String
    n) (Property -> Test) -> (prop -> Property) -> prop -> Test
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Property -> Property
    QuickCheck (Property -> Property) -> (prop -> Property) -> prop -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> prop -> Property
    forall prop. Testable prop => String -> prop -> Property
    label String
    n

    --------------------------------------------------------------------------------

    -- | Test failure result.
    data TestError
      = BFalse (Maybe String {- verbose error message -})
      | QCError Result
      deriving Int -> TestError -> ShowS
    [TestError] -> ShowS
    TestError -> String
    (Int -> TestError -> ShowS)
    -> (TestError -> String)
    -> ([TestError] -> ShowS)
    -> Show TestError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TestError -> ShowS
    showsPrec :: Int -> TestError -> ShowS
    $cshow :: TestError -> String
    show :: TestError -> String
    $cshowList :: [TestError] -> ShowS
    showList :: [TestError] -> ShowS
    Show

    putErrorLn :: String -> IO ()
    putErrorLn :: String -> IO ()
    putErrorLn = String -> IO ()
    putStrLn (String -> IO ()) -> ShowS -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "*** " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>)

    printVerbose :: String -> TestError -> IO ()
    printVerbose :: String -> TestError -> IO ()
    printVerbose String
    lb TestError
    te = case TestError
    te of
        BFalse Maybe String
    m   ->  IO () -> (String -> IO ()) -> Maybe String -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) String -> IO ()
    format Maybe String
    m
        QCError Result
    r  ->  String -> IO ()
    format (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Result -> String
    forall a. Show a => a -> String
    show Result
    r
      where
        format :: String -> IO ()
    format String
    s =
          (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> IO ()
    putErrorLn
          ([String] -> IO ()) -> [String] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (String
    "label: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    lb String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ":") String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : (ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "  " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <>) ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    s)

    runBool :: String
            -> Maybe String -- ^ verbose error message. Nothing corresponds to not verbose.
            -> Bool
            -> IO (Maybe TestError)
    runBool :: String -> Maybe String -> Bool -> IO (Maybe TestError)
    runBool String
    lb Maybe String
    vmsg = Bool -> IO (Maybe TestError)
    d  where
      d :: Bool -> IO (Maybe TestError)
    d Bool
    True  =  do
        String -> IO ()
    putStrLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "+++ OK, success (" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    lb String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ")"
        Maybe TestError -> IO (Maybe TestError)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return   Maybe TestError
    forall a. Maybe a
    Nothing
      d Bool
    False =  do
        String -> IO ()
    putErrorLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Failed! (" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    lb String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    ")"
        let r :: TestError
    r = Maybe String -> TestError
    BFalse Maybe String
    vmsg
        String -> TestError -> IO ()
    printVerbose String
    lb TestError
    r
        Maybe TestError -> IO (Maybe TestError)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe TestError -> IO (Maybe TestError))
    -> Maybe TestError -> IO (Maybe TestError)
    forall a b. (a -> b) -> a -> b
    $ TestError -> Maybe TestError
    forall a. a -> Maybe a
    Just TestError
    r

    runQcProp :: Bool -- ^ verbose flag
              -> String
              -> QC.Property
              -> IO (Maybe TestError)
    runQcProp :: Bool -> String -> Property -> IO (Maybe TestError)
    runQcProp Bool
    verbose String
    lb Property
    p = Result -> IO (Maybe TestError)
    err (Result -> IO (Maybe TestError))
    -> IO Result -> IO (Maybe TestError)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Property -> IO Result
    forall prop. Testable prop => prop -> IO Result
    quickCheckResult Property
    p  where
      err :: Result -> IO (Maybe TestError)
    err (Success {})  =
        Maybe TestError -> IO (Maybe TestError)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return   Maybe TestError
    forall a. Maybe a
    Nothing
      err Result
    x             =  do
        let r :: TestError
    r = Result -> TestError
    QCError Result
    x
        if Bool
    verbose
          then String -> TestError -> IO ()
    printVerbose String
    lb TestError
    r            -- this action show label
          else String -> IO ()
    putErrorLn (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "label: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    lb -- quickcheck does not show label
        Maybe TestError -> IO (Maybe TestError)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe TestError -> IO (Maybe TestError))
    -> Maybe TestError -> IO (Maybe TestError)
    forall a b. (a -> b) -> a -> b
    $ TestError -> Maybe TestError
    forall a. a -> Maybe a
    Just TestError
    r

    runProp :: Bool
             -> String
             -> Property
             -> IO (Maybe TestError)
    runProp :: Bool -> String -> Property -> IO (Maybe TestError)
    runProp Bool
    verbose String
    lb Property
    prop = case Property
    prop of
      Bool Maybe String
    m Bool
    b      ->  String -> Maybe String -> Bool -> IO (Maybe TestError)
    runBool String
    lb (if Bool
    verbose then Maybe String
    m else Maybe String
    forall a. Maybe a
    Nothing) Bool
    b
      QuickCheck Property
    p  ->  Bool -> String -> Property -> IO (Maybe TestError)
    runQcProp Bool
    verbose String
    lb Property
    p

    -- | Run a single test suite.
    runTest_ :: Bool                 -- ^ verbose flag
             -> Test                 -- ^ property to test
             -> IO (Maybe TestError) -- ^ result action, and may be failure result
    runTest_ :: Bool -> Test -> IO (Maybe TestError)
    runTest_ Bool
    verbose = (String -> Property -> IO (Maybe TestError))
    -> Test -> IO (Maybe TestError)
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ((String -> Property -> IO (Maybe TestError))
     -> Test -> IO (Maybe TestError))
    -> (String -> Property -> IO (Maybe TestError))
    -> Test
    -> IO (Maybe TestError)
    forall a b. (a -> b) -> a -> b
    $ Bool -> String -> Property -> IO (Maybe TestError)
    runProp Bool
    verbose

    -- | Not verbose version of runTest_
    runTest :: Test                 -- ^ property to test
            -> IO (Maybe TestError) -- ^ result action, and may be failure result
    runTest :: Test -> IO (Maybe TestError)
    runTest = Bool -> Test -> IO (Maybe TestError)
    runTest_  Bool
    False

    -- | Default main to run test suites.
    defaultMain_ :: Bool -> [Test] -> IO ()
    defaultMain_ :: Bool -> [Test] -> IO ()
    defaultMain_ Bool
    verbose [Test]
    xs = do
      es <- [Maybe TestError] -> [TestError]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TestError] -> [TestError])
    -> IO [Maybe TestError] -> IO [TestError]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Test -> IO (Maybe TestError)) -> [Test] -> IO [Maybe TestError]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Bool -> Test -> IO (Maybe TestError)
    runTest_ Bool
    verbose) [Test]
    xs
      unless (null es) $ fail "Some failures are found."

    defaultMain' :: Bool -> [Test] -> IO ()
    defaultMain' :: Bool -> [Test] -> IO ()
    defaultMain' = Bool -> [Test] -> IO ()
    defaultMain_
    {-# DEPRECATED defaultMain' "Use defaultMain_ instead of this." #-}

    -- | Not verbose version of 'defaultMain''.
    defaultMain :: [Test] -> IO ()
    defaultMain :: [Test] -> IO ()
    defaultMain = Bool -> [Test] -> IO ()
    defaultMain_ Bool
    False

    -- | Verbose verison of defaultMain
    verboseMain :: [Test] -> IO ()
    verboseMain :: [Test] -> IO ()
    verboseMain = Bool -> [Test] -> IO ()
    defaultMain_ Bool
    True