0 | module Evince.Spec
 1 |
 2 | import Language.Reflection
 3 | import Language.Reflection.TTImp
 4 | import Evince.Core
 5 |
 6 | %language ElabReflection
 7 |
 8 | ||| Group related specs under a label.
 9 | export
10 | describe : String -> Spec m a () -> Spec m a ()
11 | describe label body = MkSpec [< Describe label (getSpecTrees body)] ()
12 |
13 | ||| Alias for `describe` - use with "when"/"with" phrasing.
14 | export
15 | context : String -> Spec m a () -> Spec m a ()
16 | context = describe
17 |
18 | ||| Define a test case. The body chains expectations in the spec's own monad
19 | ||| `m`, or in `IO`, which is lifted into `m`; plain actions enter via
20 | ||| `lift`/`liftIO`. The body is evaluated when the test runs, not when the
21 | ||| spec is built.
22 | export
23 | it : Hoist n m => String -> Lazy (TestResultT n ()) -> Spec m a ()
24 | it label body = MkSpec [< It label Nothing (\_ => runTestResultT (hoistChain body))] ()
25 |
26 | ||| Define a test case that receives the resource.
27 | export
28 | itWith : Hoist n m => String -> (a -> TestResultT n ()) -> Spec m a ()
29 | itWith label f = MkSpec [< It label Nothing (runTestResultT . hoistChain . f)] ()
30 |
31 | ||| Define a test with source location captured at the call site.
32 | ||| Pass a dummy quasiquoted value as the first argument:
33 | |||   itLoc `(()) "test name" $ expectation
34 | export
35 | %macro
36 | itLoc : Hoist n m => TTImp -> String -> Lazy (TestResultT n ()) -> Elab (Spec m a ())
37 | itLoc t label body = do
38 |   let loc = fcToSrcLoc (getFC t)
39 |   pure $ MkSpec [< It label (Just loc) (\_ => runTestResultT (hoistChain body))] ()
40 |
41 | ||| Mark a test as pending - the body is ignored and not executed.
42 | export
43 | xit : Hoist n m => String -> Lazy (TestResultT n ()) -> Spec m a ()
44 | xit label _ = MkSpec [< Pending label Nothing] ()
45 |
46 | mutual
47 |   -- Every test becomes a Pending node; cleanups are dropped (their setups
48 |   -- will never run) and focus markers are ignored.
49 |   pendTree : SpecTree m a -> List (SpecTree m a)
50 |   pendTree (It label _ _)         = [Pending label Nothing]
51 |   pendTree (Describe label cs)    = [Describe label (pendTrees cs)]
52 |   pendTree (Pending label reason) = [Pending label reason]
53 |   pendTree (Focused t)            = pendTree t
54 |   pendTree (WithCleanup _ cs)     = pendTrees cs
55 |
56 |   pendTrees : List (SpecTree m a) -> List (SpecTree m a)
57 |   pendTrees []        = []
58 |   pendTrees (t :: ts) = pendTree t ++ pendTrees ts
59 |
60 | ||| Mark an entire group as pending - every test in it is reported as
61 | ||| pending and nothing is executed.
62 | export
63 | xdescribe : String -> Spec m a () -> Spec m a ()
64 | xdescribe label body = MkSpec [< Describe label (pendTrees (getSpecTrees body))] ()
65 |
66 | ||| Alias for `xdescribe`.
67 | export
68 | xcontext : String -> Spec m a () -> Spec m a ()
69 | xcontext = xdescribe
70 |
71 | ||| Focus a test - when any focused specs exist, only focused ones run.
72 | export
73 | fit : Hoist n m => String -> Lazy (TestResultT n ()) -> Spec m a ()
74 | fit label body = MkSpec [< Focused (It label Nothing (\_ => runTestResultT (hoistChain body)))] ()
75 |
76 | ||| Focus an entire group.
77 | export
78 | fdescribe : String -> Spec m a () -> Spec m a ()
79 | fdescribe label body = MkSpec [< Focused (Describe label (getSpecTrees body))] ()
80 |
81 | ||| Alias for `fdescribe`.
82 | export
83 | fcontext : String -> Spec m a () -> Spec m a ()
84 | fcontext = fdescribe
85 |
86 | ||| Focus every test in the given spec - composes with any test or group
87 | ||| combinator (`it`, `itWith`, `describe`, ...).
88 | export
89 | focus : Spec m a () -> Spec m a ()
90 | focus body = MkSpec (Lin <>< map Focused (getSpecTrees body)) ()
91 |