skeletest
Safe HaskellNone
LanguageGHC2021

Skeletest

Synopsis

Spec

type Spec = Spec' () Source #

describe :: String -> Spec -> Spec Source #

The entity or concept being tested.

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

Instances details
IsMarker AnonMarker Source # 
Instance details

Defined in Skeletest.Internal.Markers

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

data Predicate (m :: Type -> Type) a Source #

class MonadIO m => Testable (m :: Type -> Type) Source #

Minimal complete definition

runTestable, context, throwFailure

Instances

Instances details
Testable IO Source # 
Instance details

Defined in Skeletest.Assertions

Testable PropertyM Source # 
Instance details

Defined in Skeletest.Prop.Internal

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.

data PropertyM a Source #

Instances

Instances details
MonadIO PropertyM Source # 
Instance details

Defined in Skeletest.Prop.Internal

Methods

liftIO :: IO a -> PropertyM a #

Applicative PropertyM Source # 
Instance details

Defined in Skeletest.Prop.Internal

Methods

pure :: a -> PropertyM a #

(<*>) :: PropertyM (a -> b) -> PropertyM a -> PropertyM b #

liftA2 :: (a -> b -> c) -> PropertyM a -> PropertyM b -> PropertyM c #

(*>) :: PropertyM a -> PropertyM b -> PropertyM b #

(<*) :: PropertyM a -> PropertyM b -> PropertyM a #

Functor PropertyM Source # 
Instance details

Defined in Skeletest.Prop.Internal

Methods

fmap :: (a -> b) -> PropertyM a -> PropertyM b #

(<$) :: a -> PropertyM b -> PropertyM a #

Monad PropertyM Source # 
Instance details

Defined in Skeletest.Prop.Internal

Methods

(>>=) :: PropertyM a -> (a -> PropertyM b) -> PropertyM b #

(>>) :: PropertyM a -> PropertyM b -> PropertyM b #

return :: a -> PropertyM a #

Testable PropertyM Source # 
Instance details

Defined in Skeletest.Prop.Internal

type Gen = GenT Identity #

Generator for random values of a.

Fixtures

class Typeable a => Fixture a where Source #

Minimal complete definition

fixtureAction

Methods

fixtureScope :: FixtureScope Source #

The scope of the fixture, defaults to per-test

fixtureAction :: IO (a, FixtureCleanup) Source #

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 

CLI flags

data Flag Source #

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
  ]

Constructors

IsFlag a => Flag (Proxy a) 

data FlagSpec a Source #

Constructors

SwitchFlag 

Fields

RequiredFlag 

Fields

OptionalFlag 

Fields

getFlag :: forall a m. (MonadIO m, IsFlag a) => m a Source #