content: -- | Functions for introducing QuickCheck tests into a Sandwich test tree. Modelled after Hspec's version.
  --
  -- Documentation can be found <https://codedownio.github.io/sandwich/docs/extensions/sandwich-quickcheck here>.
  
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE TypeApplications #-}
  
  module Test.Sandwich.QuickCheck (
    -- * Introducing QuickCheck args
    -- Any tests that use QuickCheck should be wrapped in one of these.
    introduceQuickCheck
    , introduceQuickCheck'
    , introduceQuickCheck''
  
    -- * Versions that can be configured with built-in command line arguments.
    -- Pass --print-quickcheck-flags to list them.
    , introduceQuickCheckCommandLineOptions
    , introduceQuickCheckCommandLineOptions'
    , introduceQuickCheckCommandLineOptions''
  
    -- * Prop
    , prop
  
    -- * Modifying QuickCheck args
    , modifyArgs
    , modifyMaxSuccess
    , modifyMaxDiscardRatio
    , modifyMaxSize
    , modifyMaxShrinks
  
    -- * Types
    , HasQuickCheckContext
    ) where
  
  import Control.Monad.Free
  import Control.Monad.IO.Class
  import Data.Maybe
  import qualified Data.Text as T
  import GHC.Stack
  import Test.QuickCheck as QC
  import Test.QuickCheck.Random as QC
  import Test.Sandwich
  import Test.Sandwich.Internal
  import UnliftIO.Exception
  
  
  data QuickCheckContext = QuickCheckContext Args
    deriving Show
  quickCheckContext :: Label "quickCheckContext" QuickCheckContext
  quickCheckContext = Label
  type HasQuickCheckContext context = HasLabel context "quickCheckContext" QuickCheckContext
  
  data QuickCheckException = QuickCheckException
    deriving (Show)
  instance Exception QuickCheckException
  
  -- | Same as 'introduceQuickCheck'' but with default args.
  introduceQuickCheck :: (MonadIO m)
    => SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  introduceQuickCheck = introduceQuickCheck'' "Introduce QuickCheck context" stdArgs
  
  -- | Same as 'introduceQuickCheck''' but with a default message.
  introduceQuickCheck' :: (MonadIO m)
    => Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  introduceQuickCheck' = introduceQuickCheck'' "Introduce QuickCheck context"
  
  -- | Introduce QuickCheck args with configurable message.
  introduceQuickCheck'' :: (MonadIO m)
    => String -> Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  introduceQuickCheck'' msg args = introduce msg quickCheckContext (return $ QuickCheckContext args) (const $ return ())
  
  
  -- | Same as 'introduceQuickCheckCommandLineOptions'' but with default args.
  introduceQuickCheckCommandLineOptions :: forall a m context. (MonadIO m, HasLabel context "commandLineOptions" (CommandLineOptions a))
    => SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  introduceQuickCheckCommandLineOptions = introduceQuickCheckCommandLineOptions'' @a "Introduce QuickCheck context with command line options" stdArgs
  
  -- | Same as 'introduceQuickCheckCommandLineOptions''' but with a default message.
  introduceQuickCheckCommandLineOptions' :: forall a m context. (MonadIO m, HasLabel context "commandLineOptions" (CommandLineOptions a))
    => Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  introduceQuickCheckCommandLineOptions' = introduceQuickCheckCommandLineOptions'' @a "Introduce QuickCheck context with command line options"
  
  -- | Introduce QuickCheck args with configurable message, overriding those args with any command line options passed.
  introduceQuickCheckCommandLineOptions'' :: forall a m context. (MonadIO m, HasLabel context "commandLineOptions" (CommandLineOptions a))
    => String -> Args -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  introduceQuickCheckCommandLineOptions'' msg args = introduce msg quickCheckContext getContext' (const $ return ())
    where
      getContext' = do
        clo <- getCommandLineOptions @a
        return $ QuickCheckContext $ addCommandLineOptions clo args
  
  
  -- | Similar to 'it'. Runs the given prop with QuickCheck using the currently introduced 'Args'. Throws an appropriate exception on failure.
  prop :: (HasCallStack, HasQuickCheckContext context, MonadIO m, Testable prop) => String -> prop -> Free (SpecCommand context m) ()
  prop msg p = it msg $ do
    QuickCheckContext args <- getContext quickCheckContext
    liftIO (quickCheckWithResult (args { QC.chatty = False }) p) >>= \case
      QC.Success {..} -> info (T.pack output)
      x -> throwIO $ Reason (Just callStack) (output x)
  
  -- | Modify the 'Args' for the given spec.
  modifyArgs :: (HasQuickCheckContext context, Monad m) => (Args -> Args) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  modifyArgs f = introduce "Modified QuickCheck context" quickCheckContext acquire (const $ return ())
    where
      acquire = do
         QuickCheckContext args <- getContext quickCheckContext
         return $ QuickCheckContext (f args)
  
  -- | Modify the 'maxSuccess' for the given spec.
  modifyMaxSuccess :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  modifyMaxSuccess f = modifyArgs $ \args -> args { maxSuccess = f (maxSuccess args) }
  
  -- | Modify the 'maxDiscardRatio' for the given spec.
  modifyMaxDiscardRatio :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  modifyMaxDiscardRatio f = modifyArgs $ \args -> args { maxDiscardRatio = f (maxDiscardRatio args) }
  
  -- | Modify the 'maxSize' for the given spec.
  modifyMaxSize :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  modifyMaxSize f = modifyArgs $ \args -> args { maxSize = f (maxSize args) }
  
  -- | Modify the 'maxShrinks' for the given spec.
  modifyMaxShrinks :: (HasQuickCheckContext context, Monad m) => (Int -> Int) -> SpecFree (LabelValue "quickCheckContext" QuickCheckContext :> context) m () -> SpecFree context m ()
  modifyMaxShrinks f = modifyArgs $ \args -> args { maxShrinks = f (maxShrinks args) }
  
  addCommandLineOptions :: CommandLineOptions a -> Args -> Args
  addCommandLineOptions (CommandLineOptions {optQuickCheckOptions=(CommandLineQuickCheckOptions {..})}) baseArgs@(Args {..}) = baseArgs {
    replay = maybe replay (\n -> Just (mkQCGen (fromIntegral n), 0)) optQuickCheckSeed
    , maxDiscardRatio = fromMaybe maxSuccess optQuickCheckMaxDiscardRatio
    , maxSize = fromMaybe maxSuccess optQuickCheckMaxSize
    , maxSuccess = fromMaybe maxSuccess optQuickCheckMaxSuccess
    , maxShrinks = fromMaybe maxSuccess optQuickCheckMaxShrinks
    }
  