|
| 1 | +(**************************************************************************) |
| 2 | +(* *) |
| 3 | +(* OCaml *) |
| 4 | +(* *) |
| 5 | +(* Pierre Chambart, OCamlPro *) |
| 6 | +(* Mark Shinwell and Leo White, Jane Street Europe *) |
| 7 | +(* *) |
| 8 | +(* Copyright 2015--2016 OCamlPro SAS *) |
| 9 | +(* Copyright 2015--2016 Jane Street Group LLC *) |
| 10 | +(* *) |
| 11 | +(* All rights reserved. This file is distributed under the terms of *) |
| 12 | +(* the GNU Lesser General Public License version 2.1, with the *) |
| 13 | +(* special exception on linking described in the file ../LICENSE. *) |
| 14 | +(* *) |
| 15 | +(**************************************************************************) |
| 16 | + |
| 17 | +let fatal err = |
| 18 | + prerr_endline err; |
| 19 | + exit 2 |
| 20 | + |
| 21 | +module Make (S : sig |
| 22 | + module Key : sig |
| 23 | + type t |
| 24 | + val of_string : string -> t |
| 25 | + module Map : Map.S with type key = t |
| 26 | + end |
| 27 | + |
| 28 | + module Value : sig |
| 29 | + type t |
| 30 | + val of_string : string -> t |
| 31 | + end |
| 32 | +end) = struct |
| 33 | + type parsed = { |
| 34 | + default : S.Value.t; |
| 35 | + override : S.Value.t S.Key.Map.t; |
| 36 | + } |
| 37 | + |
| 38 | + let default v = { default = v; override = S.Key.Map.empty } |
| 39 | + |
| 40 | + let no_equals value = |
| 41 | + match String.index value '=' with |
| 42 | + | exception Not_found -> true |
| 43 | + | _index -> false |
| 44 | + |
| 45 | + exception Parse_failure of exn |
| 46 | + |
| 47 | + let parse_exn str ~update = |
| 48 | + let values = Misc.Stdlib.String.split str ~on:',' in |
| 49 | + let parsed = |
| 50 | + List.fold_left (fun acc value -> |
| 51 | + match String.index value '=' with |
| 52 | + | exception Not_found -> |
| 53 | + begin match S.Value.of_string value with |
| 54 | + | value -> { acc with default = value } |
| 55 | + | exception exn -> raise (Parse_failure exn) |
| 56 | + end |
| 57 | + | equals -> |
| 58 | + let key_value_pair = value in |
| 59 | + let length = String.length key_value_pair in |
| 60 | + assert (equals >= 0 && equals < length); |
| 61 | + if equals = 0 then begin |
| 62 | + raise (Parse_failure ( |
| 63 | + Failure "Missing key in argument specification")) |
| 64 | + end; |
| 65 | + let key = |
| 66 | + let key = String.sub key_value_pair 0 equals in |
| 67 | + try S.Key.of_string key |
| 68 | + with exn -> raise (Parse_failure exn) |
| 69 | + in |
| 70 | + let value = |
| 71 | + let value = |
| 72 | + String.sub key_value_pair (equals + 1) (length - equals - 1) |
| 73 | + in |
| 74 | + try S.Value.of_string value |
| 75 | + with exn -> raise (Parse_failure exn) |
| 76 | + in |
| 77 | + { acc with override = S.Key.Map.add key value acc.override }) |
| 78 | + !update |
| 79 | + values |
| 80 | + in |
| 81 | + update := parsed |
| 82 | + |
| 83 | + let parse str ~help_text ~update = |
| 84 | + match parse_exn str ~update with |
| 85 | + | () -> () |
| 86 | + | exception (Parse_failure exn) -> |
| 87 | + fatal (Printf.sprintf "%s: %s" (Printexc.to_string exn) help_text) |
| 88 | + |
| 89 | + type parse_result = |
| 90 | + | Ok |
| 91 | + | Parse_failed of exn |
| 92 | + |
| 93 | + let parse_no_error str ~update = |
| 94 | + match parse_exn str ~update with |
| 95 | + | () -> Ok |
| 96 | + | exception (Parse_failure exn) -> Parse_failed exn |
| 97 | + |
| 98 | + let get ~key parsed = |
| 99 | + match S.Key.Map.find key parsed.override with |
| 100 | + | provided -> provided |
| 101 | + | exception Not_found -> |
| 102 | + parsed.default |
| 103 | +end |
0 commit comments