Merge branch 'async-lwt' of ../ppx_rapper_clone into lemaetech-async-lwt

dune-project

@@ -31,3 +31,29 @@
   caqti
   caqti-lwt
   (caqti-type-calendar :with-test)))
+
+(package
+ (name ppx_rapper_async)
+ (synopsis "Async support for ppx_rapper")
+ (depends
+  (ocaml
+   (>= 4.07))
+  (dune
+   (>= 2.0.1))
+  ppx_rapper
+  caqti-async
+  caqti
+  async))
+
+(package
+ (name ppx_rapper_lwt)
+ (synopsis "Lwt support for ppx_rapper")
+ (depends
+  (ocaml
+   (>= 4.07))
+  (dune
+   (>= 2.0.1))
+  ppx_rapper
+  caqti-lwt
+  caqti
+  lwt))

examples/async/dune

@@ -0,0 +1,5 @@
+(library
+ (name examples_async)
+ (libraries async ppx_rapper_async)
+ (preprocess
+  (pps ppx_rapper)))

examples/async/examples_async.ml

@@ -0,0 +1,120 @@
+(* Simple queries *)
+type a = { username: string }
+
+type b = { id: int; username: string }
+
+let many_arg_execute =
+  [%rapper
+    execute
+      {sql|
+      UPDATE users
+      SET (username, email, bio) = (%string{username}, %string{email}, %string?{bio})
+      WHERE id = %int{id}
+      |sql}]
+
+let many_arg_get_one_repeated_arg =
+  [%rapper
+    get_one
+      {sql|
+      SELECT @string{username}
+      FROM users
+      WHERE id = %int{id} OR username = %string{username} OR id <> %int{id}
+      |sql}
+      record_out]
+
+let many_arg_get_opt =
+  [%rapper
+    get_opt
+      {sql|
+      SELECT @int{id}, @string{username}
+      FROM users
+      WHERE username = %string{username} AND id > %int{min_id}
+      |sql}]
+
+(* Using list parameters *)
+type list_in = { versions: int list }
+
+let collect_list =
+  [%rapper
+    get_many
+      {sql| SELECT @string{id} from schema_migrations where version in (%list{%int{versions}})|sql}
+      record_in]
+
+(* Using custom types *)
+module Suit : Rapper.CUSTOM = struct
+  type t = Clubs | Diamonds | Hearts | Spades
+
+  let t =
+    let encode = function
+      | Clubs -> Ok "c"
+      | Diamonds -> Ok "d"
+      | Hearts -> Ok "h"
+      | Spades -> Ok "s"
+    in
+    let decode = function
+      | "c" -> Ok Clubs
+      | "d" -> Ok Diamonds
+      | "h" -> Ok Hearts
+      | "s" -> Ok Spades
+      | _ -> Error "invalid suit"
+    in
+    Caqti_type.(custom ~encode ~decode string)
+end
+
+let get_cards =
+  [%rapper
+    get_many
+      {sql| SELECT @int{id}, @Suit{suit} FROM cards WHERE suit <> %Suit{suit} |sql}]
+
+(* Example showing the correspondence between rapper/Caqti types and OCaml types *)
+type all_types_output = {
+  id: string;
+  payload: string;
+  version: int;
+  some_int32: int32;
+  some_int64: int64;
+  added: bool;
+  fl: float;
+  date: Ptime.t;
+  time: Ptime.t;
+  span: Ptime.span;
+}
+
+let all_types =
+  [%rapper
+    get_many
+      {sql| SELECT @string{id}, @octets{payload}, @int{version},
+                @int32{some_int32}, @int64{some_int64}, @bool{added},
+                @float{fl}, @pdate{date}, @ptime{time}, @ptime_span{span}
+         FROM some_table |sql}
+      record_out]
+
+(* Example of using [function_out] and [Rapper.load_many] *)
+module Twoot = struct
+  type t = { id: int; content: string; likes: int }
+
+  let make ~id ~content ~likes = { id; content; likes }
+end
+
+module User = struct
+  type t = { id: int; name: string; twoots: Twoot.t list }
+
+  let make ~id ~name = { id; name; twoots = [] }
+end
+
+let get_multiple_function_out () dbh =
+  let open Async.Deferred.Result in
+  [%rapper
+    get_many
+      {sql|
+      SELECT @int{users.id}, @string{users.name},
+             @int{twoots.id}, @string{twoots.content}, @int{twoots.likes}
+      FROM users
+      JOIN twoots ON twoots.id = users.id
+      ORDER BY users.id
+      |sql}
+      function_out]
+    (User.make, Twoot.make) () dbh
+  >>| Rapper.load_many
+        (fst, fun { User.id; _ } -> id)
+        [ (snd, fun user twoots -> { user with twoots }) ]

