Source file `could_not_load.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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
open Core

type t =
  | Environment_variable_missing of
      { environment_variable : string
      ; default_config_error : Error.t
      ; documentation : string
      }
  | Environment_variable_present of
      { environment_value : string
      ; environment_variable : string
      ; config_parse_error : Error.t
      ; override_parse_error : Error.t option
      ; documentation : string
      }
[@@deriving sexp_of]

let environment_value = function
  | Environment_variable_missing _ -> None
  | Environment_variable_present { environment_value; _ } -> Some environment_value
;;

let raise_exn ?extra_context t =
  let extra_context =
    match extra_context with
    | None -> ""
    | Some context -> context ^ "\n"
  in
  match t with
  | Environment_variable_missing
      { environment_variable; default_config_error; documentation } ->
    eprintf
      !{|
Unable to load default configuration for empty environment variable %S.

Config load error:
%{Error#hum}

%s
Documentation:
%s

|}
      environment_variable
      default_config_error
      extra_context
      documentation;
    raise_s [%message "Unable to parse configuration"]
  | Environment_variable_present
      { environment_value
      ; config_parse_error
      ; override_parse_error
      ; documentation
      ; environment_variable
      } ->
    let override_parse_error =
      match override_parse_error with
      | None -> ""
      | Some error -> sprintf !"Override parse error:\n%{Error#hum}\n" error
    in
    eprintf
      !{|
Unable to parse %S for environment variable %S


Config parse error:
%{Error#hum}

%s
%s
Documentation:
%s

|}
      environment_value
      environment_variable
      config_parse_error
      override_parse_error
      extra_context
      documentation;
    raise_s [%message "Unable to parse configuration"]
;;