Safe Haskell | None |
---|---|
Language | GHC2021 |
Skeletest
Synopsis
- type Spec = Spec' ()
- describe :: String -> Spec -> Spec
- it :: String -> IO () -> Spec
- prop :: String -> Property -> Spec
- xfail :: String -> Spec -> Spec
- skip :: String -> Spec -> Spec
- markManual :: Spec -> Spec
- class (Show a, Typeable a) => IsMarker a where
- getMarkerName :: a -> String
- withMarkers :: [String] -> Spec -> Spec
- withMarker :: IsMarker a => a -> Spec -> Spec
- shouldBe :: (HasCallStack, Testable m, Eq a) => a -> a -> m ()
- shouldNotBe :: (HasCallStack, Testable m, Eq a) => a -> a -> m ()
- shouldSatisfy :: (HasCallStack, Testable m) => a -> Predicate m a -> m ()
- shouldNotSatisfy :: (HasCallStack, Testable m) => a -> Predicate m a -> m ()
- context :: Testable m => String -> m a -> m a
- failTest :: (HasCallStack, Testable m) => String -> m a
- type HasCallStack = ?callStack :: CallStack
- data Predicate (m :: Type -> Type) a
- class MonadIO m => Testable (m :: Type -> Type)
- type Property = PropertyM ()
- data PropertyM a
- type Gen = GenT Identity
- forAll :: (HasCallStack, Show a) => Gen a -> PropertyM a
- discard :: PropertyM a
- class Typeable a => Fixture a where
- fixtureScope :: FixtureScope
- fixtureAction :: IO (a, FixtureCleanup)
- data FixtureScope
- data FixtureCleanup
- = NoCleanup
- | CleanupFunc (IO ())
- getFixture :: (Fixture a, MonadIO m) => m a
- noCleanup :: a -> (a, FixtureCleanup)
- withCleanup :: a -> IO () -> (a, FixtureCleanup)
- newtype FixtureTmpDir = FixtureTmpDir FilePath
- data Flag = IsFlag a => Flag (Proxy a)
- class Typeable a => IsFlag a where
- data FlagSpec a
- = SwitchFlag {
- flagFromBool :: Bool -> a
- | RequiredFlag { }
- | OptionalFlag {
- flagDefault :: a
- flagParse :: String -> Either String a
- = SwitchFlag {
- getFlag :: forall a m. (MonadIO m, IsFlag a) => m a
Spec
it :: String -> IO () -> Spec Source #
Define an IO-based test.
Should typically be written to be read as full sentences in traditional BDD style: https://en.wikipedia.org/wiki/Behavior-driven_development.
describe "User" $ do
it "can be checked for equality" $ do
user1 shouldBe
user1
prop :: String -> Property -> Spec Source #
Define a property test.
describe "User" $ do prop "decode . encode === Just" $ do let genUser = ... (decode . encode) P.=== Just `shouldSatisfy` P.isoWith genUser
Modifiers
xfail :: String -> Spec -> Spec Source #
Mark the given spec as expected to fail. Fails tests if they unexpectedly pass.
Can be selected with the marker @xfail
skip :: String -> Spec -> Spec Source #
Skip all tests in the given spec.
Can be selected with the marker @skip
markManual :: Spec -> Spec Source #
Mark tests as tests that should only be run when explicitly specified on the command line.
Markers
class (Show a, Typeable a) => IsMarker a where Source #
Methods
getMarkerName :: a -> String Source #
The name of the marker that can be selected with @name
syntax.
Marker names must only include alphanumeric characters, hyphens, underscores, and periods.
Instances
IsMarker AnonMarker Source # | |
Defined in Skeletest.Internal.Markers Methods getMarkerName :: AnonMarker -> String Source # |
withMarkers :: [String] -> Spec -> Spec Source #
Adds the given names as plain markers to all tests in the given spec.
See getMarkerName
.
withMarker :: IsMarker a => a -> Spec -> Spec Source #
Adds the given marker to all the tests in the given spec.
Useful for selecting tests from the command line or identifying tests in hooks
Assertions
shouldBe :: (HasCallStack, Testable m, Eq a) => a -> a -> m () infix 1 Source #
Assert that the given input should match the given value.
Equivalent to actual
shouldSatisfy
P.eq expected
shouldNotBe :: (HasCallStack, Testable m, Eq a) => a -> a -> m () infix 1 Source #
Assert that the given input should not match the given value.
Equivalent to actual
shouldNotSatisfy
P.eq expected
shouldSatisfy :: (HasCallStack, Testable m) => a -> Predicate m a -> m () infix 1 Source #
Assert that the given input should satisfy the given predicate.
shouldNotSatisfy :: (HasCallStack, Testable m) => a -> Predicate m a -> m () infix 1 Source #
Assert that the given input should not satisfy the given predicate.
context :: Testable m => String -> m a -> m a Source #
Add any context to display if the test fails.
>>>
(code, stdout) <- runCommand ...
>>>
context stdout $ code `shouldBe` ExitSuccess
failTest :: (HasCallStack, Testable m) => String -> m a Source #
Unconditionally fail the test with the given message.
type HasCallStack = ?callStack :: CallStack #
Request a CallStack.
NOTE: The implicit parameter ?callStack :: CallStack
is an
implementation detail and should not be considered part of the
CallStack
API, we may decide to change the implementation in the
future.
@since base-4.9.0.0
class MonadIO m => Testable (m :: Type -> Type) Source #
Minimal complete definition
Instances
Testable IO Source # | |
Defined in Skeletest.Assertions Methods runTestable :: IO () -> IO TestResult Source # context :: String -> IO a -> IO a Source # throwFailure :: AssertionFail -> IO a Source # | |
Testable PropertyM Source # | |
Defined in Skeletest.Prop.Internal Methods runTestable :: PropertyM () -> IO TestResult Source # context :: String -> PropertyM a -> PropertyM a Source # throwFailure :: AssertionFail -> PropertyM a Source # |
Properties
type Property = PropertyM () Source #
A property to run, with optional configuration settings specified up front.
Settings should be specified before any other Property
calls; any settings
specified afterwards are ignored.
Instances
MonadIO PropertyM Source # | |
Defined in Skeletest.Prop.Internal | |
Applicative PropertyM Source # | |
Functor PropertyM Source # | |
Monad PropertyM Source # | |
Testable PropertyM Source # | |
Defined in Skeletest.Prop.Internal Methods runTestable :: PropertyM () -> IO TestResult Source # context :: String -> PropertyM a -> PropertyM a Source # throwFailure :: AssertionFail -> PropertyM a Source # |
Fixtures
class Typeable a => Fixture a where Source #
Minimal complete definition
Methods
fixtureScope :: FixtureScope Source #
The scope of the fixture, defaults to per-test
fixtureAction :: IO (a, FixtureCleanup) Source #
Instances
Fixture FixtureTmpDir Source # | |
Defined in Skeletest.Internal.Fixtures Methods fixtureScope :: FixtureScope Source # fixtureAction :: IO (FixtureTmpDir, FixtureCleanup) Source # |
data FixtureScope Source #
Constructors
PerTestFixture | |
PerFileFixture | |
PerSessionFixture |
Instances
Show FixtureScope Source # | |
Defined in Skeletest.Internal.Fixtures Methods showsPrec :: Int -> FixtureScope -> ShowS # show :: FixtureScope -> String # showList :: [FixtureScope] -> ShowS # |
data FixtureCleanup Source #
Constructors
NoCleanup | |
CleanupFunc (IO ()) |
getFixture :: (Fixture a, MonadIO m) => m a Source #
Load a fixture, initializing it if it hasn't been cached already.
noCleanup :: a -> (a, FixtureCleanup) Source #
A helper for specifying no cleanup.
withCleanup :: a -> IO () -> (a, FixtureCleanup) Source #
A helper for defining the cleanup function in-line.
Built-in fixtures
newtype FixtureTmpDir Source #
A fixture that provides a temporary directory that can be used in a test.
Constructors
FixtureTmpDir FilePath |
Instances
Fixture FixtureTmpDir Source # | |
Defined in Skeletest.Internal.Fixtures Methods fixtureScope :: FixtureScope Source # fixtureAction :: IO (FixtureTmpDir, FixtureCleanup) Source # |
CLI flags
Register a CLI flag.
Usage:
{- MyFixture.hs -} import Skeletest newtype MyFlag = MyFlag String instance IsFlag MyFlag where flagName = "my-flag" flagHelp = "The value for MyFixture" flagSpec = OptionalFlag { flagDefault = "foo" , flagParse = case "illegal" -> Left "invalid flag value" s -> Right (MyFlag s) } instance Fixture MyFixture where fixtureAction = do MyFlag val <- getFlag ... {- Main.hs -} import MyFixture cliFlags = [ flag @MyFlag ]
class Typeable a => IsFlag a where Source #
Methods
flagShort :: Maybe Char Source #
flagMetaVar :: String Source #
The placeholder for the flag to show in the help text, if the flag takes an argument.
Instances
Constructors
SwitchFlag | |
Fields
| |
RequiredFlag | |
OptionalFlag | |
Fields
|