examples/lwt/dune

@@ -0,0 +1,5 @@
+(library
+ (name examples_lwt)
+ (libraries lwt ppx_rapper_lwt)
+ (preprocess
+  (pps ppx_rapper)))

lib-async/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_rapper_async)
+ (public_name ppx_rapper_async)
+ (wrapped false)
+ (libraries async ppx_rapper.runtime caqti-async caqti))

lib-async/rapper_helper.ml

@@ -0,0 +1,9 @@
+include Rapper.Make_helper (struct
+  type +'a t = 'a Async.Deferred.t
+
+  let return = Async.return
+
+  let map f a = Async.Deferred.map ~f a
+
+  module Stream = Caqti_async.Stream
+end)

lib-async/rapper_helper.mli

@@ -0,0 +1,4 @@
+include
+  Rapper.RAPPER_HELPER
+    with type 'a future := 'a Async.Deferred.t
+     and module Stream = Caqti_async.Stream

lib-lwt/dune

@@ -0,0 +1,5 @@
+(library
+ (name ppx_rapper_lwt)
+ (public_name ppx_rapper_lwt)
+ (wrapped false)
+ (libraries lwt ppx_rapper.runtime caqti-lwt caqti))

lib-lwt/rapper_helper.ml

@@ -0,0 +1,9 @@
+include Rapper.Make_helper (struct
+  type +'a t = 'a Lwt.t
+
+  let return = Lwt.return
+
+  let map = Lwt.map
+
+  module Stream = Caqti_lwt.Stream
+end)

lib-lwt/rapper_helper.mli

@@ -0,0 +1,4 @@
+include
+  Rapper.RAPPER_HELPER
+    with type 'a future := 'a Lwt.t
+     and module Stream = Caqti_lwt.Stream

lib-runtime/dune

@@ -1,4 +1,4 @@
 (library
  (name rapper)
  (public_name ppx_rapper.runtime)
- (libraries caqti caqti-lwt))
+ (libraries caqti))

lib-runtime/rapper.ml

@@ -49,3 +49,44 @@ module Internal = struct
     let add t x (Pack (t', x')) = Pack (Caqti_type.tup2 t' t, (x', x))
   end
 end
+
+module type IO = sig
+  type +'a t
+
+  val return : 'a -> 'a t
+
+  val map : ('a -> 'b) -> 'a t -> 'b t
+
+  (* Need this for Caqti_connection_sig.S *)
+  module Stream : Caqti_stream.S with type 'a future := 'a t
+end
+
+module type RAPPER_HELPER = sig
+  type +'a future
+
+  val map : ('a -> 'b) -> 'a future -> 'b future
+
+  val fail : 'e -> ('a, 'e) result future
+
+  module Stream : Caqti_stream.S with type 'a future := 'a future
+
+  module type CONNECTION =
+    Caqti_connection_sig.S
+      with type 'a future := 'a future
+       and type ('a, 'err) stream := ('a, 'err) Stream.t
+end
+
+module Make_helper (Io : IO) :
+  RAPPER_HELPER with type 'a future := 'a Io.t and module Stream = Io.Stream =
+struct
+  let map = Io.map
+
+  let fail e = Io.return (Error e)
+
+  module Stream = Io.Stream
+
+  module type CONNECTION =
+    Caqti_connection_sig.S
+      with type 'a future := 'a Io.t
+       and type ('a, 'err) stream := ('a, 'err) Stream.t
+end

lib-runtime/rapper.mli

@@ -19,3 +19,32 @@ module Internal : sig
     val add : 'a Caqti_type.t -> 'a -> t -> t
   end
 end
