    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE CPP #-}

    -- | 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.Monad.Trans.Writer (mapWriterT)
    import Control.Arrow (second)

    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 :: 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 (Proxy a
    forall k (t :: k). Proxy t
    Proxy @a)
       in if ' ' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    s
            then "(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")"
            else String
    s

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

    binRelStr ::
           forall a. Typeable a
        => String
        -> String
    binRelStr :: String -> String
    binRelStr op :: String
    op = [String] -> String
    unwords ["(" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    op String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ")", "::", String
    name, "->", String
    name, "->", "Bool"]
      where
        name :: String
    name = 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 _ = "Anonymous"

    instance Functor Anon where
        fmap :: (a -> b) -> Anon a -> Anon b
    fmap f :: a -> b
    f (Anon a :: 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
    mapSpecTree' :: (SpecTree a -> SpecTree b) -> SpecM a r -> SpecM b r
    mapSpecTree' f :: SpecTree a -> SpecTree b
    f (SpecM specs :: WriterT [SpecTree a] IO r
    specs) = WriterT [SpecTree b] IO r -> SpecM b r
    forall a r. WriterT [SpecTree a] IO r -> SpecM a r
    SpecM ((IO (r, [SpecTree a]) -> IO (r, [SpecTree b]))
    -> WriterT [SpecTree a] IO r -> WriterT [SpecTree b] 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, [SpecTree a]) -> (r, [SpecTree b]))
    -> IO (r, [SpecTree a]) -> IO (r, [SpecTree b])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (([SpecTree a] -> [SpecTree b])
    -> (r, [SpecTree a]) -> (r, [SpecTree b])
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((SpecTree a -> SpecTree b) -> [SpecTree a] -> [SpecTree b]
    forall a b. (a -> b) -> [a] -> [b]
    map SpecTree a -> SpecTree b
    f))) WriterT [SpecTree a] IO r
    specs)

    -- | 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 s :: 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 sp :: SpecTree ()
    sp =
            Item () -> SpecTree ()
    forall c a. a -> Tree c a
    Leaf
                Item :: forall a.
    String
    -> Maybe Location
    -> Maybe Bool
    -> Bool
    -> (Params
        -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result)
    -> Item a
    Item
                    { itemRequirement :: String
    itemRequirement = String
    s
                    , itemLocation :: Maybe Location
    itemLocation = Maybe Location
    forall a. Maybe a
    Nothing
    #if MIN_VERSION_hspec_core(2,6,0)
                    , itemIsFocused :: Bool
    itemIsFocused = Bool
    False
    #endif
    #if MIN_VERSION_hspec_core(2,5,0)
                    , itemIsParallelizable :: Maybe Bool
    itemIsParallelizable = Maybe Bool
    forall a. Maybe a
    Nothing
    #else
                    , itemIsParallelizable = False
    #endif
                    , itemExample :: Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
    itemExample =
                          \_ _ _ -> 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
    > 0 Bool -> Bool -> Bool
    && Summary -> Int
    summaryFailures Summary
    r Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0
                              Result -> IO Result
    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
                    }
    #if MIN_VERSION_hspec_core(2,4,0)
    #if MIN_VERSION_hspec_core(2,5,0)
    produceResult :: Bool -> Test.Hspec.Core.Spec.Result
    produceResult :: Bool -> Result
    produceResult succesful :: Bool
    succesful = Result :: String -> ResultStatus -> Result
    Result
      { resultInfo :: String
    resultInfo = ""
      , 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
    Reason "Should have failed but didn't."
      }
    #else
    produceResult :: Bool -> Either a Test.Hspec.Core.Spec.Result
    produceResult succesful =
        Right $
        if succesful
            then Success
            else Failure Nothing $ Reason "Should have failed but didn't."
    #endif
    #else
    produceResult :: Bool -> Test.Hspec.Core.Spec.Result
    produceResult succesful =
        if succesful
            then Success
            else Fail Nothing "Should have failed but didn't."
    #endif
    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
    $ \res :: Result
    res ->
            Result
    res
                { reason :: String
    reason = [String] -> String
    unwords ["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
                }