module Test.Tasty.Hspec (
testSpec
, SmallCheckDepth(..)
, QuickCheckMaxRatio(..)
, QuickCheckMaxSize(..)
, QuickCheckReplay(..)
, QuickCheckTests(..)
, module Test.Hspec
) where
import Control.Applicative ((<$>))
import Data.Proxy
import Data.Typeable (Typeable)
import qualified Test.Hspec as H
import qualified Test.Hspec.Core.Spec as H
import qualified Test.QuickCheck as QC
import qualified Test.Tasty as T
import qualified Test.Tasty.SmallCheck as TSC
import qualified Test.Tasty.Options as T
import qualified Test.Tasty.Providers as T
import qualified Test.Tasty.QuickCheck as TQC
import qualified Test.Tasty.Runners as T
import Test.Hspec
import Test.Tasty.SmallCheck (SmallCheckDepth(..))
import Test.Tasty.QuickCheck (QuickCheckMaxRatio(..), QuickCheckMaxSize(..)
, QuickCheckReplay(..), QuickCheckTests(..))
testSpec :: T.TestName -> H.Spec -> IO T.TestTree
testSpec name spec = T.testGroup name . map specTreeToTestTree <$> H.runSpecM spec
specTreeToTestTree :: H.SpecTree () -> T.TestTree
specTreeToTestTree (H.Node name spec_trees) = T.testGroup name (map specTreeToTestTree spec_trees)
specTreeToTestTree (H.NodeWithCleanup cleanup spec_trees) =
let test_tree = specTreeToTestTree (H.Node "(unnamed)" spec_trees)
in T.WithResource (T.ResourceSpec (return ()) cleanup) (const test_tree)
specTreeToTestTree (H.Leaf item) = T.singleTest (H.itemRequirement item) (Item item)
hspecResultToTastyResult :: H.Result -> T.Result
hspecResultToTastyResult H.Success = T.testPassed ""
hspecResultToTastyResult (H.Pending mstr) = T.testFailed ("test pending" ++ maybe "" (": " ++) mstr)
hspecResultToTastyResult (H.Fail str) = T.testFailed str
newtype Item = Item (H.Item ())
deriving Typeable
instance T.IsTest Item where
run opts (Item (H.Item _ _ _ ex)) progress =
hspecResultToTastyResult <$> ex params ($ ()) hprogress
where
params :: H.Params
params = H.Params
{ H.paramsQuickCheckArgs = qc_args
, H.paramsSmallCheckDepth = sc_depth
}
where
qc_args :: QC.Args
qc_args =
let TQC.QuickCheckTests num_tests = T.lookupOption opts
TQC.QuickCheckReplay replay = T.lookupOption opts
TQC.QuickCheckMaxSize max_size = T.lookupOption opts
TQC.QuickCheckMaxRatio max_ratio = T.lookupOption opts
in QC.stdArgs
{ QC.chatty = False
, QC.maxDiscardRatio = max_ratio
, QC.maxSize = max_size
, QC.maxSuccess = num_tests
, QC.replay = replay
}
sc_depth :: Int
sc_depth = let TSC.SmallCheckDepth depth = T.lookupOption opts in depth
hprogress :: H.Progress -> IO ()
hprogress (x,y) = progress $ T.Progress
{ T.progressText = ""
, T.progressPercent = fromIntegral x / fromIntegral y
}
testOptions = return
[ T.Option (Proxy :: Proxy TQC.QuickCheckTests)
, T.Option (Proxy :: Proxy TQC.QuickCheckReplay)
, T.Option (Proxy :: Proxy TQC.QuickCheckMaxSize)
, T.Option (Proxy :: Proxy TQC.QuickCheckMaxRatio)
, T.Option (Proxy :: Proxy TSC.SmallCheckDepth)
]