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
|
open Import
module Make (S : Stringlike_intf.S_base) = struct
include S
let of_string s : t =
match S.of_string_opt s with
| Some s -> s
| None ->
Code_error.raise
("Invalid " ^ S.module_ ^ ".t")
[ ("s", Dyn.Encoder.string s) ]
let error_message s = Printf.sprintf "%S is an invalid %s." s S.description
let user_error (loc, s) =
let hints =
match S.hint_valid with
| None -> []
| Some f -> [ Pp.textf "%s would be a correct %s" (f s) S.description ]
in
let valid_desc =
match S.description_of_valid_string with
| None -> []
| Some m -> [ m ]
in
User_error.make ~loc ~hints (Pp.text (error_message s) :: valid_desc)
let of_string_user_error (loc, s) =
match of_string_opt s with
| Some s -> Ok s
| None -> Error (user_error (loc, s))
let parse_string_exn (loc, s) =
match of_string_user_error (loc, s) with
| Ok s -> s
| Error err -> raise (User_error.E err)
let conv =
( (fun s ->
match of_string_opt s with
| Some x -> Ok x
| None -> Error (`Msg (error_message s)))
, fun fmt t -> Format.pp_print_string fmt (to_string t) )
let decode =
let open Dune_lang.Decoder in
map_validate (located string) ~f:of_string_user_error
let decode_loc =
let open Dune_lang.Decoder in
map_validate (located string) ~f:(fun ((loc, _) as s) ->
let open Result.O in
let+ t = of_string_user_error s in
(loc, t))
let encode t = Dune_lang.Encoder.(string (to_string t))
let to_dyn t = Dyn.Encoder.string (to_string t)
end
|