+
+module type IO = sig
+  type +'a t
+
+  val return : 'a -> 'a t
+
+  val map : ('a -> 'b) -> 'a t -> 'b t
+
+  (* Need this for Caqti_connection_sig.S *)
+  module Stream : Caqti_stream.S with type 'a future := 'a t
+end
+
+module type RAPPER_HELPER = sig
+  type +'a future
+
+  val map : ('a -> 'b) -> 'a future -> 'b future
+
+  val fail : 'e -> ('a, 'e) result future
+
+  module Stream : Caqti_stream.S with type 'a future := 'a future
+
+  module type CONNECTION =
+    Caqti_connection_sig.S
+      with type 'a future := 'a future
+       and type ('a, 'err) stream := ('a, 'err) Stream.t
+end
+
+module Make_helper (Io : IO) :
+  RAPPER_HELPER with type 'a future := 'a Io.t and module Stream = Io.Stream

ppx/codegen.ml

@@ -257,7 +257,7 @@ let find_body_factory ~loc input_nested_tuple_pattern output_expression
       | Ok [%p input_nested_tuple_pattern] -> Ok [%e output_expression]
       | Error e -> Error e
     in
-    Lwt.map f
+    Rapper_helper.map f
       ([%e connection_function_expr] query [%e input_nested_tuple_expression])]
 
 let find_map_factory ~loc map_expr input_nested_tuple_pattern output_expression
@@ -268,7 +268,7 @@ let find_map_factory ~loc map_expr input_nested_tuple_pattern output_expression
       let f = [%e map_expr] g in
       match result with Ok x -> Ok (f x) | Error e -> Error e
     in
-    Lwt.map f
+    Rapper_helper.map f
       ([%e connection_function_expr] query [%e input_nested_tuple_expression])]
 
 (** Generates the function body for a [find] function ([get_one] statement)*)
@@ -314,19 +314,20 @@ let query_function ~loc ?(body_fn = fun x -> x) function_body_factory
         else
           let input_record_pattern = record_pattern ~loc deduped_in_params in
           [%expr
-            fun [%p input_record_pattern] (module Db : Caqti_lwt.CONNECTION) ->
+            fun [%p input_record_pattern] (module Db : Rapper_helper.CONNECTION) ->
               [%e body]]
     | `Labelled_args ->
         if List.is_empty in_params then
-          [%expr fun () (module Db : Caqti_lwt.CONNECTION) -> [%e body]]
+          [%expr fun () (module Db : Rapper_helper.CONNECTION) -> [%e body]]
         else
           let f in_param body_so_far =
             let name = in_param.Query.name in
             let pattern = Buildef.ppat_var ~loc (Loc.make ~loc name) in
             Buildef.pexp_fun ~loc (Labelled name) None pattern body_so_far
           in
           List.fold_right ~f
-            ~init:[%expr fun (module Db : Caqti_lwt.CONNECTION) -> [%e body]]
+            ~init:
+              [%expr fun (module Db : Rapper_helper.CONNECTION) -> [%e body]]
             deduped_in_params
   in
   match expression_contents.output_kind with

ppx/ppx_rapper.ml

@@ -107,7 +107,7 @@ let make_expand_get_and_exec_expression ~loc parsed_query input_kind output_kind
                     (Codegen.lident_of_param ~loc list_param)]
               with
               | [] ->
-                  Lwt_result.fail
+                  Rapper_helper.fail
                     Caqti_error.(
                       encode_rejected ~uri:Uri.empty ~typ:Caqti_type.unit
                         (Msg "Empty list"))
@@ -126,7 +126,7 @@ let make_expand_get_and_exec_expression ~loc parsed_query input_kind output_kind
                         Dynparam.add
                           (Caqti_type.(
                              [%e
-                               Codegen.make_caqti_type_tup ~loc [ list_param ]]) 
+                               Codegen.make_caqti_type_tup ~loc [ list_param ]])
                           [@ocaml.warning "-33"])
                           item pack)
                       Dynparam.empty elems

ppx_rapper_async.opam

@@ -0,0 +1,33 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "2.0.0"
+synopsis: "Async support for ppx_rapper"
+maintainer: ["Roddy MacSween <github@roddymacsween.co.uk>"]
+authors: ["Roddy MacSween <github@roddymacsween.co.uk>"]
+license: "MIT"
+homepage: "https://github.com/roddyyaga/ppx_rapper"
+doc: "https://github.com/roddyyaga/ppx_rapper"
+bug-reports: "https://github.com/roddyyaga/ppx_rapper/issues"
+depends: [
+  "ocaml" {>= "4.07"}
+  "dune" {>= "2.0.1"}
+  "ppx_rapper"
+  "caqti-async"
+  "caqti"
+  "async"
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/roddyyaga/ppx_rapper.git"