Source file `stringlike.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
open Stdune

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