package pgx_lwt

  1. Overview
  2. Docs

Source file pgx_lwt.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
module Io_intf = Io_intf

module type S = Pgx.S with type 'a Io.t = 'a Lwt.t

module Thread = struct
  open Lwt

  module Make (Io : Io_intf.S) = struct
    type 'a t = 'a Lwt.t

    let return = return
    let ( >>= ) = ( >>= )
    let catch = catch

    type sockaddr = Io.sockaddr =
      | Unix of string
      | Inet of string * int

    type in_channel = Io.in_channel
    type out_channel = Io.out_channel

    let output_char = Io.output_char
    let output_string = Io.output_string

    let output_binary_int w n =
      let chr = Char.chr in
      output_char w (chr (n lsr 24))
      >>= fun () ->
      output_char w (chr ((n lsr 16) land 255))
      >>= fun () ->
      output_char w (chr ((n lsr 8) land 255))
      >>= fun () -> output_char w (chr (n land 255))
    ;;

    let flush = Io.flush
    let input_char = Io.input_char
    let really_input = Io.really_input

    let input_binary_int r =
      let b = Bytes.create 4 in
      really_input r b 0 4
      >|= fun () ->
      let s = Bytes.to_string b in
      let code = Char.code in
      (code s.[0] lsl 24) lor (code s.[1] lsl 16) lor (code s.[2] lsl 8) lor code s.[3]
    ;;

    let close_in = Io.close_in
    let open_connection = Io.open_connection

    type ssl_config

    let upgrade_ssl = `Not_supported
    let getlogin = Io.getlogin
    let debug s = Logs_lwt.debug (fun m -> m "%s" s)
    let protect f ~finally = Lwt.finalize f finally

    module Sequencer = struct
      type 'a monad = 'a t
      type 'a t = 'a * Lwt_mutex.t

      let create t = t, Lwt_mutex.create ()
      let enqueue (t, mutex) f = Lwt_mutex.with_lock mutex (fun () -> f t)
    end
  end
end

module Make (Io : Io_intf.S) = struct
  module Thread = Thread.Make (Io)
  include Pgx.Make (Thread)
end