    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE InstanceSigs          #-}
    {-# LANGUAGE OverloadedStrings     #-}
    {-# LANGUAGE PartialTypeSignatures #-}
    {-# LANGUAGE RankNTypes            #-}
    {-# LANGUAGE RecordWildCards       #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# LANGUAGE TypeFamilies          #-}
    {-# LANGUAGE TypeOperators         #-}
    {-# LANGUAGE TypeSynonymInstances  #-}
    {-# LANGUAGE ViewPatterns          #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}

    -- | This module allows you to easily integrate the "Hedgehog" library with
    -- "Test.Hspec" test-suites.
    --
    -- To get started, check out the 'hedgehog' function, which lets you embed
    -- a 'PropertyT' directly.
    --
    -- @
    -- spec :: 'Spec'
    -- spec =
    --   'describe' \"my great test\" '$' do
    --     'it' \"generates stuff\" '$'
    --       'hedgehog' '$' do
    --         a <- 'forAll' generator
    --         a '===' expected
    -- @
    --
    -- Truth be told, the functionality is in the two orphan instances of
    -- 'Example' for 'PropertyT'. You can directly use code in the @'PropertyT'
    -- 'IO'@ type. However, because most "Hedgehog" functions are abstract in
    -- 'MonadTest', you might get errors about ambiguous types. The 'hedgehog'
    -- function fixes the type to @'PropertyT' 'IO' '()'@, which works out just
    -- fine.
    --
    -- You can use all of @hspec@'s hooks with this, of course.
    --
    -- @
    -- spec :: Spec
    -- spec = 'before' ('pure' \"Hello!\") '$' do
    --   'describe' \"with a string\" '$' do
    --     'it' \"gets a string\" '$' \\ str ->
    --       'hedgehog' '$' do
    --         wrongLen <- 'forAll' $ 'Gen.integral' ('Range.linear' 0 3)
    --         length str '/==' wrongLen
    -- @
    --
    -- The function 'before' will make all the following spec items a function,
    -- accepting that as a parameter. You should call 'hedgehog' after the
    -- lambda.
    --
    -- If you are morally opposed to the pattern:
    --
    -- @
    -- 'it' \"message\" $ 'hedgehog' $ do
    --   True '===' False
    -- @
    --
    -- Then you can alternatively force the type some other way. One option is
    -- to use a no-op function, like this:
    --
    -- @
    -- 'it' \"message\" $ do
    --   'pure' () :: 'PropertyT' 'IO' ()
    --   True '===' False
    -- @
    --
    -- This style has the advantage that parameters via hooks are less
    -- difficult to get right.
    --
    -- @
    -- 'before' ('pure' \"Hello!\") $ do
    --   'it' \"message\" $ \\str -> do
    --     'pure' () :: 'PropertyT' 'IO' ()
    --     wrongLen <- 'forAll' $ 'Gen.integral' ('Range.linear' 0 3)
    --     'length' str '/==' wrongLen
    -- @
    --
    -- You don't have to remember to put the 'hedgehog' call after the lambda.
    module Test.Hspec.Hedgehog
        ( -- * The Main Function
          hedgehog
          -- * Hspec re-exports
          --
          -- | 'Test.Hspec.QuickCheck.modifyMaxSize' isn't re-exported, since
          -- hedgehog has nothing that corresponds to it.
        , modifyArgs
        , modifyMaxSuccess
        , modifyMaxDiscardRatio
        , modifyMaxShrinks
          -- * Hedgehog Re-exports
        , module Hedgehog
        ) where

    import           Control.Monad.IO.Class     (liftIO)
    import           Data.Char                  (isSpace)
    import           Data.Coerce                (coerce)
    import           Data.IORef                 (newIORef, readIORef, writeIORef)
    import           GHC.Stack                  (withFrozenCallStack)
    import           Hedgehog
    import           Hedgehog.Internal.Config   (UseColor(..))
    import           Hedgehog.Internal.Property (DiscardLimit (..), Property (..),
                                                 PropertyConfig (..),
                                                 ShrinkLimit (..),
                                                 TerminationCriteria (..),
                                                 TestCount (..), TestLimit (..))
    import           Hedgehog.Internal.Report   hiding (renderResult)
    import           Hedgehog.Internal.Runner   (checkReport)
    import qualified Hedgehog.Internal.Seed     as Seed
    import           Hedgehog.Internal.Source   (ColumnNo (..), LineNo (..),
                                                 Span (..))
    import           System.Random.SplitMix     (unseedSMGen)
    import           Test.Hspec
    import           Test.Hspec.Core.Spec       as Hspec
    import           Test.Hspec.QuickCheck      (modifyArgs, modifyMaxDiscardRatio,
                                                 modifyMaxShrinks, modifyMaxSuccess)
    import           Test.QuickCheck.Random     (QCGen (..))
    import           Test.QuickCheck.Test       (Args (..))

    -- | Embed a "Hedgehog" @'PropertyT' 'IO' ()@ in an @hspec@ test.
    --
    -- @
    -- spec :: 'Spec'
    -- spec =
    --   'describe' \"my great test\" '$' do
    --     'it' \"generates stuff\" '$'
    --       'hedgehog' '$' do
    --         a <- 'forAll' generator
    --         a '===' expected
    -- @
    --
    -- This function is only used to fix the type of the @'PropertyT'@ monad
    -- transformer. The functions in "Hedgehog" are typically abstract in
    -- a 'MonadTest', and it's easy to get ambiguous type errors if you leave
    -- this out.
    --
    -- @since 0.0.0.0
    hedgehog :: HasCallStack => PropertyT IO () -> PropertyT IO ()
    hedgehog :: HasCallStack => PropertyT IO () -> PropertyT IO ()
    hedgehog = PropertyT IO () -> PropertyT IO ()
    forall a. a -> a
    id

    -- |  Warning: Orphan instance! This instance is used to embed a "Hedgehog"
    -- property seamlessly into the @hspec@ framework. See the other instance
    -- of 'Example' for a function for more details.
    --
    -- @since 0.0.0.0
    instance m ~ IO => Example (PropertyT m ()) where
        type Arg (PropertyT m ()) = ()
        evaluateExample :: PropertyT m ()
    -> Params
    -> (ActionWith (Arg (PropertyT m ())) -> IO ())
    -> ProgressCallback
    -> IO Result
    evaluateExample PropertyT m ()
    e = (() -> PropertyT m ())
    -> Params
    -> (ActionWith (Arg (() -> PropertyT m ())) -> IO ())
    -> ProgressCallback
    -> IO Result
    forall e.
    Example e =>
    e
    -> Params
    -> (ActionWith (Arg e) -> IO ())
    -> ProgressCallback
    -> IO Result
    evaluateExample (\() -> PropertyT m ()
    e)

    propertyWithoutCallStack :: PropertyT IO () -> Property
    propertyWithoutCallStack :: PropertyT IO () -> Property
    propertyWithoutCallStack = (HasCallStack => PropertyT IO () -> Property)
    -> PropertyT IO () -> Property
    forall a. HasCallStack => (HasCallStack => a) -> a
    withFrozenCallStack HasCallStack => PropertyT IO () -> Property
    PropertyT IO () -> Property
    property

    -- | Warning: orphan instance! This instance is used to embed a "Hedgehog"
    -- property seamlessly into the @hspec@ framework.
    --
    -- The instance will pick things up from the "Test.Hspec.QuickCheck"
    -- configuration. For example, if the program is supposed to use
    -- a predetermined seed, then the same seed will be used for QuickCheck and
    -- Hedgehog tests.
    --
    -- @since 0.0.0.0
    instance (m ~ IO) => Example (a -> PropertyT m ()) where
        type Arg (a -> PropertyT m ()) = a

        evaluateExample :: (a -> PropertyT m ())
    -> Params
    -> (ActionWith (Arg (a -> PropertyT m ())) -> IO ())
    -> ProgressCallback
    -> IO Result
    evaluateExample ((PropertyT IO () -> Property)
    -> (a -> PropertyT IO ()) -> a -> Property
    forall a b. (a -> b) -> (a -> a) -> a -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PropertyT IO () -> Property
    propertyWithoutCallStack -> a -> Property
    aprop) Params
    params ActionWith (Arg (a -> PropertyT m ())) -> IO ()
    aroundAction ProgressCallback
    progressCallback = do
            ref <- Result -> IO (IORef Result)
    forall a. a -> IO (IORef a)
    newIORef (String -> ResultStatus -> Result
    Result String
    "" (Maybe Location -> Maybe String -> ResultStatus
    Pending Maybe Location
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing))
            aroundAction $ \Arg (a -> PropertyT m ())
    a ->  do
                let size :: Size
    size = Size
    0
                    prop :: Property
    prop = a -> Property
    aprop a
    Arg (a -> PropertyT m ())
    a
                    propConfig :: PropertyConfig
    propConfig = PropertyConfig -> PropertyConfig
    useQuickCheckArgs (Property -> PropertyConfig
    propertyConfig Property
    prop)
                    qcArgs :: Args
    qcArgs = Params -> Args
    paramsQuickCheckArgs Params
    params

                    maxTests :: Int
    maxTests = Args -> Int
    maxSuccess Args
    qcArgs
                    useQuickCheckArgs :: PropertyConfig -> PropertyConfig
    useQuickCheckArgs PropertyConfig
    pc =
                        PropertyConfig
    pc
                        { propertyTerminationCriteria =
                            case propertyTerminationCriteria pc of
                                EarlyTermination Confidence
    x (TestLimit Int
    _)      ->
                                    Confidence -> TestLimit -> TerminationCriteria
    EarlyTermination Confidence
    x (Int -> TestLimit
    TestLimit Int
    maxTests)
                                NoEarlyTermination Confidence
    x (TestLimit Int
    _)    ->
                                    Confidence -> TestLimit -> TerminationCriteria
    NoEarlyTermination Confidence
    x (Int -> TestLimit
    TestLimit Int
    maxTests)
                                NoConfidenceTermination (TestLimit Int
    _) ->
                                    TestLimit -> TerminationCriteria
    NoConfidenceTermination (Int -> TestLimit
    TestLimit Int
    maxTests)
                        , propertyDiscardLimit =
                            DiscardLimit $ maxDiscardRatio qcArgs * maxTests
                        , propertyShrinkLimit =
                            ShrinkLimit $ maxShrinks qcArgs
                        }
                    testCount :: Report a -> Int
    testCount Report a
    report =
                        case Report a -> TestCount
    forall a. Report a -> TestCount
    reportTests Report a
    report of
                            TestCount Int
    n -> Int
    n
                    cb :: Report Progress -> IO ()
    cb Report Progress
    progress = do
                        case Report Progress -> Progress
    forall a. Report a -> a
    reportStatus Report Progress
    progress of
                            Progress
    Running ->
                                ProgressCallback
    progressCallback (Report Progress -> Int
    forall {a}. Report a -> Int
    testCount Report Progress
    progress, Int
    maxTests)
                            Shrinking FailureReport
    _ ->
                                ProgressCallback
    progressCallback (Report Progress -> Int
    forall {a}. Report a -> Int
    testCount Report Progress
    progress, Int
    maxTests)

                seed <- IO Seed -> IO Seed
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Seed -> IO Seed) -> IO Seed -> IO Seed
    forall a b. (a -> b) -> a -> b
    $ case Args -> Maybe (QCGen, Int)
    replay (Params -> Args
    paramsQuickCheckArgs Params
    params) of
                   Maybe (QCGen, Int)
    Nothing       -> IO Seed
    forall (m :: * -> *). MonadIO m => m Seed
    Seed.random
                   Just (QCGen
    rng, Int
    _) -> Seed -> IO Seed
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Word64 -> Word64 -> Seed) -> (Word64, Word64) -> Seed
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Word64 -> Word64 -> Seed
    Seed (SMGen -> (Word64, Word64)
    unseedSMGen (QCGen -> SMGen
    forall a b. Coercible a b => a -> b
    coerce QCGen
    rng)))
                hedgeResult <- checkReport propConfig size seed (propertyTest prop) cb

                let
                  config = Config
    defaultConfig {
                      configContext = Context 3
                    , configPrintFailedAtLocation = False
                    , configPrintReproduceMessage = False
                    , configPrintPrefixIcons = DisablePrefixIcons
                    }
                  renderResult UseColor
    color = [String] -> String
    unlines ([String] -> String) -> (String -> [String]) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    unindent ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines (String -> [String]) -> (String -> String) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd Char -> Bool
    isSpace (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Config
    -> UseColor -> Maybe PropertyName -> Report Result -> IO String
    forall (m :: * -> *).
    MonadIO m =>
    Config
    -> UseColor -> Maybe PropertyName -> Report Result -> m String
    renderResultWith Config
    config UseColor
    color (PropertyName -> Maybe PropertyName
    forall a. a -> Maybe a
    Just PropertyName
    "") Report Result
    hedgeResult

                case reportStatus hedgeResult of
                    Failed FailureReport{String
    [String]
    [FailedAnnotation]
    Maybe Span
    Maybe (Coverage CoverCount)
    Maybe Diff
    ShrinkPath
    ShrinkCount
    failureShrinks :: ShrinkCount
    failureShrinkPath :: ShrinkPath
    failureCoverage :: Maybe (Coverage CoverCount)
    failureAnnotations :: [FailedAnnotation]
    failureLocation :: Maybe Span
    failureMessage :: String
    failureDiff :: Maybe Diff
    failureFootnotes :: [String]
    failureFootnotes :: FailureReport -> [String]
    failureDiff :: FailureReport -> Maybe Diff
    failureMessage :: FailureReport -> String
    failureLocation :: FailureReport -> Maybe Span
    failureAnnotations :: FailureReport -> [FailedAnnotation]
    failureCoverage :: FailureReport -> Maybe (Coverage CoverCount)
    failureShrinkPath :: FailureReport -> ShrinkPath
    failureShrinks :: FailureReport -> ShrinkCount
    ..} -> do
                        ppresult <- UseColor -> IO String
    renderResult UseColor
    EnableColor
                        let
                            fromSpan Span{String
    ColumnNo
    LineNo
    spanFile :: String
    spanStartLine :: LineNo
    spanStartColumn :: ColumnNo
    spanEndLine :: LineNo
    spanEndColumn :: ColumnNo
    spanEndColumn :: Span -> ColumnNo
    spanEndLine :: Span -> LineNo
    spanStartColumn :: Span -> ColumnNo
    spanStartLine :: Span -> LineNo
    spanFile :: Span -> String
    ..} =
                                Location
                                    { locationFile :: String
    locationFile = String
    spanFile
                                    , locationLine :: Int
    locationLine = LineNo -> Int
    forall a b. Coercible a b => a -> b
    coerce LineNo
    spanStartLine
                                    , locationColumn :: Int
    locationColumn = ColumnNo -> Int
    forall a b. Coercible a b => a -> b
    coerce ColumnNo
    spanStartColumn
                                    }
                        writeIORef ref $ Result "" $ Hspec.Failure (fromSpan <$> failureLocation) $ ColorizedReason ppresult
                    Result
    GaveUp -> do
                        ppresult <- UseColor -> IO String
    renderResult UseColor
    DisableColor
                        writeIORef ref $ Result "" $ Failure Nothing (Reason ppresult)
                    Result
    OK -> do
                        ppresult <- UseColor -> IO String
    renderResult UseColor
    DisableColor
                        writeIORef ref $ Result ppresult Success
            readIORef ref

    dropWhileEnd :: (a -> Bool) -> [a] -> [a]
    dropWhileEnd :: forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd a -> Bool
    p = [a] -> [a]
    forall a. [a] -> [a]
    reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile a -> Bool
    p ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> [a]
    forall a. [a] -> [a]
    reverse

    unindent :: [String] -> [String]
    unindent :: [String] -> [String]
    unindent [String]
    xs = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    indentation) [String]
    xs
      where
        indentation :: Int
    indentation = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (String -> String) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ')) [String]
    xs