    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE CPP #-}
    module Test.Hspec.Core.QuickCheck.Util (
      liftHook
    , aroundProperty

    , QuickCheckResult(..)
    , Status(..)
    , QuickCheckFailure(..)
    , parseQuickCheckResult

    , formatNumbers

    , mkGen
    , newSeed
    #ifdef TEST
    , stripSuffix
    , splitBy
    #endif
    ) where

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

    import           Data.Int
    import           System.Random

    import           Test.QuickCheck
    import           Test.QuickCheck.Text (isOneLine)
    import qualified Test.QuickCheck.Property as QCP
    import           Test.QuickCheck.Property hiding (Result(..))
    import           Test.QuickCheck.Gen
    import           Test.QuickCheck.IO ()
    import           Test.QuickCheck.Random
    import qualified Test.QuickCheck.Test as QC (showTestCount)
    import           Test.QuickCheck.State (State(..))

    import           Test.Hspec.Core.Util

    liftHook
      :: r
      -- ^ Default result, taken if the hook decides to not run the test
      -> ((a -> IO ()) -> IO ())
      -- ^ Hook: given an action to actually run the test, potentially does
      -- some IO actions before the test, runs it while supplying an argument (or
      -- skips it!), then may execute some more actions after running it.
      -> (a -> IO r)
      -- ^ The actual test being run, producing a result
      -> IO r
    liftHook :: forall r a. r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r
    liftHook r
    def (a -> IO ()) -> IO ()
    hook a -> IO r
    inner = do
      ref <- r -> IO (IORef r)
    forall a. a -> IO (IORef a)
    newIORef r
    def
      hook $ inner >=> writeIORef ref
      readIORef ref

    aroundProperty :: ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property
    aroundProperty :: forall a. ((a -> IO ()) -> IO ()) -> (a -> Property) -> Property
    aroundProperty (a -> IO ()) -> IO ()
    hook a -> Property
    p = Gen Prop -> Property
    MkProperty (Gen Prop -> Property)
    -> ((QCGen -> Int -> Prop) -> Gen Prop)
    -> (QCGen -> Int -> Prop)
    -> Property
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (QCGen -> Int -> Prop) -> Gen Prop
    forall a. (QCGen -> Int -> a) -> Gen a
    MkGen ((QCGen -> Int -> Prop) -> Property)
    -> (QCGen -> Int -> Prop) -> Property
    forall a b. (a -> b) -> a -> b
    $ \QCGen
    r Int
    n -> ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop
    forall a. ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop
    aroundProp (a -> IO ()) -> IO ()
    hook ((a -> Prop) -> Prop) -> (a -> Prop) -> Prop
    forall a b. (a -> b) -> a -> b
    $ \a
    a -> (Gen Prop -> QCGen -> Int -> Prop
    forall a. Gen a -> QCGen -> Int -> a
    unGen (Gen Prop -> QCGen -> Int -> Prop)
    -> (Property -> Gen Prop) -> Property -> QCGen -> Int -> Prop
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Property -> Gen Prop
    unProperty (Property -> QCGen -> Int -> Prop)
    -> Property -> QCGen -> Int -> Prop
    forall a b. (a -> b) -> a -> b
    $ a -> Property
    p a
    a) QCGen
    r Int
    n

    aroundProp :: ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop
    aroundProp :: forall a. ((a -> IO ()) -> IO ()) -> (a -> Prop) -> Prop
    aroundProp (a -> IO ()) -> IO ()
    hook a -> Prop
    p = Rose Result -> Prop
    MkProp (Rose Result -> Prop) -> Rose Result -> Prop
    forall a b. (a -> b) -> a -> b
    $ ((a -> IO ()) -> IO ()) -> (a -> Rose Result) -> Rose Result
    forall a.
    ((a -> IO ()) -> IO ()) -> (a -> Rose Result) -> Rose Result
    aroundRose (a -> IO ()) -> IO ()
    hook (\a
    a -> Prop -> Rose Result
    unProp (Prop -> Rose Result) -> Prop -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ a -> Prop
    p a
    a)

    aroundRose :: ((a -> IO ()) -> IO ()) -> (a -> Rose QCP.Result) -> Rose QCP.Result
    aroundRose :: forall a.
    ((a -> IO ()) -> IO ()) -> (a -> Rose Result) -> Rose Result
    aroundRose (a -> IO ()) -> IO ()
    hook a -> Rose Result
    r = IO (Rose Result) -> Rose Result
    ioRose (IO (Rose Result) -> Rose Result)
    -> IO (Rose Result) -> Rose Result
    forall a b. (a -> b) -> a -> b
    $ do
      Rose Result
    -> ((a -> IO ()) -> IO ())
    -> (a -> IO (Rose Result))
    -> IO (Rose Result)
    forall r a. r -> ((a -> IO ()) -> IO ()) -> (a -> IO r) -> IO r
    liftHook (Result -> Rose Result
    forall a. a -> Rose a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    QCP.succeeded) (a -> IO ()) -> IO ()
    hook ((a -> IO (Rose Result)) -> IO (Rose Result))
    -> (a -> IO (Rose Result)) -> IO (Rose Result)
    forall a b. (a -> b) -> a -> b
    $ \ a
    a -> Rose Result -> IO (Rose Result)
    reduceRose (a -> Rose Result
    r a
    a)

    newSeed :: IO Int
    newSeed :: IO Int
    newSeed = (Int, QCGen) -> Int
    forall a b. (a, b) -> a
    fst ((Int, QCGen) -> Int) -> (QCGen -> (Int, QCGen)) -> QCGen -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> QCGen -> (Int, QCGen)
    forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR (Int
    0, Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32
    forall a. Bounded a => a
    maxBound :: Int32)) (QCGen -> Int) -> IO QCGen -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
      IO QCGen
    newQCGen

    mkGen :: Int -> QCGen
    mkGen :: Int -> QCGen
    mkGen = Int -> QCGen
    mkQCGen

    formatNumbers :: Int -> Int -> String
    formatNumbers :: Int -> Int -> String
    formatNumbers Int
    n Int
    shrinks = String
    "(after " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    pluralize Int
    n String
    "test" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    shrinks_ String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
      where
        shrinks_ :: String
    shrinks_
          | Int
    shrinks Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 = String
    " and " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    pluralize Int
    shrinks String
    "shrink"
          | Bool
    otherwise = String
    ""

    data QuickCheckResult = QuickCheckResult {
      QuickCheckResult -> Int
    quickCheckResultNumTests :: Int
    , QuickCheckResult -> String
    quickCheckResultInfo :: String
    , QuickCheckResult -> Status
    quickCheckResultStatus :: Status
    } deriving Int -> QuickCheckResult -> String -> String
    [QuickCheckResult] -> String -> String
    QuickCheckResult -> String
    (Int -> QuickCheckResult -> String -> String)
    -> (QuickCheckResult -> String)
    -> ([QuickCheckResult] -> String -> String)
    -> Show QuickCheckResult
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> QuickCheckResult -> String -> String
    showsPrec :: Int -> QuickCheckResult -> String -> String
    $cshow :: QuickCheckResult -> String
    show :: QuickCheckResult -> String
    $cshowList :: [QuickCheckResult] -> String -> String
    showList :: [QuickCheckResult] -> String -> String
    Show

    data Status =
        QuickCheckSuccess
      | QuickCheckFailure QuickCheckFailure
      | QuickCheckOtherFailure String
      deriving Int -> Status -> String -> String
    [Status] -> String -> String
    Status -> String
    (Int -> Status -> String -> String)
    -> (Status -> String)
    -> ([Status] -> String -> String)
    -> Show Status
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Status -> String -> String
    showsPrec :: Int -> Status -> String -> String
    $cshow :: Status -> String
    show :: Status -> String
    $cshowList :: [Status] -> String -> String
    showList :: [Status] -> String -> String
    Show

    data QuickCheckFailure = QCFailure {
      QuickCheckFailure -> Int
    quickCheckFailureNumShrinks :: Int
    , QuickCheckFailure -> Maybe SomeException
    quickCheckFailureException :: Maybe SomeException
    , QuickCheckFailure -> String
    quickCheckFailureReason :: String
    , QuickCheckFailure -> [String]
    quickCheckFailureCounterexample :: [String]
    } deriving Int -> QuickCheckFailure -> String -> String
    [QuickCheckFailure] -> String -> String
    QuickCheckFailure -> String
    (Int -> QuickCheckFailure -> String -> String)
    -> (QuickCheckFailure -> String)
    -> ([QuickCheckFailure] -> String -> String)
    -> Show QuickCheckFailure
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> QuickCheckFailure -> String -> String
    showsPrec :: Int -> QuickCheckFailure -> String -> String
    $cshow :: QuickCheckFailure -> String
    show :: QuickCheckFailure -> String
    $cshowList :: [QuickCheckFailure] -> String -> String
    showList :: [QuickCheckFailure] -> String -> String
    Show

    parseQuickCheckResult :: Result -> QuickCheckResult
    parseQuickCheckResult :: Result -> QuickCheckResult
    parseQuickCheckResult Result
    r = case Result
    r of
      Success {Int
    String
    Map String Int
    Map String (Map String Int)
    Map [String] Int
    numTests :: Int
    numDiscarded :: Int
    labels :: Map [String] Int
    classes :: Map String Int
    tables :: Map String (Map String Int)
    output :: String
    output :: Result -> String
    tables :: Result -> Map String (Map String Int)
    classes :: Result -> Map String Int
    labels :: Result -> Map [String] Int
    numDiscarded :: Result -> Int
    numTests :: Result -> Int
    ..} -> String -> Status -> QuickCheckResult
    result String
    output Status
    QuickCheckSuccess

      Failure {Int
    String
    [String]
    [Witness]
    Maybe SomeException
    QCGen
    Set String
    output :: Result -> String
    numDiscarded :: Result -> Int
    numTests :: Result -> Int
    numTests :: Int
    numDiscarded :: Int
    numShrinks :: Int
    numShrinkTries :: Int
    numShrinkFinal :: Int
    usedSeed :: QCGen
    usedSize :: Int
    reason :: String
    theException :: Maybe SomeException
    output :: String
    failingTestCase :: [String]
    failingLabels :: [String]
    failingClasses :: Set String
    witnesses :: [Witness]
    witnesses :: Result -> [Witness]
    failingClasses :: Result -> Set String
    failingLabels :: Result -> [String]
    failingTestCase :: Result -> [String]
    theException :: Result -> Maybe SomeException
    reason :: Result -> String
    usedSize :: Result -> Int
    usedSeed :: Result -> QCGen
    numShrinkFinal :: Result -> Int
    numShrinkTries :: Result -> Int
    numShrinks :: Result -> Int
    ..} ->
        case String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix String
    outputWithoutVerbose String
    output of
          Just String
    xs -> String -> Status -> QuickCheckResult
    result String
    verboseOutput (QuickCheckFailure -> Status
    QuickCheckFailure (QuickCheckFailure -> Status) -> QuickCheckFailure -> Status
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Maybe SomeException -> String -> [String] -> QuickCheckFailure
    QCFailure Int
    numShrinks Maybe SomeException
    theException String
    reason [String]
    failingTestCase)
            where
              verboseOutput :: String
    verboseOutput
                | String
    xs String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "*** Failed! " = String
    ""
                | Bool
    otherwise = String -> String -> String
    maybeStripSuffix String
    "*** Failed!" (String -> String
    strip String
    xs)
          Maybe String
    Nothing -> String -> QuickCheckResult
    couldNotParse String
    output
        where
          outputWithoutVerbose :: String
    outputWithoutVerbose = String
    reasonAndNumbers String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines [String]
    failingTestCase
          reasonAndNumbers :: String
    reasonAndNumbers
            | String -> Bool
    isOneLine String
    reason = String
    reason 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
    colonNewline
            | Bool
    otherwise = String
    numbers String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    colonNewline String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    ensureTrailingNewline String
    reason
          numbers :: String
    numbers = Int -> Int -> String
    formatNumbers Int
    numTests Int
    numShrinks
          colonNewline :: String
    colonNewline = String
    ":\n"

      GaveUp {Int
    String
    Map String Int
    Map String (Map String Int)
    Map [String] Int
    output :: Result -> String
    tables :: Result -> Map String (Map String Int)
    classes :: Result -> Map String Int
    labels :: Result -> Map [String] Int
    numDiscarded :: Result -> Int
    numTests :: Result -> Int
    numTests :: Int
    numDiscarded :: Int
    labels :: Map [String] Int
    classes :: Map String Int
    tables :: Map String (Map String Int)
    output :: String
    ..} ->
        case String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix String
    outputWithoutVerbose String
    output of
          Just String
    info -> String -> String -> QuickCheckResult
    otherFailure String
    info (String
    "Gave up after " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    numbers String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "!")
          Maybe String
    Nothing -> String -> QuickCheckResult
    couldNotParse String
    output
        where
          numbers :: String
    numbers = Int -> Int -> String
    showTestCount Int
    numTests Int
    numDiscarded
          outputWithoutVerbose :: String
    outputWithoutVerbose = String
    "*** Gave up! Passed only " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    numbers String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " tests.\n"

      NoExpectedFailure {Int
    String
    Map String Int
    Map String (Map String Int)
    Map [String] Int
    output :: Result -> String
    tables :: Result -> Map String (Map String Int)
    classes :: Result -> Map String Int
    labels :: Result -> Map [String] Int
    numDiscarded :: Result -> Int
    numTests :: Result -> Int
    numTests :: Int
    numDiscarded :: Int
    labels :: Map [String] Int
    classes :: Map String Int
    tables :: Map String (Map String Int)
    output :: String
    ..} -> case String -> String -> Maybe (String, String)
    splitBy String
    "*** Failed! " String
    output of
        Just (String
    info, String
    err) -> String -> String -> QuickCheckResult
    otherFailure String
    info String
    err
        Maybe (String, String)
    Nothing -> String -> QuickCheckResult
    couldNotParse String
    output

      where
        result :: String -> Status -> QuickCheckResult
    result = Int -> String -> Status -> QuickCheckResult
    QuickCheckResult (Result -> Int
    numTests Result
    r) (String -> Status -> QuickCheckResult)
    -> (String -> String) -> String -> Status -> QuickCheckResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    strip
        otherFailure :: String -> String -> QuickCheckResult
    otherFailure String
    info String
    err = String -> Status -> QuickCheckResult
    result String
    info (String -> Status
    QuickCheckOtherFailure (String -> Status) -> String -> Status
    forall a b. (a -> b) -> a -> b
    $ String -> String
    strip String
    err)
        couldNotParse :: String -> QuickCheckResult
    couldNotParse = String -> Status -> QuickCheckResult
    result String
    "" (Status -> QuickCheckResult)
    -> (String -> Status) -> String -> QuickCheckResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Status
    QuickCheckOtherFailure

    showTestCount :: Int -> Int -> String
    showTestCount :: Int -> Int -> String
    showTestCount Int
    success Int
    discarded = State -> String
    QC.showTestCount State
    state
      where
        state :: State
    state = MkState {
          terminal :: Terminal
    terminal                  = Terminal
    forall a. HasCallStack => a
    undefined
        , maxSuccessTests :: Int
    maxSuccessTests           = Int
    forall a. HasCallStack => a
    undefined
        , maxDiscardedRatio :: Int
    maxDiscardedRatio         = Int
    forall a. HasCallStack => a
    undefined
        , coverageConfidence :: Maybe Confidence
    coverageConfidence        = Maybe Confidence
    forall a. HasCallStack => a
    undefined
    #if MIN_VERSION_QuickCheck(2,15,0)
        , maxTestSize :: Int
    maxTestSize               = Int
    0
        , replayStartSize :: Maybe Int
    replayStartSize           = Maybe Int
    forall a. HasCallStack => a
    undefined
    #else
        , computeSize               = undefined
    #endif
        , numTotMaxShrinks :: Int
    numTotMaxShrinks          = Int
    0
        , numSuccessTests :: Int
    numSuccessTests           = Int
    success
        , numDiscardedTests :: Int
    numDiscardedTests         = Int
    discarded
        , numRecentlyDiscardedTests :: Int
    numRecentlyDiscardedTests = Int
    0
        , labels :: Map [String] Int
    labels                    = Map [String] Int
    forall a. Monoid a => a
    mempty
        , classes :: Map String Int
    classes                   = Map String Int
    forall a. Monoid a => a
    mempty
        , tables :: Map String (Map String Int)
    tables                    = Map String (Map String Int)
    forall a. Monoid a => a
    mempty
        , requiredCoverage :: Map (Maybe String, String) Double
    requiredCoverage          = Map (Maybe String, String) Double
    forall a. Monoid a => a
    mempty
        , expected :: Bool
    expected                  = Bool
    True
        , randomSeed :: QCGen
    randomSeed                = Int -> QCGen
    mkGen Int
    0
        , numSuccessShrinks :: Int
    numSuccessShrinks         = Int
    0
        , numTryShrinks :: Int
    numTryShrinks             = Int
    0
        , numTotTryShrinks :: Int
    numTotTryShrinks          = Int
    0
        }

    ensureTrailingNewline :: String -> String
    ensureTrailingNewline :: String -> String
    ensureTrailingNewline = [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

    maybeStripPrefix :: String -> String -> String
    maybeStripPrefix :: String -> String -> String
    maybeStripPrefix String
    prefix String
    m = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    m (String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    prefix String
    m)

    maybeStripSuffix :: String -> String -> String
    maybeStripSuffix :: String -> String -> String
    maybeStripSuffix String
    suffix = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    maybeStripPrefix (String -> String
    forall a. [a] -> [a]
    reverse String
    suffix) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse

    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix [a]
    suffix = ([a] -> [a]) -> Maybe [a] -> Maybe [a]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [a] -> [a]
    forall a. [a] -> [a]
    reverse (Maybe [a] -> Maybe [a]) -> ([a] -> Maybe [a]) -> [a] -> Maybe [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a] -> Maybe [a]
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    suffix) ([a] -> Maybe [a]) -> ([a] -> [a]) -> [a] -> Maybe [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse

    splitBy :: String -> String -> Maybe (String, String)
    splitBy :: String -> String -> Maybe (String, String)
    splitBy String
    sep String
    xs = [(String, String)] -> Maybe (String, String)
    forall a. [a] -> Maybe a
    listToMaybe [
        (String
    x, String
    y) | (String
    x, Just String
    y) <- [String] -> [Maybe String] -> [(String, Maybe String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (String -> [String]
    forall a. [a] -> [[a]]
    inits String
    xs) ((String -> Maybe String) -> [String] -> [Maybe String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Maybe String
    stripSep ([String] -> [Maybe String]) -> [String] -> [Maybe String]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    forall a. [a] -> [[a]]
    tails String
    xs)
      ]
      where
        stripSep :: String -> Maybe String
    stripSep = String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    sep