package transom

  1. Overview
  2. Docs
OCaml sidecar glue for Tauri-style desktop apps

Install 

dune-project
 Dependency

github.com Readme Edit opam file Versions (2)

Authors

  1. F
    funwithcthulhu

Maintainers

  1. F
    funwithcthulhu29@gmail.com

Sources

v0.1.0.tar.gz
md5=a6aa17a9cab249e390f574553bc22620
sha512=56ac775c6b61fc45488795f2658fcfcbf380427f9477e94d6d69770a6df288851f266fb026d27696ba579caa37386404e4059fa2d2218b23e8b1e5c59cd9994b

doc/src/transom.codegen/manifest.ml.html

Source file manifest.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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
type command =
  { name : string
  ; request : string
  ; response : string
  ; event : string option
  ; ts_request : string
  ; ts_response : string
  ; ts_event : string option
  }

type t =
  { service_module : string
  ; types_module : string
  ; json_module : string
  ; typescript_types_module : string
  ; commands : command list
  }

let error message = Error message

let assoc path = function
  | `Assoc fields -> Ok fields
  | _ -> error (path ^ " must be an object")

let field path name fields =
  match List.assoc_opt name fields with
  | Some value -> Ok value
  | None -> error (path ^ "." ^ name ^ " is required")

let non_empty_string path = function
  | `String value when String.length value > 0 -> Ok value
  | `String _ -> error (path ^ " must be non-empty")
  | _ -> error (path ^ " must be a string")

let string_field path name fields =
  match field path name fields with
  | Error message -> error message
  | Ok value -> non_empty_string (path ^ "." ^ name) value

let optional_string_field path name fields =
  match List.assoc_opt name fields with
  | None -> Ok None
  | Some value ->
    (match non_empty_string (path ^ "." ^ name) value with
     | Ok value -> Ok (Some value)
     | Error message -> error message)

let command_of_yojson index json =
  let path = Printf.sprintf "commands[%d]" index in
  match assoc path json with
  | Error message -> error message
  | Ok fields ->
    let required name = string_field path name fields in
    let optional name = optional_string_field path name fields in
    (match
       required "name",
       required "request",
       required "response",
       optional "event",
       optional "ts_request",
       optional "ts_response",
       optional "ts_event"
     with
     | Ok name, Ok request, Ok response, Ok event, Ok ts_request, Ok ts_response, Ok ts_event ->
       Ok
         { name
         ; request
         ; response
         ; event
         ; ts_request = Option.value ts_request ~default:request
         ; ts_response = Option.value ts_response ~default:response
         ; ts_event = (match ts_event with Some _ -> ts_event | None -> event)
         }
     | Error message, _, _, _, _, _, _
     | _, Error message, _, _, _, _, _
     | _, _, Error message, _, _, _, _
     | _, _, _, Error message, _, _, _
     | _, _, _, _, Error message, _, _
     | _, _, _, _, _, Error message, _
     | _, _, _, _, _, _, Error message -> error message)

module Names = Set.Make (String)

let check_unique_names commands =
  let rec loop seen = function
    | [] -> Ok ()
    | command :: rest ->
      if Names.mem command.name seen then
        error ("duplicate command name: " ^ command.name)
      else
        loop (Names.add command.name seen) rest
  in
  loop Names.empty commands

let commands_of_yojson = function
  | `List commands ->
    let rec loop index acc = function
      | [] ->
        let commands = List.rev acc in
        (match check_unique_names commands with
         | Ok () -> Ok commands
         | Error message -> error message)
      | json :: rest ->
        (match command_of_yojson index json with
         | Ok command -> loop (index + 1) (command :: acc) rest
         | Error message -> error message)
    in
    loop 0 [] commands
  | _ -> error "commands must be an array"

let of_yojson json =
  match assoc "manifest" json with
  | Error message -> error message
  | Ok fields ->
    let required name = string_field "manifest" name fields in
    let typescript_types_module =
      match optional_string_field "manifest" "typescript_types_module" fields with
      | Ok (Some value) -> Ok value
      | Ok None -> Ok "./api_types"
      | Error message -> error message
    in
    (match
       required "service_module",
       required "types_module",
       required "json_module",
       typescript_types_module,
       field "manifest" "commands" fields
     with
     | Ok service_module, Ok types_module, Ok json_module, Ok typescript_types_module, Ok commands_json ->
       (match commands_of_yojson commands_json with
        | Ok commands ->
          Ok { service_module; types_module; json_module; typescript_types_module; commands }
        | Error message -> error message)
     | Error message, _, _, _, _
     | _, Error message, _, _, _
     | _, _, Error message, _, _
     | _, _, _, Error message, _
     | _, _, _, _, Error message -> error message)

let read_file path =
  let input = open_in_bin path in
  Fun.protect
    ~finally:(fun () -> close_in_noerr input)
    (fun () ->
       let length = in_channel_length input in
       really_input_string input length)

let load_file path =
  match read_file path with
  | exception Sys_error message -> error message
  | text ->
    (match Yojson.Safe.from_string text with
     | json -> of_yojson json
     | exception Yojson.Json_error message -> error ("invalid JSON: " ^ message))