Source file `async_invariant.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
open! Core
open! Deferred.Let_syntax
open! Import
include Core.Invariant

module Async = struct
  include Async_invariant_intf.Async

  let invariant here t sexp_of_t f =
    match%map
      Monitor.try_with
        ~run:`Schedule
        ~rest:`Log
        f
        ~extract_exn:true
    with
    | Ok () -> ()
    | Error exn ->
      raise_s
        [%message
          "invariant failed" ~_:(here : Source_code_position.t) (exn : exn) ~_:(t : t)]
  ;;

  let check_field t f wait_for_previous field =
    let%bind () = wait_for_previous in
    match%map
      Monitor.try_with
        ~run:`Schedule
        ~rest:`Log
        ~extract_exn:true
        (fun () -> f (Field.get field t))
    with
    | Ok () -> ()
    | Error exn ->
      raise_s
        [%message "problem with field" ~field:(Field.name field : string) (exn : exn)]
  ;;
end