UNPKG

20.4 kBPlain TextView Raw
1type 'a modifier = [
2| `Just of 'a
3| `Not of 'a
4]
5
6let mapMod f = function
7| `Just a -> `Just (f a)
8| `Not a -> `Not (f a)
9
10type assertion =
11| Ok : assertion
12| Fail : string -> assertion
13
14| ArrayContains : ('a array * 'a) modifier -> assertion
15| ArrayLength : ('a array * int) modifier -> assertion
16| ArraySuperset : ('a array * 'a array) modifier -> assertion
17| Be : ('a * 'a) modifier -> assertion
18| Equal : ('a * 'a) modifier -> assertion
19| FloatCloseTo : (float * float * int option) modifier -> assertion
20| GreaterThan : ('a * 'a) modifier -> assertion
21| GreaterThanOrEqual : ('a * 'a) modifier -> assertion
22| LessThan : ('a * 'a) modifier -> assertion
23| LessThanOrEqual : ('a * 'a) modifier -> assertion
24| StringContains : (string * string) modifier -> assertion
25| StringMatch : (string * Js.Re.t) modifier -> assertion
26
27| Throws : (unit -> _) modifier -> assertion
28| ThrowsException : ((unit -> _) * exn) modifier -> assertion
29| ThrowsMessage : ((unit -> _) * string) modifier -> assertion
30| ThrowsMessageRe : ((unit -> _) * Js.Re.t) modifier -> assertion
31
32| MatchSnapshot : _ -> assertion
33| MatchSnapshotName : _ * string -> assertion
34| ThrowsMatchSnapshot : (unit -> _) -> assertion
35
36(* JS *)
37| Defined : ('a Js.undefined) modifier -> assertion
38| Falsy : 'a modifier -> assertion
39| Null : _ Js.null modifier -> assertion
40| Truthy : 'a modifier -> assertion
41| Undefined : 'a Js.undefined modifier -> assertion
42| ObjectContains : (< .. > Js.t * string array) modifier -> assertion
43| ObjectMatch : (< .. > Js.t * < .. > Js.t) modifier -> assertion
44
45module type Asserter = sig
46 type 'a t
47 val affirm : 'a t -> unit
48end
49
50(* internal *)
51module LLExpect : sig
52 type 'a t = assertion
53 val affirm : 'a t -> unit
54end = struct
55 type 'a t = assertion
56 type specialMatch
57
58 external expect : 'a -> < .. > Js.t = "" [@@bs.val]
59 external fail : string -> unit = "" [@@bs.val]
60 external arrayContaining : 'a array -> specialMatch = "expect.arrayContaining" [@@bs.val]
61 external stringContaining : string -> specialMatch = "expect.stringContaining" [@@bs.val]
62 let objectContaining : string array -> < .. > Js.t = [%raw {|
63 function (properties) {
64 var spec = {};
65 properties.forEach(function (property) {
66 spec[property] = expect.anything();
67 });
68 return spec;
69 }
70 |}]
71
72 let affirm = function
73 | Ok -> ()
74 | Fail message -> fail message
75
76 | ArrayContains `Just (a, b) -> (expect a) ## toContain b
77 | ArrayContains `Not (a, b) -> (expect a) ## not ## toContain b
78 | ArrayLength `Just (a, l) -> (expect a) ## toHaveLength l
79 | ArrayLength `Not (a, l) -> (expect a) ## not ## toHaveLength l
80 | ArraySuperset `Just (a, b) -> (expect a) ## toEqual (arrayContaining b)
81 | ArraySuperset `Not (a, b) -> (expect a) ## not ## toEqual (arrayContaining b)
82 | Be `Just (a, b) -> (expect a) ## toBe b
83 | Be `Not (a, b) -> (expect a) ## not ## toBe b
84 | Equal `Just (a, b) -> (expect a) ## toEqual b
85 | Equal `Not (a, b) -> (expect a) ## not ## toEqual b
86 | FloatCloseTo `Just (a, b, p) -> (expect a) ## toBeCloseTo b (Js.Undefined.fromOption p)
87 | FloatCloseTo `Not (a, b, p) -> (expect a) ## not ## toBeCloseTo b (Js.Undefined.fromOption p)
88 | GreaterThan `Just (a, b) -> (expect a) ## toBeGreaterThan b
89 | GreaterThan `Not (a, b) -> (expect a) ## not ## toBeGreaterThan b
90 | GreaterThanOrEqual `Just (a, b) -> (expect a) ## toBeGreaterThanOrEqual b
91 | GreaterThanOrEqual `Not (a, b) -> (expect a) ## not ## toBeGreaterThanOrEqual b
92 | LessThan `Just (a, b) -> (expect a) ## toBeLessThan b
93 | LessThan `Not (a, b) -> (expect a) ## not ## toBeLessThan b
94 | LessThanOrEqual `Just (a, b) -> (expect a) ## toBeLessThanOrEqual b
95 | LessThanOrEqual `Not (a, b) -> (expect a) ## not ## toBeLessThanOrEqual b
96 | StringMatch `Just (s, re) -> (expect s) ## toMatch re
97 | StringMatch `Not (s, re) -> (expect s) ## not ## toMatch re
98 | StringContains `Just (a, b) -> (expect a) ## toEqual (stringContaining b)
99 | StringContains `Not (a, b) -> (expect a) ## not ## toEqual (stringContaining b)
100
101 | Throws `Just f -> (expect f) ## toThrow ()
102 | Throws `Not f -> (expect f) ## not ## toThrow ()
103 | ThrowsException `Just (f, e) -> (expect f) ## toThrow (Js.String.make e)
104 | ThrowsException `Not (f, e) -> (expect f) ## not ## toThrow (Js.String.make e)
105 | ThrowsMessage `Just (f, msg) -> (expect f) ## toThrow msg
106 | ThrowsMessage `Not (f, msg) -> (expect f) ## not ## toThrow msg
107 | ThrowsMessageRe `Just (f, re) -> (expect f) ## toThrow re
108 | ThrowsMessageRe `Not (f, re) -> (expect f) ## not ## toThrow re
109
110 | MatchSnapshot a -> (expect a) ## toMatchSnapshot ()
111 | MatchSnapshotName (a, name) -> (expect a) ## toMatchSnapshot name
112 | ThrowsMatchSnapshot f -> (expect f) ## toThrowErrorMatchingSnapshot ()
113
114 (* JS *)
115 | Defined `Just a -> (expect a) ## toBeDefined ()
116 | Defined `Not a -> (expect a) ## not ## toBeDefined ()
117 | Falsy `Just a -> (expect a) ## toBeFalsy ()
118 | Falsy `Not a -> (expect a) ## not ## toBeFalsy ()
119 | Null `Just a -> (expect a) ## toBeNull ()
120 | Null `Not a -> (expect a) ## not ## toBeNull ()
121 | Truthy `Just a -> (expect a) ## toBeTruthy ()
122 | Truthy `Not a -> (expect a) ## not ## toBeTruthy ()
123 | Undefined `Just a -> (expect a) ## toBeUndefined ()
124 | Undefined `Not a -> (expect a) ## not ## toBeUndefined ()
125 | ObjectContains `Just (a, props) -> (expect a) ## toEqual (objectContaining props)
126 | ObjectContains `Not (a, props) -> (expect a) ## not ## toEqual (objectContaining props)
127 | ObjectMatch `Just (a, b) -> (expect a) ## toMatchObject b
128 | ObjectMatch `Not (a, b) -> (expect a) ## not ## toMatchObject b
129end
130
131module Runner (A : Asserter) = struct
132 let affirm = A.affirm
133 external _test : string -> (unit -> unit Js.undefined [@bs.uncurry]) -> unit = "test" [@@bs.val]
134 external _testAsync : string -> ((unit -> unit [@bs]) -> unit Js.undefined) -> int Js.Undefined.t -> unit = "test" [@@bs.val]
135 external _testPromise : string -> (unit -> 'a Js.Promise.t [@bs.uncurry]) -> int Js.Undefined.t -> unit = "test" [@@bs.val]
136
137 let test name callback =
138 _test name (fun () ->
139 affirm @@ callback ();
140 Js.undefined)
141
142 let testAsync name ?timeout callback =
143 _testAsync name (fun finish ->
144 callback (fun case ->
145 affirm case;
146 finish () [@bs]);
147 Js.undefined)
148 (Js.Undefined.fromOption timeout)
149
150 let testPromise name ?timeout callback =
151 _testPromise name (fun () ->
152 callback () |> Js.Promise.then_ (fun a -> a |> A.affirm |> Js.Promise.resolve))
153 (Js.Undefined.fromOption timeout)
154
155 let testAll name inputs callback =
156 inputs |> List.iter (fun input ->
157 let name = {j|$name - $input|j} in
158 _test name (fun () ->
159 affirm @@ callback input;
160 Js.undefined))
161
162 external describe : string -> (unit -> unit Js.undefined [@bs.uncurry]) -> unit = "" [@@bs.val]
163 let describe label f =
164 describe label (fun () -> f (); Js.undefined)
165
166 external beforeAll : (unit -> unit [@bs.uncurry]) -> unit = "" [@@bs.val]
167 external beforeAllAsync : ((unit -> unit [@bs]) -> unit Js.undefined) -> int Js.Undefined.t -> unit = "beforeAll" [@@bs.val]
168 let beforeAllAsync ?timeout callback =
169 beforeAllAsync
170 (fun finish -> callback (fun () -> finish () [@bs]); Js.undefined)
171 (Js.Undefined.fromOption timeout)
172 external beforeAllPromise : (unit -> 'a Js.Promise.t [@bs.uncurry]) -> int Js.Undefined.t -> unit = "beforeAll" [@@bs.val]
173 let beforeAllPromise ?timeout callback =
174 beforeAllPromise
175 (fun () -> callback () |> Js.Promise.resolve)
176 (Js.Undefined.fromOption timeout)
177
178 external beforeEach : (unit -> unit [@bs.uncurry]) -> unit = "" [@@bs.val]
179 external beforeEachAsync : ((unit -> unit [@bs]) -> unit Js.undefined) -> int Js.Undefined.t -> unit = "beforeEach" [@@bs.val]
180 let beforeEachAsync ?timeout callback =
181 beforeEachAsync
182 (fun finish -> callback (fun () -> finish () [@bs]); Js.undefined)
183 (Js.Undefined.fromOption timeout)
184 external beforeEachPromise : (unit -> 'a Js.Promise.t [@bs.uncurry]) -> int Js.Undefined.t -> unit = "beforeEach" [@@bs.val]
185 let beforeEachPromise ?timeout callback =
186 beforeEachPromise
187 (fun () -> callback () |> Js.Promise.resolve)
188 (Js.Undefined.fromOption timeout)
189
190 external afterAll : (unit -> unit [@bs.uncurry]) -> unit = "" [@@bs.val]
191 external afterAllAsync : ((unit -> unit [@bs]) -> unit Js.undefined) -> int Js.Undefined.t -> unit = "afterAll" [@@bs.val]
192 let afterAllAsync ?timeout callback =
193 afterAllAsync
194 (fun finish -> callback (fun () -> finish () [@bs]); Js.undefined)
195 (Js.Undefined.fromOption timeout)
196 external afterAllPromise : (unit -> 'a Js.Promise.t [@bs.uncurry]) -> int Js.Undefined.t -> unit = "afterAll" [@@bs.val]
197 let afterAllPromise ?timeout callback =
198 afterAllPromise
199 (fun () -> callback () |> Js.Promise.resolve)
200 (Js.Undefined.fromOption timeout)
201
202 external afterEach : (unit -> unit [@bs.uncurry]) -> unit = "" [@@bs.val]
203 external afterEachAsync : ((unit -> unit [@bs]) -> unit Js.undefined) -> int Js.Undefined.t -> unit = "afterEach" [@@bs.val]
204 let afterEachAsync ?timeout callback =
205 afterEachAsync
206 (fun finish -> callback (fun () -> finish () [@bs]); Js.undefined)
207 (Js.Undefined.fromOption timeout)
208 external afterEachPromise : (unit -> 'a Js.Promise.t [@bs.uncurry]) -> int Js.Undefined.t -> unit = "afterEach" [@@bs.val]
209 let afterEachPromise ?timeout callback =
210 afterEachPromise
211 (fun () -> callback () |> Js.Promise.resolve)
212 (Js.Undefined.fromOption timeout)
213
214 module Only = struct
215 external _test : string -> (unit -> unit Js.undefined [@bs.uncurry]) -> unit = "it.only" [@@bs.val]
216 external _testAsync : string -> ((unit -> unit [@bs]) -> unit Js.undefined) -> int Js.Undefined.t -> unit = "it.only" [@@bs.val]
217 external _testPromise : string -> (unit -> 'a Js.Promise.t [@bs.uncurry]) -> int Js.Undefined.t -> unit = "it.only" [@@bs.val]
218
219 let test name callback =
220 _test name (fun () ->
221 affirm @@ callback ();
222 Js.undefined)
223
224 let testAsync name ?timeout callback =
225 _testAsync name (fun finish ->
226 callback (fun assertion ->
227 affirm assertion;
228 finish () [@bs]);
229 Js.undefined)
230 (Js.Undefined.fromOption timeout)
231
232 let testPromise name ?timeout callback =
233 _testPromise name (fun () ->
234 callback () |> Js.Promise.then_ (fun a -> a |> affirm |> Js.Promise.resolve))
235 (Js.Undefined.fromOption timeout)
236
237 let testAll name inputs callback =
238 inputs |> List.iter (fun input ->
239 let name = {j|$name - $input|j} in
240 _test name (fun () ->
241 affirm @@ callback input;
242 Js.undefined))
243
244 external describe : string -> (unit -> unit Js.undefined [@bs.uncurry]) -> unit = "describe.only" [@@bs.val]
245 let describe label f =
246 describe label (fun () -> f (); Js.undefined)
247 end
248
249 module Skip = struct
250 external test : string -> (unit -> 'a A.t [@bs.uncurry]) -> unit = "it.skip" [@@bs.val]
251 external testAsync : string -> (('a A.t -> unit) -> unit) -> unit = "it.skip" [@@bs.val]
252 let testAsync name ?timeout:_ callback =
253 testAsync name callback
254 external testPromise : string -> (unit -> 'a A.t Js.Promise.t [@bs.uncurry]) -> unit = "it.skip" [@@bs.val]
255 let testPromise name ?timeout:_ callback =
256 testPromise name callback
257 let testAll name inputs callback =
258 inputs |> List.iter (fun input ->
259 let name = {j|$name - $input|j} in
260 test name (fun () -> callback input))
261 external describe : string -> (unit -> unit Js.undefined [@bs.uncurry]) -> unit = "describe.skip" [@@bs.val]
262 let describe label f =
263 describe label (fun () -> f (); Js.undefined)
264 end
265end
266
267include Runner(LLExpect)
268
269let pass = Ok
270let fail message = Fail message
271(*
272 * Not implemented:
273 * - expect.anything - pointless when there's `option`, `Js.null` etc.
274 * - expect.any - pointless when you have types, except against < .. > Js.t, but how to implement this?
275 * - expect.arrayContaining - implement as overloads of `toEqual`, `toBeCalledWith`, `objectContaining` and `toMatchObject`
276 * - expect.assertions - Not supported. There should be only one assertion per test.
277 * - expect.objectContaining - implement as separate matcher and overload of `toBeCalledWith`
278 * - expect.stringContaining - implement as overloads of `toEqual`, `toBeCalledWith`, `objectContaining` and `toMatchObject`
279 * - expect.stringMatching - implement as overloads of `toEqual`, `toBeCalledWith`, `objectContaining` and `toMatchObject`
280 *)
281
282module Expect = struct
283 type 'a plainPartial = [`Just of 'a]
284 type 'a invertedPartial = [`Not of 'a]
285 type 'a partial = 'a modifier
286
287 let expect a =
288 `Just a
289
290 let expectFn f a =
291 `Just (fun () -> f a)
292
293 let toBe b p =
294 Be (mapMod (fun a -> (a, b)) p)
295
296 (* toHaveBeenCalled* *)
297
298 let toBeCloseTo b p =
299 FloatCloseTo (mapMod (fun a -> (a, b, None)) p)
300
301 let toBeSoCloseTo b ~digits p =
302 FloatCloseTo (mapMod (fun a -> (a, b, Some digits)) p)
303
304 let toBeGreaterThan b p =
305 GreaterThan (mapMod (fun a -> (a, b)) p)
306
307 let toBeGreaterThanOrEqual b p =
308 GreaterThanOrEqual (mapMod (fun a -> (a, b)) p)
309
310 let toBeLessThan b p =
311 LessThan (mapMod (fun a -> (a, b)) p)
312
313 let toBeLessThanOrEqual b p =
314 LessThanOrEqual (mapMod (fun a -> (a, b)) p)
315
316 (** replaces expect.arrayContaining *)
317 let toBeSupersetOf b p =
318 ArraySuperset (mapMod (fun a -> (a, b)) p)
319
320 let toContain b p =
321 ArrayContains (mapMod (fun a -> (a, b)) p)
322
323 (** replaces expect.stringContaining *)
324 let toContainString b p =
325 StringContains (mapMod (fun a -> (a, b)) p)
326
327 let toEqual b p =
328 Equal (mapMod (fun a -> (a, b)) p)
329
330 let toHaveLength l p =
331 ArrayLength (mapMod (fun a -> (a, l)) p)
332
333 let toMatch s p =
334 StringMatch (mapMod (fun a -> (a, Js.Re.fromString s)) p)
335
336 let toMatchRe re p =
337 StringMatch (mapMod (fun a -> (a, re)) p)
338
339 let toMatchSnapshot (`Just a) =
340 MatchSnapshot a
341
342 let toMatchSnapshotWithName name (`Just a) =
343 MatchSnapshotName (a, name)
344
345 let toThrow f =
346 Throws (f :> _ modifier)
347
348 let toThrowErrorMatchingSnapshot (`Just f) =
349 ThrowsMatchSnapshot f
350
351 let toThrowException e p =
352 ThrowsException (mapMod (fun f -> (f, e)) p)
353
354 let toThrowMessage message p =
355 ThrowsMessage (mapMod (fun f -> (f, message)) p)
356
357 let toThrowMessageRe re p =
358 ThrowsMessageRe (mapMod (fun f -> (f, re)) p)
359
360 let not_ (`Just a) = `Not a
361 let not__ = not_ (* For Reason syntax compatibility. TODO: deprecate and remove *)
362
363 module Operators = struct
364 (** experimental *)
365
366 let (==) = fun a b -> toBe b a
367 let (>) = fun a b -> toBeGreaterThan b a
368 let (>=) = fun a b -> toBeGreaterThanOrEqual b a
369 let (<) = fun a b -> toBeLessThan b a
370 let (<=) = fun a b -> toBeLessThanOrEqual b a
371 let (=) = fun a b -> toEqual b a
372 let (<>) = fun a b -> a |> not_ |> toEqual b
373 let (!=) = fun a b -> a |> not_ |> toBe b
374 end
375end
376
377module ExpectJs = struct
378 include Expect
379
380 let toBeDefined a = Defined (a :> _ modifier)
381 let toBeFalsy a = Falsy (a :> _ modifier)
382 (* toBeInstanceOf *)
383 let toBeNull a = Null (a :> _ modifier)
384 let toBeTruthy a = Truthy (a :> _ modifier)
385 let toBeUndefined a = Undefined (a :> _ modifier)
386
387 (** replaces expect.objectContaining *)
388 let toContainProperties props p =
389 ObjectContains (mapMod (fun a -> (a, props)) p)
390
391 let toMatchObject b p =
392 ObjectMatch (mapMod (fun a -> (a, b)) p)
393end
394
395module MockJs = struct
396 (** experimental *)
397
398 type ('fn, 'args, 'ret) fn
399
400 [%%bs.raw {|
401 function makeNewMock(self) {
402 return new (Function.prototype.bind.apply(self, arguments));
403 }
404 |}]
405
406 external new0 : (unit -> 'ret, unit, 'ret) fn -> 'ret = "makeNewMock" [@@bs.val]
407 let new0 = new0
408 external new1 : ('a -> 'ret, 'a, 'ret) fn -> 'a -> 'ret = "makeNewMock" [@@bs.val]
409 let new1 a self = new1 self a
410 external new2 : (('a -> 'b -> 'ret) [@bs], ('a * 'b), 'ret) fn -> 'a -> 'b -> 'ret = "makeNewMock" [@@bs.val]
411 let new2 a b self = new2 self a b
412
413 external fn : ('fn, _, _) fn -> 'fn = "%identity"
414 external calls : (_, 'args, _) fn -> 'args array = "" [@@bs.get] [@@bs.scope "mock"]
415 let calls self = Js.Array.copy (calls self) (* Awesome, the bloody things are mutated so we need to copy *)
416 let calls self = calls self |> Array.map [%bs.raw {|
417 function (args) { return args.length === 1 ? args[0] : args }
418 |}] (* there's no such thing as aa 1-ary tuple, so we need to unbox single-element arrays *)
419 external instances : (_, _, 'ret) fn -> 'ret array = "" [@@bs.get] [@@bs.scope "mock"] (* TODO: semms this only records "instances" created by `new` *)
420 let instances self = Js.Array.copy (instances self) (* Awesome, the bloody things are mutated so we need to copy *)
421
422 (** Beware: this actually replaces `mock`, not just `mock.instances` and `mock.calls` *)
423 external mockClear : unit = "" [@@bs.send.pipe: _ fn]
424 external mockReset : unit = "" [@@bs.send.pipe: _ fn]
425 external mockImplementation : 'fn -> 'self = "" [@@bs.send.pipe: ('fn, _, _) fn as 'self]
426 external mockImplementationOnce : 'fn -> 'self = "" [@@bs.send.pipe: ('fn, _, _) fn as 'self]
427 external mockReturnThis : unit = "" [@@bs.send.pipe: (_, _, 'ret) fn] (* not type safe, we don't know what `this` actually is *)
428 external mockReturnValue : 'ret -> 'self = "" [@@bs.send.pipe: (_, _, 'ret) fn as 'self]
429 external mockReturnValueOnce : 'ret -> 'self = "" [@@bs.send.pipe: (_, _, 'ret) fn as 'self]
430end
431
432module Jest = struct
433 external clearAllTimers : unit -> unit = "jest.clearAllTimers" [@@bs.val]
434 external runAllTicks : unit -> unit = "jest.runAllTicks" [@@bs.val]
435 external runAllTimers : unit -> unit = "jest.runAllTimers" [@@bs.val]
436 external runAllImmediates : unit -> unit = "jest.runAllImmediates" [@@bs.val]
437 external runTimersToTime : int -> unit = "jest.runTimersToTime" [@@bs.val]
438 external advanceTimersByTime : int -> unit = "jest.advanceTimersByTime" [@@bs.val]
439 external runOnlyPendingTimers : unit -> unit = "jest.runOnlyPendingTimers" [@@bs.val]
440 external useFakeTimers : unit -> unit = "jest.useFakeTimers" [@@bs.val]
441 external useRealTimers : unit -> unit = "jest.useRealTimers" [@@bs.val]
442end
443
444module JestJs = struct
445 (** experimental *)
446
447 external disableAutomock : unit -> unit = "jest.disableAutomock" [@@bs.val]
448 external enableAutomock : unit -> unit = "jest.enableAutomock" [@@bs.val]
449 (* genMockFromModule *)
450 external resetModules : unit -> unit = "jest.resetModules" [@@bs.val]
451 external inferred_fn : unit -> ('a -> 'b Js.undefined [@bs], 'a, 'b Js.undefined) MockJs.fn = "jest.fn" [@@bs.val] (* not sure how useful this really is *)
452 external fn : ('a -> 'b) -> ('a -> 'b, 'a, 'b) MockJs.fn = "jest.fn" [@@bs.val]
453 external fn2 : ('a -> 'b -> 'c [@bs]) -> (('a -> 'b -> 'c [@bs]), 'a * 'b, 'c) MockJs.fn = "jest.fn" [@@bs.val]
454 (* TODO
455 external fn3 : ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) MockJs.fn = "jest.fn" [@@bs.val]
456 external fn4 : ('a -> 'b -> 'c -> 'd -> 'e) -> ('a * 'b * 'c * 'd) MockJs.fn = "jest.fn" [@@bs.val]
457 external fn5 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f) -> ('a * 'a * 'c * 'd * 'e) MockJs.fn = "jest.fn" [@@bs.val]
458 external fn6 : ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> 'g) -> ('a * 'b * 'c * 'd * 'e * 'f) MockJs.fn = "jest.fn" [@@bs.val]
459 *)
460 (* external isMockFunction : MockJs.fn -> Js.boolean = "jest.isMockFunction" [@@bs.val] *) (* pointless with types? *)
461 external mock : string -> unit = "jest.mock" [@@bs.val]
462 external mockWithFactory : string -> (unit -> 'a) ->unit = "jest.mock" [@@bs.val]
463 external mockVirtual : string -> (unit -> 'a) -> < .. > Js.t -> unit = "jest.mock" [@@bs.val]
464 (* TODO If this is merely defined, babel-plugin-jest-hoist fails with "The second argument of `jest.mock` must be a function." Silly thing.
465 let mockVirtual : string -> (unit -> 'a) -> unit =
466 fun moduleName factory -> mockVirtual moduleName factory [%bs.obj { _virtual = Js.true_ }]
467 *)
468 external clearAllMocks : unit -> unit = "jest.clearAllMocks" [@@bs.val]
469 external resetAllMocks : unit -> unit = "jest.resetAllMocks" [@@bs.val]
470 external setMock : string -> < .. > Js.t -> unit = "jest.setMock" [@@bs.val]
471 external unmock : string -> unit = "jest.unmock" [@@bs.val]
472 external spyOn : (< .. > Js.t as 'this) -> string -> (unit, unit, 'this) MockJs.fn = "jest.spyOn" [@@bs.val] (* this is a bit too dynamic *)
473end