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 with pure expectations. The body is lazy, so it is
 19 | ||| evaluated when the test runs, not when the spec is built.
 20 | export
 21 | it : Applicative m => String -> Lazy (TestResult ()) -> Spec m a ()
 22 | it label result = MkSpec [< It label Nothing (\_ => pure result)] ()
 23 |
 24 | ||| Define a test case with IO-based expectations.
 25 | export
 26 | itIO : HasIO m => String -> IO (TestResult ()) -> Spec m a ()
 27 | itIO label action = MkSpec [< It label Nothing (\_ => liftIO action)] ()
 28 |
 29 | ||| Define a test case that receives the resource.
 30 | export
 31 | itWith : Applicative m => String -> (a -> TestResult ()) -> Spec m a ()
 32 | itWith label f = MkSpec [< It label Nothing (\res => pure (f res))] ()
 33 |
 34 | ||| Define an IO test case that receives the resource.
 35 | export
 36 | itIOWith : HasIO m => String -> (a -> IO (TestResult ())) -> Spec m a ()
 37 | itIOWith label f = MkSpec [< It label Nothing (\res => liftIO (f res))] ()
 38 |
 39 | ||| Define a test with source location captured at the call site.
 40 | ||| Pass a dummy quasiquoted value as the first argument:
 41 | |||   itLoc `(()) "test name" $ expectation
 42 | export
 43 | %macro
 44 | itLoc : Applicative m => TTImp -> String -> Lazy (TestResult ()) -> Elab (Spec m a ())
 45 | itLoc t label result = do
 46 |   let loc = fcToSrcLoc (getFC t)
 47 |   pure $ MkSpec [< It label (Just loc) (\_ => pure result)] ()
 48 |
 49 | ||| Define an IO test with source location captured at the call site.
 50 | |||   itIOLoc `(()) "test name" $ ioAction
 51 | export
 52 | %macro
 53 | itIOLoc : HasIO m => TTImp -> String -> IO (TestResult ()) -> Elab (Spec m a ())
 54 | itIOLoc t label action = do
 55 |   let loc = fcToSrcLoc (getFC t)
 56 |   pure $ MkSpec [< It label (Just loc) (\_ => liftIO action)] ()
 57 |
 58 | ||| Mark a test as pending - the body is ignored and not executed.
 59 | export
 60 | xit : String -> Lazy (TestResult ()) -> Spec m a ()
 61 | xit label _ = MkSpec [< Pending label Nothing] ()
 62 |
 63 | ||| Mark an IO test as pending - the body is ignored and not executed.
 64 | export
 65 | xitIO : String -> Lazy (IO (TestResult ())) -> Spec m a ()
 66 | xitIO label _ = MkSpec [< Pending label Nothing] ()
 67 |
 68 | mutual
 69 |   -- Every test becomes a Pending node; cleanups are dropped (their setups
 70 |   -- will never run) and focus markers are ignored.
 71 |   pendTree : SpecTree m a -> List (SpecTree m a)
 72 |   pendTree (It label _ _)         = [Pending label Nothing]
 73 |   pendTree (Describe label cs)    = [Describe label (pendTrees cs)]
 74 |   pendTree (Pending label reason) = [Pending label reason]
 75 |   pendTree (Focused t)            = pendTree t
 76 |   pendTree (WithCleanup _ cs)     = pendTrees cs
 77 |
 78 |   pendTrees : List (SpecTree m a) -> List (SpecTree m a)
 79 |   pendTrees []        = []
 80 |   pendTrees (t :: ts) = pendTree t ++ pendTrees ts
 81 |
 82 | ||| Mark an entire group as pending - every test in it is reported as
 83 | ||| pending and nothing is executed.
 84 | export
 85 | xdescribe : String -> Spec m a () -> Spec m a ()
 86 | xdescribe label body = MkSpec [< Describe label (pendTrees (getSpecTrees body))] ()
 87 |
 88 | ||| Alias for `xdescribe`.
 89 | export
 90 | xcontext : String -> Spec m a () -> Spec m a ()
 91 | xcontext = xdescribe
 92 |
 93 | ||| Focus a test - when any focused specs exist, only focused ones run.
 94 | export
 95 | fit : Applicative m => String -> Lazy (TestResult ()) -> Spec m a ()
 96 | fit label result = MkSpec [< Focused (It label Nothing (\_ => pure result))] ()
 97 |
 98 | ||| Focus an entire group.
 99 | export
100 | fdescribe : String -> Spec m a () -> Spec m a ()
101 | fdescribe label body = MkSpec [< Focused (Describe label (getSpecTrees body))] ()
102 |
103 | ||| Alias for `fdescribe`.
104 | export
105 | fcontext : String -> Spec m a () -> Spec m a ()
106 | fcontext = fdescribe
107 |
108 | ||| Focus every test in the given spec - composes with any test or group
109 | ||| combinator (`itIO`, `itAsync`, `describe`, ...).
110 | export
111 | focus : Spec m a () -> Spec m a ()
112 | focus body = MkSpec (Lin <>< map Focused (getSpecTrees body)) ()
113 |