    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# OPTIONS_GHC -Wno-deprecations #-}

    -- | Utilities for defining your own validity 'Spec's
    --
    -- You will need @TypeApplications@ to use these.
    module Test.Validity.Utils
      ( nameOf,
        genDescr,
        binRelStr,
        shouldFail,
        failsBecause,
        Anon (..),
        shouldBeValid,
        shouldBeInvalid,
      )
    where

    import Control.Arrow (second)
    import Control.Monad.Trans.Writer (mapWriterT)
    import Data.Data
    import Test.Hspec
    import Test.Hspec.Core.Formatters
    import Test.Hspec.Core.Runner
    import Test.Hspec.Core.Spec
    import Test.QuickCheck.Property
    import Test.Validity.Property.Utils

    nameOf ::
      forall a.
      Typeable a =>
      String
    nameOf :: forall {k} (a :: k). Typeable a => String
    nameOf =
      let s :: String
    s = TypeRep -> String
    forall a. Show a => a -> String
    show (TypeRep -> String) -> TypeRep -> String
    forall a b. (a -> b) -> a -> b
    $ Proxy a -> TypeRep
    forall {k} (proxy :: k -> *) (a :: k).
    Typeable a =>
    proxy a -> TypeRep
    typeRep (forall (t :: k). Proxy t
    forall {k} (t :: k). Proxy t
    Proxy @a)
       in if Char
    ' ' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    s
            then String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
            else String
    s

    genDescr ::
      forall a.
      Typeable a =>
      String ->
      String
    genDescr :: forall {k} (a :: k). Typeable a => String -> String
    genDescr String
    genname = [String] -> String
    unwords [String
    "\"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    genname, String
    "::", forall (a :: k). Typeable a => String
    forall {k} (a :: k). Typeable a => String
    nameOf @a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\""]

    binRelStr ::
      forall a.
      Typeable a =>
      String ->
      String
    binRelStr :: forall {k} (a :: k). Typeable a => String -> String
    binRelStr String
    op = [String] -> String
    unwords [String
    "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    op String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ")", String
    "::", String
    name, String
    "->", String
    name, String
    "->", String
    "Bool"]
      where
        name :: String
    name = forall (a :: k). Typeable a => String
    forall {k} (a :: k). Typeable a => String
    nameOf @a

    newtype Anon a
      = Anon a

    instance Show (Anon a) where
      show :: Anon a -> String
    show Anon a
    _ = String
    "Anonymous"

    instance Functor Anon where
      fmap :: forall a b. (a -> b) -> Anon a -> Anon b
    fmap a -> b
    f (Anon a
    a) = b -> Anon b
    forall a. a -> Anon a
    Anon (a -> b
    f a
    a)

    -- I'm not sure why mapSpecTree was removed from hspec-core,
    -- but it has been copied here for convenience.
    -- https://github.com/hspec/hspec/commit/020c7ecc4a73c24af38e9fab049f60bb9aec6981#diff-29cb22f0ef6e98086a71fc045847bd21L22
    mapSpecTree' :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r

    #if MIN_VERSION_hspec(2,10,0)
    mapSpecTree' :: forall a b r. (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r
    mapSpecTree' SpecTree a -> SpecTree b
    f (SpecM WriterT (Endo Config, [SpecTree a]) (ReaderT Env IO) r
    specs) = WriterT (Endo Config, [SpecTree b]) (ReaderT Env IO) r -> SpecM b r
    forall a r.
    WriterT (Endo Config, [SpecTree a]) (ReaderT Env IO) r -> SpecM a r
    SpecM ((ReaderT Env IO (r, (Endo Config, [SpecTree a]))
     -> ReaderT Env IO (r, (Endo Config, [SpecTree b])))
    -> WriterT (Endo Config, [SpecTree a]) (ReaderT Env IO) r
    -> WriterT (Endo Config, [SpecTree b]) (ReaderT Env IO) r
    forall (m :: * -> *) a w (n :: * -> *) b w'.
    (m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
    mapWriterT (((r, (Endo Config, [SpecTree a]))
     -> (r, (Endo Config, [SpecTree b])))
    -> ReaderT Env IO (r, (Endo Config, [SpecTree a]))
    -> ReaderT Env IO (r, (Endo Config, [SpecTree b]))
    forall a b. (a -> b) -> ReaderT Env IO a -> ReaderT Env IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((Endo Config, [SpecTree a]) -> (Endo Config, [SpecTree b]))
    -> (r, (Endo Config, [SpecTree a]))
    -> (r, (Endo Config, [SpecTree b]))
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (([SpecTree a] -> [SpecTree b])
    -> (Endo Config, [SpecTree a]) -> (Endo Config, [SpecTree b])
    forall a b. (a -> b) -> (Endo Config, a) -> (Endo Config, b)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((SpecTree a -> SpecTree b) -> [SpecTree a] -> [SpecTree b]
    forall a b. (a -> b) -> [a] -> [b]
    map SpecTree a -> SpecTree b
    f)))) WriterT (Endo Config, [SpecTree a]) (ReaderT Env IO) r
    specs)
    #else
    mapSpecTree' f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs)
    #endif

    -- | Asserts that a given 'Spec' tree fails _somewhere_.
    --
    -- It also shows the given string when reporting that the tree unexpectedly
    -- succeeded.
    failsBecause :: String -> SpecWith () -> SpecWith ()
    failsBecause :: String -> SpecWith () -> SpecWith ()
    failsBecause String
    s = (SpecTree () -> SpecTree ()) -> SpecWith () -> SpecWith ()
    forall a b r. (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r
    mapSpecTree' SpecTree () -> SpecTree ()
    go
      where
        go :: SpecTree () -> SpecTree ()
        go :: SpecTree () -> SpecTree ()
    go SpecTree ()
    sp =
          Item () -> SpecTree ()
    forall c a. a -> Tree c a
    Leaf
            Item
              { itemRequirement :: String
    itemRequirement = String
    s,
                itemLocation :: Maybe Location
    itemLocation = Maybe Location
    forall a. Maybe a
    Nothing,
                itemIsFocused :: Bool
    itemIsFocused = Bool
    False,
                itemIsParallelizable :: Maybe Bool
    itemIsParallelizable = Maybe Bool
    forall a. Maybe a
    Nothing,
                itemExample :: Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
    itemExample =
                  \Params
    _ ActionWith () -> IO ()
    _ ProgressCallback
    _ -> do
                    let conf :: Config
    conf =
                          Config
    defaultConfig {configFormatter :: Maybe Formatter
    configFormatter = Formatter -> Maybe Formatter
    forall a. a -> Maybe a
    Just Formatter
    silent}
                    Summary
    r <- Config -> SpecWith () -> IO Summary
    hspecWithResult Config
    conf (SpecWith () -> IO Summary) -> SpecWith () -> IO Summary
    forall a b. (a -> b) -> a -> b
    $ [SpecTree ()] -> SpecWith ()
    forall a. [SpecTree a] -> SpecWith a
    fromSpecList [SpecTree ()
    sp]
                    let succesful :: Bool
    succesful =
                          Summary -> Int
    summaryExamples Summary
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 Bool -> Bool -> Bool
    && Summary -> Int
    summaryFailures Summary
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0
                    Result -> IO Result
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ Bool -> Result
    produceResult Bool
    succesful
              }

    produceResult :: Bool -> Test.Hspec.Core.Spec.Result
    produceResult :: Bool -> Result
    produceResult Bool
    succesful =
      Result
        { resultInfo :: String
    resultInfo = String
    "",
          resultStatus :: ResultStatus
    resultStatus =
            if Bool
    succesful
              then ResultStatus
    Success
              else Maybe Location -> FailureReason -> ResultStatus
    Failure Maybe Location
    forall a. Maybe a
    Nothing (FailureReason -> ResultStatus) -> FailureReason -> ResultStatus
    forall a b. (a -> b) -> a -> b
    $ String -> FailureReason
    Test.Hspec.Core.Spec.Reason String
    "Should have failed but didn't."
        }

    shouldFail :: Property -> Property
    shouldFail :: Property -> Property
    shouldFail =
      (Result -> Result) -> Property -> Property
    forall prop.
    Testable prop =>
    (Result -> Result) -> prop -> Property
    mapResult ((Result -> Result) -> Property -> Property)
    -> (Result -> Result) -> Property -> Property
    forall a b. (a -> b) -> a -> b
    $ \Result
    res ->
        Result
    res
          { reason :: String
    reason = [String] -> String
    unwords [String
    "Should have failed:", Result -> String
    reason Result
    res],
            expect :: Bool
    expect = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Result -> Bool
    expect Result
    res
          }