Source file `parse.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
(** Module providing functions to parse a config from various kind of inputs. *)

(** Pretty print a token *)
let pp_token fmt = function
  | Menhir_parser.WORD s -> Fmt.pf fmt "WORD %s" s
  | LBRACE -> Fmt.string fmt "LBRACE"
  | RBRACE -> Fmt.string fmt "RBRACE"
  | NEWLINE -> Fmt.string fmt "NEWLINE"
  | EOF -> Fmt.string fmt "EOF"

(** Parse a config from a lexing buffer. *)
let from_lexbuf =
  let parser =
    MenhirLib.Convert.Simplified.traditional2revised Menhir_parser.config
  in
  fun buf ->
    let last_token = ref None in
    let provider () =
      let tok = Lexer.token buf in
      let start, stop = Sedlexing.lexing_positions buf in
      last_token := Some tok;
      (tok, start, stop)
    in
    try Ok (parser provider) with
    | Menhir_parser.Error ->
      let start, _stop = Sedlexing.lexing_positions buf in
      Fmt.error_msg "File %s, line %i, character %i: unexpected token %a"
        start.pos_fname start.pos_lnum
        (start.pos_cnum - start.pos_bol)
        (Fmt.option pp_token) !last_token
    | Lexer.Error msg -> Error (`Msg msg)

(** Parse a config from a string. *)
let from_string s = from_lexbuf (Sedlexing.Utf8.from_string s)
(*
  let filename = Filename.temp_file "scfg" "scfg" in
  let chan = open_out_bin filename in
  output_string chan s;
  close_out_noerr chan;
  let chan = open_in_bin filename in
  from_lexbuf (Sedlexing.Utf8.from_channel chan)
  *)

(** Parse a config from a channel. *)
let from_channel c = from_lexbuf (Sedlexing.Utf8.from_channel c)

(** Parse a config from a file. *)
let from_file f =
  match
    Bos.OS.File.with_ic f
      (fun chan () ->
        let lexbuf = Sedlexing.Utf8.from_channel chan in
        Sedlexing.set_filename lexbuf (Fpath.to_string f);
        from_lexbuf lexbuf )
      ()
  with
  | Error _ as e -> e
  | Ok (Error _ as e) -> e
  | Ok (Ok _ as ok) -> ok