{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | This module defines all the functions you will use to define your test suite.
module Test.Syd.Def.Specify
  ( -- * API Functions

    -- ** Declaring tests
    describe,
    it,
    itWithOuter,
    itWithBoth,
    itWithAll,
    specify,
    specifyWithOuter,
    specifyWithBoth,
    specifyWithAll,

    -- ** Declaring commented-out tests
    xdescribe,
    xit,
    xitWithOuter,
    xitWithBoth,
    xitWithAll,
    xspecify,
    xspecifyWithOuter,
    xspecifyWithBoth,
    xspecifyWithAll,

    -- ** Pending tests
    pending,
    pendingWith,
  )
where

import Control.Monad.RWS.Strict
import qualified Data.Text as T
import GHC.Stack
import Test.QuickCheck.IO ()
import Test.Syd.Def.TestDefM
import Test.Syd.HList
import Test.Syd.Run
import Test.Syd.SpecDef

-- | Declare a test group
--
-- === Example usage:
--
-- > describe "addition" $ do
-- >     it "adds 3 to 5 to result in 8" $
-- >         3 + 5 `shouldBe` 8
-- >     it "adds 4 to 7 to result in 11" $
-- >         4 + 7 `shouldBe` 11
describe :: String -> TestDefM a b () -> TestDefM a b ()
describe :: String -> TestDefM a b () -> TestDefM a b ()
describe String
s TestDefM a b ()
func = ([SpecDefTree a b ()] -> [SpecDefTree a b ()])
-> TestDefM a b () -> TestDefM a b ()
forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor ((SpecDefTree a b () -> [SpecDefTree a b ()] -> [SpecDefTree a b ()]
forall a. a -> [a] -> [a]
: []) (SpecDefTree a b () -> [SpecDefTree a b ()])
-> ([SpecDefTree a b ()] -> SpecDefTree a b ())
-> [SpecDefTree a b ()]
-> [SpecDefTree a b ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [SpecDefTree a b ()] -> SpecDefTree a b ()
forall (a :: [*]) c e.
Text -> SpecDefForest a c e -> SpecDefTree a c e
DefDescribeNode (String -> Text
T.pack String
s)) TestDefM a b ()
func

-- TODO maybe we want to keep all tests below but replace them with a "Pending" instead.
xdescribe :: String -> TestDefM a b () -> TestDefM a b ()
xdescribe :: String -> TestDefM a b () -> TestDefM a b ()
xdescribe String
s TestDefM a b ()
_ = String -> TestDefM a b ()
forall (a :: [*]) b. String -> TestDefM a b ()
pending String
s

-- | Declare a test
--
-- __Note: Don't look at the type signature unless you really have to, just follow the examples.__
--
-- === Example usage:
--
-- ==== Tests without resources
--
-- ===== Pure test
--
-- > describe "addition" $
-- >     it "adds 3 to 5 to result in 8" $
-- >         3 + 5 == 8
--
--
-- ===== IO test
--
-- > describe "readFile and writeFile" $
-- >     it "reads back what it wrote for this example" $ do
-- >         let cts = "hello world"
-- >         let fp = "test.txt"
-- >         writeFile fp cts
-- >         cts' <- readFile fp
-- >         cts' `shouldBe` cts
--
--
-- ===== Pure Property test
--
-- > describe "sort" $
-- >     it "is idempotent" $
-- >         forAllValid $ \ls ->
-- >             sort (sort ls) `shouldBe` (sort (ls :: [Int]))
--
--
-- ===== IO Property test
--
-- > describe "readFile and writeFile" $
-- >     it "reads back what it wrote for any example" $ do
-- >         forAllValid $ \fp ->
-- >             forAllValid $ \cts -> do
-- >                 writeFile fp cts
-- >                 cts' <- readFile fp
-- >                 cts' `shouldBe` cts
--
--
-- ==== Tests with an inner resource
--
-- ===== Pure test
--
-- This is quite a rare use-case but here is an example anyway:
--
-- > before (pure 3) $ describe "addition" $
-- >     it "adds 3 to 5 to result in 8" $ \i ->
-- >         i + 5 == 8
--
--
-- ===== IO test
--
-- This test sets up a temporary directory as an inner resource, and makes it available to each test in the group below.
--
-- > let setUpTempDir func = withSystemTempDir $ \tempDir -> func tempDir
-- > in around setUpTempDir describe "readFile and writeFile" $
-- >     it "reads back what it wrote for this example" $ \tempDir -> do
-- >         let cts = "hello world"
-- >         let fp = tempDir </> "test.txt"
-- >         writeFile fp cts
-- >         cts' <- readFile fp
-- >         cts' `shouldBe` cts
--
--
-- ===== Pure property test
--
-- This is quite a rare use-case but here is an example anyway:
--
-- > before (pure 3) $ describe "multiplication" $
-- >     it "is commutative for 5" $ \i ->
-- >         i * 5 == 5 * 3
--
--
-- ===== IO property test
--
-- > let setUpTempDir func = withSystemTempDir $ \tempDir -> func tempDir
-- > in around setUpTempDir describe "readFile and writeFile" $
-- >     it "reads back what it wrote for this example" $ \tempDir ->
-- >         property $ \cts -> do
-- >             let fp = tempDir </> "test.txt"
-- >             writeFile fp cts
-- >             cts' <- readFile fp
-- >             cts' `shouldBe` cts
it :: forall outers test. (HasCallStack, IsTest test, Arg1 test ~ ()) => String -> test -> TestDefM outers (Arg2 test) ()
it :: String -> test -> TestDefM outers (Arg2 test) ()
it String
s test
t = do
  TestRunSettings
sets <- TestDefM outers (Arg2 test) TestRunSettings
forall r (m :: * -> *). MonadReader r m => m r
ask
  let testDef :: TDef
  (((HList outers -> Arg2 test -> IO ()) -> IO ())
   -> IO TestRunResult)
testDef =
        TDef :: forall v. v -> CallStack -> TDef v
TDef
          { testDefVal :: ((HList outers -> Arg2 test -> IO ()) -> IO ()) -> IO TestRunResult
testDefVal = \(HList outers -> Arg2 test -> IO ()) -> IO ()
supplyArgs ->
              test
-> TestRunSettings
-> ((Arg1 test -> Arg2 test -> IO ()) -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest
                test
t
                TestRunSettings
sets
                ( \Arg1 test -> Arg2 test -> IO ()
func -> (HList outers -> Arg2 test -> IO ()) -> IO ()
supplyArgs (\HList outers
_ Arg2 test
arg2 -> Arg1 test -> Arg2 test -> IO ()
func () Arg2 test
arg2)
                ),
            testDefCallStack :: CallStack
testDefCallStack = CallStack
HasCallStack => CallStack
callStack
          }
  [SpecDefTree outers (Arg2 test) ()]
-> TestDefM outers (Arg2 test) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
-> TDef
     (((HList outers -> Arg2 test -> IO ()) -> IO ())
      -> IO TestRunResult)
-> ()
-> SpecDefTree outers (Arg2 test) ()
forall (a :: [*]) c e.
Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> e
-> SpecDefTree a c e
DefSpecifyNode (String -> Text
T.pack String
s) TDef
  (((HList outers -> Arg2 test -> IO ()) -> IO ())
   -> IO TestRunResult)
testDef ()]

xit :: forall outers test. (HasCallStack, IsTest test, Arg1 test ~ ()) => String -> test -> TestDefM outers (Arg2 test) ()
xit :: String -> test -> TestDefM outers (Arg2 test) ()
xit String
s test
_ = String -> TestDefM outers (Arg2 test) ()
forall (a :: [*]) b. String -> TestDefM a b ()
pending String
s

-- | Declare a test that uses an outer resource
--
-- === Example usage:
--
-- ==== Tests with an outer resource
--
-- ===== __Pure test__
--
-- This is quite a rare use-case but here is an example anyway:
--
-- > beforeAll (pure 3) $ describe "addition" $
-- >     itWithBoth "adds 3 to 5 to result in 8" $ \i ->
-- >         i + 5 == 8
--
--
-- ===== IO test
--
-- This test sets up a temporary directory as an inner resource, and makes it available to each test in the group below.
--
-- > let setUpTempDir func = withSystemTempDir $ \tempDir -> func tempDir
-- > in aroundAll setUpTempDir describe "readFile and writeFile" $
-- >     itWithBoth "reads back what it wrote for this example" $ \tempDir -> do
-- >         let cts = "hello world"
-- >         let fp = tempDir </> "test.txt"
-- >         writeFile fp cts
-- >         cts' <- readFile fp
-- >         cts' `shouldBe` cts
--
--
-- ===== __Pure property test__
--
-- This is quite a rare use-case but here is an example anyway:
--
-- > beforeAll (pure 3) $ describe "multiplication" $
-- >     itWithBoth "is commutative for 5" $ \i ->
-- >         i * 5 == 5 * 3
--
--
-- ===== IO property test
--
-- > let setUpTempDir func = withSystemTempDir $ \tempDir -> func tempDir
-- > in aroundAll setUpTempDir describe "readFile and writeFile" $
-- >     itWithBoth "reads back what it wrote for this example" $ \tempDir ->
-- >         property $ \cts -> do
-- >             let fp = tempDir </> "test.txt"
-- >             writeFile fp cts
-- >             cts' <- readFile fp
-- >             cts' `shouldBe` cts
itWithOuter :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg2 test ': l) (Arg1 test) ()
itWithOuter :: String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
itWithOuter String
s test
t = do
  TestRunSettings
sets <- TestDefM (Arg2 test : l) (Arg1 test) TestRunSettings
forall r (m :: * -> *). MonadReader r m => m r
ask
  let testDef :: TDef
  (((HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ())
   -> IO TestRunResult)
testDef =
        TDef :: forall v. v -> CallStack -> TDef v
TDef
          { testDefVal :: ((HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ())
-> IO TestRunResult
testDefVal = \(HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ()
supplyArgs ->
              test
-> TestRunSettings
-> ((Arg1 test -> Arg2 test -> IO ()) -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest
                test
t
                TestRunSettings
sets
                (\Arg1 test -> Arg2 test -> IO ()
func -> (HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ()
supplyArgs ((HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ())
-> (HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(HCons e
outerArgs HList l
_) Arg1 test
innerArg -> Arg1 test -> Arg2 test -> IO ()
func Arg1 test
innerArg e
Arg2 test
outerArgs),
            testDefCallStack :: CallStack
testDefCallStack = CallStack
HasCallStack => CallStack
callStack
          }
  [SpecDefTree (Arg2 test : l) (Arg1 test) ()]
-> TestDefM (Arg2 test : l) (Arg1 test) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
-> TDef
     (((HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ())
      -> IO TestRunResult)
-> ()
-> SpecDefTree (Arg2 test : l) (Arg1 test) ()
forall (a :: [*]) c e.
Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> e
-> SpecDefTree a c e
DefSpecifyNode (String -> Text
T.pack String
s) TDef
  (((HList (Arg2 test : l) -> Arg1 test -> IO ()) -> IO ())
   -> IO TestRunResult)
testDef ()]

xitWithOuter :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg2 test ': l) (Arg1 test) ()
xitWithOuter :: String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
xitWithOuter String
s test
_ = String -> TestDefM (Arg2 test : l) (Arg1 test) ()
forall (a :: [*]) b. String -> TestDefM a b ()
pending String
s

-- | Declare a test that uses both an inner and an outer resource
--
-- === Example usage:
--
-- ==== Tests with both an inner and an outer resource
--
-- ===== __Pure test__
--
-- This is quite a rare use-case but here is an example anyway:
--
-- > beforeAll (pure 3) $ before (pure 5) $ describe "addition" $
-- >     itWithBoth "adds 3 to 5 to result in 8" $ \i j ->
-- >         i + j == 8
--
--
-- ===== IO test
--
-- This test sets up a temporary directory as an inner resource, and makes it available to each test in the group below.
--
-- > let setUpTempDir func = withSystemTempDir $ \tempDir -> func tempDir
-- > in aroundAll setUpTempDir describe "readFile and writeFile" $ before (pure "hello world") $
-- >     itWithBoth "reads back what it wrote for this example" $ \tempDir cts -> do
-- >         let fp = tempDir </> "test.txt"
-- >         writeFile fp cts
-- >         cts' <- readFile fp
-- >         cts' `shouldBe` cts
--
--
-- ===== __Pure property test__
--
-- This is quite a rare use-case but here is an example anyway:
--
-- > beforeAll (pure 3) $ before (pure 5) $ describe "multiplication" $
-- >     itWithBoth "is commutative" $ \i j ->
-- >         i * j == 5 * 3
--
--
-- ===== IO property test
--
-- > let setUpTempDir func = withSystemTempDir $ \tempDir -> func tempDir
-- > in aroundAll setUpTempDir describe "readFile and writeFile" $ before (pure "test.txt") $
-- >     itWithBoth "reads back what it wrote for this example" $ \tempDir fileName ->
-- >         property $ \cts -> do
-- >             let fp = tempDir </> fileName
-- >             writeFile fp cts
-- >             cts' <- readFile fp
-- >             cts' `shouldBe` cts
itWithBoth :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg1 test ': l) (Arg2 test) ()
itWithBoth :: String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
itWithBoth String
s test
t = do
  TestRunSettings
sets <- TestDefM (Arg1 test : l) (Arg2 test) TestRunSettings
forall r (m :: * -> *). MonadReader r m => m r
ask
  let testDef :: TDef
  (((HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ())
   -> IO TestRunResult)
testDef =
        TDef :: forall v. v -> CallStack -> TDef v
TDef
          { testDefVal :: ((HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ())
-> IO TestRunResult
testDefVal = \(HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ()
supplyArgs ->
              test
-> TestRunSettings
-> ((Arg1 test -> Arg2 test -> IO ()) -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest
                test
t
                TestRunSettings
sets
                (\Arg1 test -> Arg2 test -> IO ()
func -> (HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ()
supplyArgs ((HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ())
-> (HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(HCons e
outerArgs HList l
_) Arg2 test
innerArg -> Arg1 test -> Arg2 test -> IO ()
func e
Arg1 test
outerArgs Arg2 test
innerArg),
            testDefCallStack :: CallStack
testDefCallStack = CallStack
HasCallStack => CallStack
callStack
          }
  [SpecDefTree (Arg1 test : l) (Arg2 test) ()]
-> TestDefM (Arg1 test : l) (Arg2 test) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
-> TDef
     (((HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ())
      -> IO TestRunResult)
-> ()
-> SpecDefTree (Arg1 test : l) (Arg2 test) ()
forall (a :: [*]) c e.
Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> e
-> SpecDefTree a c e
DefSpecifyNode (String -> Text
T.pack String
s) TDef
  (((HList (Arg1 test : l) -> Arg2 test -> IO ()) -> IO ())
   -> IO TestRunResult)
testDef ()]

xitWithBoth :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg1 test ': l) (Arg2 test) ()
xitWithBoth :: String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
xitWithBoth String
s test
_ = String -> TestDefM (Arg1 test : l) (Arg2 test) ()
forall (a :: [*]) b. String -> TestDefM a b ()
pending String
s

-- | Declare a test that uses all outer resources
--
-- You will most likely never need this function, but in case you do:
-- Note that this will always require a type annotation, along with the @GADTs@ and @ScopedTypeVariables@ extensions.
--
-- === Example usage
--
-- > beforeAll (pure 'a') $ beforeAll (pure 5) $
-- >     itWithAll "example" $
-- >         \(HCons c (HCons i HNil) :: HList '[Char, Int]) () ->
-- >             (c, i) `shouldeBe` ('a', 5)
itWithAll :: (HasCallStack, IsTest test, Arg1 test ~ HList l) => String -> test -> TestDefM l (Arg2 test) ()
itWithAll :: String -> test -> TestDefM l (Arg2 test) ()
itWithAll String
s test
t = do
  TestRunSettings
sets <- TestDefM l (Arg2 test) TestRunSettings
forall r (m :: * -> *). MonadReader r m => m r
ask
  let testDef :: TDef
  (((HList l -> Arg2 test -> IO ()) -> IO ()) -> IO TestRunResult)
testDef =
        TDef :: forall v. v -> CallStack -> TDef v
TDef
          { testDefVal :: ((HList l -> Arg2 test -> IO ()) -> IO ()) -> IO TestRunResult
testDefVal = \(HList l -> Arg2 test -> IO ()) -> IO ()
supplyArgs ->
              test
-> TestRunSettings
-> ((Arg1 test -> Arg2 test -> IO ()) -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest
                test
t
                TestRunSettings
sets
                (\Arg1 test -> Arg2 test -> IO ()
func -> (HList l -> Arg2 test -> IO ()) -> IO ()
supplyArgs HList l -> Arg2 test -> IO ()
Arg1 test -> Arg2 test -> IO ()
func),
            testDefCallStack :: CallStack
testDefCallStack = CallStack
HasCallStack => CallStack
callStack
          }
  [SpecDefTree l (Arg2 test) ()] -> TestDefM l (Arg2 test) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text
-> TDef
     (((HList l -> Arg2 test -> IO ()) -> IO ()) -> IO TestRunResult)
-> ()
-> SpecDefTree l (Arg2 test) ()
forall (a :: [*]) c e.
Text
-> TDef (((HList a -> c -> IO ()) -> IO ()) -> IO TestRunResult)
-> e
-> SpecDefTree a c e
DefSpecifyNode (String -> Text
T.pack String
s) TDef
  (((HList l -> Arg2 test -> IO ()) -> IO ()) -> IO TestRunResult)
testDef ()]

xitWithAll :: (HasCallStack, IsTest test, Arg1 test ~ HList l) => String -> test -> TestDefM l (Arg2 test) ()
xitWithAll :: String -> test -> TestDefM l (Arg2 test) ()
xitWithAll String
s test
_ = String -> TestDefM l (Arg2 test) ()
forall (a :: [*]) b. String -> TestDefM a b ()
pending String
s

-- | A synonym for 'it'
specify :: forall outers test. (HasCallStack, IsTest test, Arg1 test ~ ()) => String -> test -> TestDefM outers (Arg2 test) ()
specify :: String -> test -> TestDefM outers (Arg2 test) ()
specify = String -> test -> TestDefM outers (Arg2 test) ()
forall (outers :: [*]) test.
(HasCallStack, IsTest test, Arg1 test ~ ()) =>
String -> test -> TestDefM outers (Arg2 test) ()
it

xspecify :: forall outers test. (HasCallStack, IsTest test, Arg1 test ~ ()) => String -> test -> TestDefM outers (Arg2 test) ()
xspecify :: String -> test -> TestDefM outers (Arg2 test) ()
xspecify = String -> test -> TestDefM outers (Arg2 test) ()
forall (outers :: [*]) test.
(HasCallStack, IsTest test, Arg1 test ~ ()) =>
String -> test -> TestDefM outers (Arg2 test) ()
xit

-- | A synonym for 'itWithOuter'
specifyWithOuter :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg2 test ': l) (Arg1 test) ()
specifyWithOuter :: String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
specifyWithOuter = String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
forall test (l :: [*]).
(HasCallStack, IsTest test) =>
String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
itWithOuter

xspecifyWithOuter :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg2 test ': l) (Arg1 test) ()
xspecifyWithOuter :: String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
xspecifyWithOuter = String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
forall test (l :: [*]).
(HasCallStack, IsTest test) =>
String -> test -> TestDefM (Arg2 test : l) (Arg1 test) ()
xitWithOuter

-- | A synonym for 'itWithBoth'
specifyWithBoth :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg1 test ': l) (Arg2 test) ()
specifyWithBoth :: String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
specifyWithBoth = String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
forall test (l :: [*]).
(HasCallStack, IsTest test) =>
String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
itWithBoth

xspecifyWithBoth :: (HasCallStack, IsTest test) => String -> test -> TestDefM (Arg1 test ': l) (Arg2 test) ()
xspecifyWithBoth :: String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
xspecifyWithBoth = String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
forall test (l :: [*]).
(HasCallStack, IsTest test) =>
String -> test -> TestDefM (Arg1 test : l) (Arg2 test) ()
xitWithBoth

-- | A synonym for 'itWithAll'
specifyWithAll :: (HasCallStack, IsTest test, Arg1 test ~ HList l) => String -> test -> TestDefM l (Arg2 test) ()
specifyWithAll :: String -> test -> TestDefM l (Arg2 test) ()
specifyWithAll = String -> test -> TestDefM l (Arg2 test) ()
forall test (l :: [*]).
(HasCallStack, IsTest test, Arg1 test ~ HList l) =>
String -> test -> TestDefM l (Arg2 test) ()
itWithAll

xspecifyWithAll :: (HasCallStack, IsTest test, Arg1 test ~ HList l) => String -> test -> TestDefM l (Arg2 test) ()
xspecifyWithAll :: String -> test -> TestDefM l (Arg2 test) ()
xspecifyWithAll = String -> test -> TestDefM l (Arg2 test) ()
forall test (l :: [*]).
(HasCallStack, IsTest test, Arg1 test ~ HList l) =>
String -> test -> TestDefM l (Arg2 test) ()
xitWithAll

-- | Declare a test that has not been written yet.
pending :: String -> TestDefM a b ()
pending :: String -> TestDefM a b ()
pending String
s = [SpecDefTree a b ()] -> TestDefM a b ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> Maybe Text -> SpecDefTree a b ()
forall (a :: [*]) c e. Text -> Maybe Text -> SpecDefTree a c e
DefPendingNode (String -> Text
T.pack String
s) Maybe Text
forall a. Maybe a
Nothing]

-- | Declare a test that has not been written yet for the given reason.
pendingWith :: String -> String -> TestDefM a b ()
pendingWith :: String -> String -> TestDefM a b ()
pendingWith String
s String
reason = [SpecDefTree a b ()] -> TestDefM a b ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [Text -> Maybe Text -> SpecDefTree a b ()
forall (a :: [*]) c e. Text -> Maybe Text -> SpecDefTree a c e
DefPendingNode (String -> Text
T.pack String
s) (Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
reason))]