1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE ConstraintKinds #-}
3-- |
4-- Stability: unstable
5--
6-- This module provides access to Hspec's internals.  It is less stable than
7-- other parts of the API. For most users @Test.Hspec@ is more suitable!
8module Test.Hspec.Core.Spec (
9
10-- * Defining a spec
11  it
12, specify
13, describe
14, context
15, pending
16, pendingWith
17, xit
18, xspecify
19, xdescribe
20, xcontext
21
22, focus
23, fit
24, fspecify
25, fdescribe
26, fcontext
27
28, parallel
29, sequential
30
31-- * The @SpecM@ monad
32, module Test.Hspec.Core.Spec.Monad
33
34-- * A type class for examples
35, module Test.Hspec.Core.Example
36
37-- * Internal representation of a spec tree
38, module Test.Hspec.Core.Tree
39) where
40
41import           Prelude ()
42import           Test.Hspec.Core.Compat
43
44import qualified Control.Exception as E
45import           Data.CallStack
46
47import           Test.Hspec.Expectations (Expectation)
48
49import           Test.Hspec.Core.Example
50import           Test.Hspec.Core.Hooks
51import           Test.Hspec.Core.Tree
52import           Test.Hspec.Core.Spec.Monad
53
54-- | The @describe@ function combines a list of specs into a larger spec.
55describe :: HasCallStack => String -> SpecWith a -> SpecWith a
56describe label spec = runIO (runSpecM spec) >>= fromSpecList . return . specGroup label
57
58-- | @context@ is an alias for `describe`.
59context :: HasCallStack => String -> SpecWith a -> SpecWith a
60context = describe
61
62-- |
63-- Changing `describe` to `xdescribe` marks all spec items of the corresponding subtree as pending.
64--
65-- This can be used to temporarily disable spec items.
66xdescribe :: HasCallStack => String -> SpecWith a -> SpecWith a
67xdescribe label spec = before_ pending_ $ describe label spec
68
69-- | @xcontext@ is an alias for `xdescribe`.
70xcontext :: HasCallStack => String -> SpecWith a -> SpecWith a
71xcontext = xdescribe
72
73-- | The @it@ function creates a spec item.
74--
75-- A spec item consists of:
76--
77-- * a textual description of a desired behavior
78--
79-- * an example for that behavior
80--
81-- > describe "absolute" $ do
82-- >   it "returns a positive number when given a negative number" $
83-- >     absolute (-1) == 1
84it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
85it label action = fromSpecList [specItem label action]
86
87-- | @specify@ is an alias for `it`.
88specify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
89specify = it
90
91-- |
92-- Changing `it` to `xit` marks the corresponding spec item as pending.
93--
94-- This can be used to temporarily disable a spec item.
95xit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
96xit label action = before_ pending_ $ it label action
97
98-- | @xspecify@ is an alias for `xit`.
99xspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
100xspecify = xit
101
102-- | `focus` focuses all spec items of the given spec.
103--
104-- Applying `focus` to a spec with focused spec items has no effect.
105focus :: SpecWith a -> SpecWith a
106focus spec = do
107  xs <- runIO (runSpecM spec)
108  let
109    ys
110      | any (any itemIsFocused) xs = xs
111      | otherwise = bimapForest id (\ item -> item {itemIsFocused = True}) xs
112  fromSpecList ys
113
114-- | @fit@ is an alias for @fmap focus . it@
115fit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
116fit = fmap focus . it
117
118-- | @fspecify@ is an alias for `fit`.
119fspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
120fspecify = fit
121
122-- | @fdescribe@ is an alias for @fmap focus . describe@
123fdescribe :: HasCallStack => String -> SpecWith a -> SpecWith a
124fdescribe = fmap focus . describe
125
126-- | @fcontext@ is an alias for `fdescribe`.
127fcontext :: HasCallStack => String -> SpecWith a -> SpecWith a
128fcontext = fdescribe
129
130-- | `parallel` marks all spec items of the given spec to be safe for parallel
131-- evaluation.
132parallel :: SpecWith a -> SpecWith a
133parallel = mapSpecItem_ (setParallelizable True)
134
135-- | `sequential` marks all spec items of the given spec to be evaluated sequentially.
136sequential :: SpecWith a -> SpecWith a
137sequential = mapSpecItem_ (setParallelizable False)
138
139setParallelizable :: Bool -> Item a -> Item a
140setParallelizable value item = item {itemIsParallelizable = itemIsParallelizable item <|> Just value}
141
142-- | `pending` can be used to mark a spec item as pending.
143--
144-- If you want to textually specify a behavior but do not have an example yet,
145-- use this:
146--
147-- > describe "fancyFormatter" $ do
148-- >   it "can format text in a way that everyone likes" $
149-- >     pending
150pending :: HasCallStack => Expectation
151pending = E.throwIO (Pending location Nothing)
152
153pending_ :: Expectation
154pending_ = (E.throwIO (Pending Nothing Nothing))
155
156-- |
157-- `pendingWith` is similar to `pending`, but it takes an additional string
158-- argument that can be used to specify the reason for why the spec item is pending.
159pendingWith :: HasCallStack => String -> Expectation
160pendingWith = E.throwIO . Pending location . Just
161