Source file sqlgg_io.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
(**
  OCaml IO signature for sqlgg
  by Raman Varabets
  2018-12-19

  This is free and unencumbered software released into the public domain.

  Anyone is free to copy, modify, publish, use, compile, sell, or
  distribute this software, either in source code form or as a compiled
  binary, for any purpose, commercial or non-commercial, and by any
  means.

  For more information, please refer to <http://unlicense.org/>
*)

module type M = sig
  type 'a future
  val return : 'a -> 'a future
  val (>>=) : 'a future -> ('a -> 'b future) -> 'b future
  val bracket : 'a future -> ('a -> unit future) -> ('a -> 'b future) -> 'b future
end

module type M_control = sig 
  include M
  val catch : (unit -> 'a future) -> (exn -> 'a future) -> 'a future
  val try_bind : (unit -> 'a future) -> ('a -> 'b future) -> (exn -> 'b future) -> 'b future
  val async : (unit -> unit future) -> unit

  module List : sig
    val iter_s : ('a -> unit future) -> 'a list -> unit future
  end
end

module Blocking : M_control with type 'a future = 'a = struct

  type 'a future = 'a

  let return x = x

  let (>>=) x f = f x

  let bracket x dtor f =
    let r = try f x with exn -> dtor x; raise exn in
    dtor x;
    r

  let catch f h =
    try f () with exn -> h exn

  let try_bind f succ_handler exc_handler =
    try
      let x = f () in
      succ_handler x
    with exn -> exc_handler exn

  let async f = ignore (f ())

  module List = struct
    let rec iter_s f = function
      | [] -> return ()
      | x :: xs ->
          f x >>= fun () ->
          iter_s f xs 
  end
end