-- |
-- Module      : Test.Hspec.LeanCheck
-- Copyright   : (c) 2018 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- LeanCheck support for the Hspec test framework.
--
-- Here's how your @spec.hs@ might look like:
--
-- > import Test.Hspec
-- > import Test.Hspec.LeanCheck as LC
-- >
-- > import Data.List (sort)
-- >
-- > main :: IO ()
-- > main = hspec spec
-- >
-- > spec :: Spec
-- > spec = do
-- >   describe "sort" $ do
-- >     it "is idempotent" $
-- >       LC.property $ \xs -> sort (sort xs :: [Int]) == sort xs
-- >     it "is identity" $ -- not really
-- >       LC.property $ \xs -> sort (xs :: [Int]) == xs
--
-- The output for the above program is:
--
-- > $ ./eg/minimal
-- >
-- > sort
-- >   is idempotent
-- >   is identity FAILED [1]
-- >
-- > Failures:
-- >
-- >   eg/minimal.hs:17:5:
-- >   1) sort is identity
-- >        [1,0]
-- >
-- >   To rerun use: --match "/sort/is identity/"
-- >
-- > 2 examples, 1 failure
--
-- Please see the documentation of
-- "Test.LeanCheck" and Hspec
-- for more details.
module Test.Hspec.LeanCheck
  ( property
  , propertyFor
  , prop
  , Property
  , module Test.LeanCheck
  )
where

import Test.Hspec.Core.Spec
import Test.LeanCheck
import Test.LeanCheck.Core (resultiers)
import Control.Exception (try)
import System.IO.Unsafe (unsafePerformIO) -- LeanCheck is pure
import qualified Test.HUnit.Lang as HUnit
import Data.Maybe (fromMaybe)

-- | A LeanCheck property.  See 'property', 'propertyFor' and 'prop'.
data Property = Ok
              | Failed String

-- | Like 'property' but allows setting the maximum number of tests.
--
-- > spec :: Spec
-- > spec = do
-- >   describe "thing" $ do
-- >    it "is so and so" $ propertyFor 100 $ \... -> ...
-- >    it "is like this" $ propertyFor 200 $ \... -> ...
-- >    it "does a thing" $ propertyFor 300 $ \... -> ...
-- >    ...
propertyFor :: Testable a => Int -> a -> Property
propertyFor :: Int -> a -> Property
propertyFor Int
m a
p = case Int -> a -> Maybe [String]
forall a. Testable a => Int -> a -> Maybe [String]
counterExample Int
m a
p of
  Maybe [String]
Nothing -> Property
Ok
  Just [String]
ce -> String -> Property
Failed (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
ce
-- TODO: catch errors above

-- | Allows a LeanCheck 'Testable' property to appear in a Spec.
--   Like so:
--
-- > spec :: Spec
-- > spec = do
-- >   describe "thing" $ do
-- >    it "is so and so" $ property $ \x... -> ...
-- >    it "is like this" $ property $ \y... -> ...
-- >    ...
property :: Testable a => a -> Property
property :: a -> Property
property = Int -> a -> Property
forall a. Testable a => Int -> a -> Property
propertyFor Int
200

-- | Allows a named LeanCheck 'Testable' property to appear in a Spec.
--
-- > prop "does so and so" $ ...
--
-- is a shortcut for
--
-- > it "does so an so" $ property $ ...
--
-- > spec :: Spec
-- > spec = do
-- >   describe "thing" $ do
-- >    prop "is so and so" $ \x... -> ...
-- >    prop "is like this" $ \y... -> ...
-- >    ...
prop :: Testable a => String -> a -> Spec
prop :: String -> a -> Spec
prop String
s = String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
s (Property -> Spec) -> (a -> Property) -> a -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Property
forall a. Testable a => a -> Property
property

instance Example Property where
  evaluateExample :: Property
-> Params
-> (ActionWith (Arg Property) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample Property
p Params
_ ActionWith (Arg Property) -> IO ()
_ ProgressCallback
_ = Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result)
-> (ResultStatus -> Result) -> ResultStatus -> IO Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ResultStatus -> Result
Result String
""
                          (ResultStatus -> IO Result) -> ResultStatus -> IO Result
forall a b. (a -> b) -> a -> b
$ case Property
p of
                            Property
Ok -> ResultStatus
Success
                            Failed String
s -> Maybe Location -> FailureReason -> ResultStatus
Failure Maybe Location
forall a. Maybe a
Nothing (String -> FailureReason
Reason String
s)

-- | Allows @should*@ to appear inside LeanCheck properties
--
--   Example:
--
-- > describe "sort" $ do
-- >   it "is idempotent" $
-- >     LC.property $ \xs -> sort (sort xs :: [Int]) `shouldBe` sort xs
instance Testable (IO a) where
  resultiers :: IO a -> [[([String], Bool)]]
resultiers IO a
action = IO [[([String], Bool)]] -> [[([String], Bool)]]
forall a. IO a -> a
unsafePerformIO (IO [[([String], Bool)]] -> [[([String], Bool)]])
-> IO [[([String], Bool)]] -> [[([String], Bool)]]
forall a b. (a -> b) -> a -> b
$ do
    Either HUnitFailure a
r <- IO a -> IO (Either HUnitFailure a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
    [[([String], Bool)]] -> IO [[([String], Bool)]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[([String], Bool)]] -> IO [[([String], Bool)]])
-> (([String], Bool) -> [[([String], Bool)]])
-> ([String], Bool)
-> IO [[([String], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([([String], Bool)] -> [[([String], Bool)]] -> [[([String], Bool)]]
forall a. a -> [a] -> [a]
:[]) ([([String], Bool)] -> [[([String], Bool)]])
-> (([String], Bool) -> [([String], Bool)])
-> ([String], Bool)
-> [[([String], Bool)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], Bool) -> [([String], Bool)] -> [([String], Bool)]
forall a. a -> [a] -> [a]
:[]) (([String], Bool) -> IO [[([String], Bool)]])
-> ([String], Bool) -> IO [[([String], Bool)]]
forall a b. (a -> b) -> a -> b
$ case Either HUnitFailure a
r of
      Right a
_ -> ([],Bool
True)
      Left (HUnit.HUnitFailure Maybe SrcLoc
loc FailureReason
reason) ->
        case FailureReason
reason of
        HUnit.Reason String
s -> ([String
"--", String
s],Bool
False)
        HUnit.ExpectedButGot Maybe String
prefix String
expected String
actual ->
          ([String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
prefix, String
"--", String
"expected", String
expected, String
"but got", String
actual], Bool
False)