    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE TypeFamilies #-}
    -- | Stability: provisional
    module Test.Hspec.Core.QuickCheck (
      modifyMaxSuccess
    , modifyMaxDiscardRatio
    , modifyMaxSize
    , modifyMaxShrinks
    , modifyArgs
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat

    import           Test.QuickCheck (Args(..))
    import qualified Test.QuickCheck as QC
    import qualified Test.QuickCheck.State as QC (numSuccessTests, maxSuccessTests)
    import qualified Test.QuickCheck.Property as QCP

    import           Test.Hspec.Core.Util
    import           Test.Hspec.Core.QuickCheck.Util
    import           Test.Hspec.Core.Example (Example(..), Params(..), Result(..), ResultStatus(..), FailureReason(..), hunitFailureToResult)
    import           Test.Hspec.Core.Spec.Monad (SpecWith, modifyParams)

    -- | Use a modified `maxSuccess` for given spec.
    modifyMaxSuccess :: (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxSuccess :: forall a. (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxSuccess = (Args -> Args) -> SpecWith a -> SpecWith a
    forall a. (Args -> Args) -> SpecWith a -> SpecWith a
    modifyArgs ((Args -> Args) -> SpecWith a -> SpecWith a)
    -> ((Int -> Int) -> Args -> Args)
    -> (Int -> Int)
    -> SpecWith a
    -> SpecWith a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int) -> Args -> Args
    modify
      where
        modify :: (Int -> Int) -> Args -> Args
        modify :: (Int -> Int) -> Args -> Args
    modify Int -> Int
    f Args
    args = Args
    args {maxSuccess = f (maxSuccess args)}

    -- | Use a modified `maxDiscardRatio` for given spec.
    modifyMaxDiscardRatio :: (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxDiscardRatio :: forall a. (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxDiscardRatio = (Args -> Args) -> SpecWith a -> SpecWith a
    forall a. (Args -> Args) -> SpecWith a -> SpecWith a
    modifyArgs ((Args -> Args) -> SpecWith a -> SpecWith a)
    -> ((Int -> Int) -> Args -> Args)
    -> (Int -> Int)
    -> SpecWith a
    -> SpecWith a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int) -> Args -> Args
    modify
      where
        modify :: (Int -> Int) -> Args -> Args
        modify :: (Int -> Int) -> Args -> Args
    modify Int -> Int
    f Args
    args = Args
    args {maxDiscardRatio = f (maxDiscardRatio args)}

    -- | Use a modified `maxSize` for given spec.
    modifyMaxSize :: (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxSize :: forall a. (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxSize = (Args -> Args) -> SpecWith a -> SpecWith a
    forall a. (Args -> Args) -> SpecWith a -> SpecWith a
    modifyArgs ((Args -> Args) -> SpecWith a -> SpecWith a)
    -> ((Int -> Int) -> Args -> Args)
    -> (Int -> Int)
    -> SpecWith a
    -> SpecWith a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int) -> Args -> Args
    modify
      where
        modify :: (Int -> Int) -> Args -> Args
        modify :: (Int -> Int) -> Args -> Args
    modify Int -> Int
    f Args
    args = Args
    args {maxSize = f (maxSize args)}

    -- | Use a modified `maxShrinks` for given spec.
    modifyMaxShrinks :: (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxShrinks :: forall a. (Int -> Int) -> SpecWith a -> SpecWith a
    modifyMaxShrinks = (Args -> Args) -> SpecWith a -> SpecWith a
    forall a. (Args -> Args) -> SpecWith a -> SpecWith a
    modifyArgs ((Args -> Args) -> SpecWith a -> SpecWith a)
    -> ((Int -> Int) -> Args -> Args)
    -> (Int -> Int)
    -> SpecWith a
    -> SpecWith a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> Int) -> Args -> Args
    modify
      where
        modify :: (Int -> Int) -> Args -> Args
        modify :: (Int -> Int) -> Args -> Args
    modify Int -> Int
    f Args
    args = Args
    args {maxShrinks = f (maxShrinks args)}

    -- | Use modified `Args` for given spec.
    modifyArgs :: (Args -> Args) -> SpecWith a -> SpecWith a
    modifyArgs :: forall a. (Args -> Args) -> SpecWith a -> SpecWith a
    modifyArgs = (Params -> Params) -> SpecWith a -> SpecWith a
    forall a. (Params -> Params) -> SpecWith a -> SpecWith a
    modifyParams ((Params -> Params) -> SpecWith a -> SpecWith a)
    -> ((Args -> Args) -> Params -> Params)
    -> (Args -> Args)
    -> SpecWith a
    -> SpecWith a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Args -> Args) -> Params -> Params
    modify
      where
        modify :: (Args -> Args) -> Params -> Params
        modify :: (Args -> Args) -> Params -> Params
    modify Args -> Args
    f Params
    p = Params
    p {paramsQuickCheckArgs = f (paramsQuickCheckArgs p)}

    instance Example QC.Property where
    #ifdef ENABLE_SPEC_HOOK_ARGS
      type Arg QC.Property = ()
    #endif
      evaluateExample :: Property
    -> Params
    -> (ActionWith (Arg Property) -> IO ())
    -> ProgressCallback
    -> IO Result
    evaluateExample Property
    e = (() -> Property)
    -> Params
    -> (ActionWith (Arg (() -> Property)) -> IO ())
    -> ProgressCallback
    -> IO Result
    forall e.
    Example e =>
    e
    -> Params
    -> (ActionWith (Arg e) -> IO ())
    -> ProgressCallback
    -> IO Result
    evaluateExample (\() -> Property
    e)

    #ifdef ENABLE_SPEC_HOOK_ARGS
    instance Example (a -> QC.Property) where
      type Arg (a -> QC.Property) = a
    #else
    instance Example (() -> QC.Property) where
    #endif
      evaluateExample :: (a -> Property)
    -> Params
    -> (ActionWith (Arg (a -> Property)) -> IO ())
    -> ProgressCallback
    -> IO Result
    evaluateExample a -> Property
    p Params
    params ActionWith (Arg (a -> Property)) -> IO ()
    hook ProgressCallback
    progressCallback = do
        let args :: Args
    args = Params -> Args
    paramsQuickCheckArgs Params
    params
        r <- Args -> Property -> IO Result
    forall prop. Testable prop => Args -> prop -> IO Result
    QC.quickCheckWithResult Args
    args {QC.chatty = False} (Callback -> Property -> Property
    forall prop. Testable prop => Callback -> prop -> Property
    QCP.callback Callback
    qcProgressCallback (Property -> Property) -> Property -> Property
    forall a b. (a -> b) -> a -> b
    $ ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property
    forall a. ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property
    aroundProperty (a -> IO ()) -> IO ()
    ActionWith (Arg (a -> Property)) -> IO ()
    hook a -> Property
    p)
        return $ fromQuickCheckResult args r
        where
          qcProgressCallback :: Callback
    qcProgressCallback = CallbackKind -> (State -> Result -> IO ()) -> Callback
    QCP.PostTest CallbackKind
    QCP.NotCounterexample ((State -> Result -> IO ()) -> Callback)
    -> (State -> Result -> IO ()) -> Callback
    forall a b. (a -> b) -> a -> b
    $
            \State
    st Result
    _ -> ProgressCallback
    progressCallback (State -> Int
    QC.numSuccessTests State
    st, State -> Int
    QC.maxSuccessTests State
    st)

    fromQuickCheckResult :: QC.Args -> QC.Result -> Result
    fromQuickCheckResult :: Args -> Result -> Result
    fromQuickCheckResult Args
    args Result
    r = case Result -> QuickCheckResult
    parseQuickCheckResult Result
    r of
      QuickCheckResult Int
    _ String
    info (QuickCheckOtherFailure String
    err) -> String -> ResultStatus -> Result
    Result String
    info (ResultStatus -> Result) -> ResultStatus -> Result
    forall a b. (a -> b) -> a -> b
    $ Maybe Location -> FailureReason -> ResultStatus
    Failure Maybe Location
    forall a. Maybe a
    Nothing (String -> FailureReason
    Reason String
    err)
      QuickCheckResult Int
    _ String
    info Status
    QuickCheckSuccess -> String -> ResultStatus -> Result
    Result (if Args -> Bool
    QC.chatty Args
    args then String
    info else String
    "") ResultStatus
    Success
      QuickCheckResult Int
    n String
    info (QuickCheckFailure QCFailure{Int
    String
    [String]
    Maybe SomeException
    quickCheckFailureNumShrinks :: Int
    quickCheckFailureException :: Maybe SomeException
    quickCheckFailureReason :: String
    quickCheckFailureCounterexample :: [String]
    quickCheckFailureCounterexample :: QuickCheckFailure -> [String]
    quickCheckFailureReason :: QuickCheckFailure -> String
    quickCheckFailureException :: QuickCheckFailure -> Maybe SomeException
    quickCheckFailureNumShrinks :: QuickCheckFailure -> Int
    ..}) -> case Maybe SomeException
    quickCheckFailureException of
        Just SomeException
    e | Just ResultStatus
    result <- SomeException -> Maybe ResultStatus
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e -> String -> ResultStatus -> Result
    Result String
    info ResultStatus
    result
        Just SomeException
    e | Just HUnitFailure
    hunit <- SomeException -> Maybe HUnitFailure
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e -> String -> ResultStatus -> Result
    Result String
    info (ResultStatus -> Result) -> ResultStatus -> Result
    forall a b. (a -> b) -> a -> b
    $ Maybe String -> HUnitFailure -> ResultStatus
    hunitFailureToResult (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    hunitAssertion) HUnitFailure
    hunit
        Just SomeException
    e -> String -> Result
    failure (SomeException -> String
    uncaughtException SomeException
    e)
        Maybe SomeException
    Nothing -> String -> Result
    failure String
    falsifiable
        where
          failure :: String -> Result
    failure = String -> ResultStatus -> Result
    Result String
    info (ResultStatus -> Result)
    -> (String -> ResultStatus) -> String -> Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Location -> FailureReason -> ResultStatus
    Failure Maybe Location
    forall a. Maybe a
    Nothing (FailureReason -> ResultStatus)
    -> (String -> FailureReason) -> String -> ResultStatus
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> FailureReason
    Reason

          numbers :: String
    numbers = Int -> Int -> String
    formatNumbers Int
    n Int
    quickCheckFailureNumShrinks

          hunitAssertion :: String
          hunitAssertion :: String
    hunitAssertion = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" [
              String
    "Falsifiable " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    numbers String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":"
            , String -> String
    indent ([String] -> String
    unlines [String]
    quickCheckFailureCounterexample)
            ]

          uncaughtException :: SomeException -> String
    uncaughtException SomeException
    e = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" [
              String
    "uncaught exception: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    formatException SomeException
    e
            , String
    numbers
            , String -> String
    indent ([String] -> String
    unlines [String]
    quickCheckFailureCounterexample)
            ]

          falsifiable :: String
    falsifiable = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" [
              String
    quickCheckFailureReason String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    numbers String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ":"
            , String -> String
    indent ([String] -> String
    unlines [String]
    quickCheckFailureCounterexample)
            ]

    indent :: String -> String
    indent :: String -> String
    indent = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines