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/gen_ocaml_server.ml.html

Source file gen_ocaml_server.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
let lower_module_filename name = String.lowercase_ascii name

let handler_lines types_module command =
  match command.Manifest.event with
  | None ->
    [ Printf.sprintf "  val %s :" command.name
    ; Printf.sprintf "    %s.%s ->" types_module command.request
    ; Printf.sprintf "    (%s.%s, Transom_runtime.Error.t) result" types_module command.response
    ]
  | Some event ->
    [ Printf.sprintf "  val %s :" command.name
    ; Printf.sprintf "    %s.%s ->" types_module command.request
    ; Printf.sprintf "    emit:(%s.%s -> unit) ->" types_module event
    ; Printf.sprintf "    (%s.%s, Transom_runtime.Error.t) result" types_module command.response
    ]

let handlers_module_type manifest =
  [ "module type HANDLERS = sig" ]
  @ List.concat_map (handler_lines manifest.Manifest.types_module) manifest.commands
  @ [ "end" ]

let dispatch_signature =
  [ "  val dispatch :"
  ; "    method_:string ->"
  ; "    params:Yojson.Safe.t ->"
  ; "    emit:(Yojson.Safe.t -> unit) ->"
  ; "    (Yojson.Safe.t, Transom_runtime.Error.t) result"
  ; ""
  ; "  val run_stdio : unit -> unit"
  ]

let interface manifest =
  String.concat
    "\n"
    (handlers_module_type manifest
     @ [ ""
       ; "module Make (_ : HANDLERS) : sig"
       ]
     @ dispatch_signature
     @ [ "end"; "" ])

let response_encode json_module command =
  Printf.sprintf
    "Yojson.Safe.from_string (%s.string_of_%s res)"
    json_module
    command.Manifest.response

let request_decode json_module command =
  Printf.sprintf
    "%s.%s_of_string (Yojson.Safe.to_string params)"
    json_module
    command.Manifest.request

let event_emit json_module event =
  Printf.sprintf
    "emit (Yojson.Safe.from_string (%s.string_of_%s ev))"
    json_module
    event

let branch manifest command =
  let json_module = manifest.Manifest.json_module in
  let decode = request_decode json_module command in
  let encode = response_encode json_module command in
  let handler_lines =
    match command.Manifest.event with
    | None -> [ Printf.sprintf "         match H.%s req with" command.name ]
    | Some event ->
      [ Printf.sprintf "         let emit_event ev = %s in" (event_emit json_module event)
      ; Printf.sprintf "         match H.%s req ~emit:emit_event with" command.name
      ]
  in
  [ Printf.sprintf "    | %S ->" command.name
  ; "      (match"
  ; "         (try Ok"
  ; Printf.sprintf "                (%s)" decode
  ; "          with exn -> Error (bad_request method_ exn))"
  ; "       with"
  ; "       | Error err -> Error err"
  ; "       | Ok req ->"
  ]
  @ handler_lines
  @
  [ Printf.sprintf "         | Ok res -> Ok (%s)" encode
  ; "         | Error err -> Error err)"
  ]

let implementation manifest =
  let branches = List.concat_map (branch manifest) manifest.Manifest.commands in
  String.concat
    "\n"
    (handlers_module_type manifest
     @ [ ""
       ; "module Make (H : HANDLERS) = struct"
       ; "  let bad_request method_ exn ="
       ; "    Transom_runtime.Error.bad_request"
       ; "      (\"Invalid params for \" ^ method_ ^ \": \" ^ Printexc.to_string exn)"
       ; ""
       ; "  let dispatch ~method_ ~params ~emit ="
       ; "    match method_ with"
       ]
     @ branches
     @ [ "    | _ -> Error (Transom_runtime.Error.unknown_method method_)"
       ; ""
       ; "  let run_stdio () = Transom_runtime.run ~dispatch"
       ; "end"
       ; ""
       ])