Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

add preliminary support for nested objects #68

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

add preliminary support for nested objects #68

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
28 changes: 27 additions & 1 deletion README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,8 @@ let () =
PGOCaml.close(dbh)
```

## Objects

The PPX allows you to specify that queries returning results should be returned as
objects, rather than tuples. This is not currently supported in the Camlp4 version
(which is being deprecated).
Expand All @@ -96,11 +98,35 @@ List.iter
res
```

## Nested objects

It is possible to generate objects which are further broken down so that columns
from different tables are nested in their own sub-objects.

```ocaml
let%lwt res =
[%pgsql.nestedobject
dbh
"SELECT employees.*,owners.* FROM employees LEFT JOIN owners ON employees.name = owners.name"
]
in
List.iter
(fun row ->
Printf.printf
"%s has %d shares and is paid %f.\n"
row#employees#name
(Int32.to_int row#owners#shares)
row#employees#salary)
rows
```

## Complex expressions as values within queries

The PPX now also supports `${...}` expansions.

```ocaml
(* where [e] is a row returned by a [pgsql.object] query *)
let%lwt incr_sal e =
let incr_sal e =
[%pgsql dbh "UPDATE employees SET salary = ${e#salary +. 1.0}"]
```

Expand Down
4 changes: 4 additions & 0 deletions _oasis
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -113,3 +113,7 @@ Test "pgocaml_highlevel"
Test "test_re"
Command: $test_re
WorkingDirectory: tests

Test "test_ppx"
Command: $test_ppx
WorkingDirectory: tests_ppx
203 changes: 161 additions & 42 deletions ppx/ppx_pgsql.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,7 @@ let mk_listpat ~loc results =
(range 0 (List.length results))
([%pat? []][@metaloc loc])

let pgsql_expand ~genobject ?(flags = []) loc dbh query =
let pgsql_expand ~genobject ~wrapobject ?(flags = []) loc dbh query =
let open Rresult in
let (key, f_execute, f_nullable_results, comment_src_loc) = parse_flags flags loc in
let query =
Expand Down Expand Up @@ -428,15 +428,17 @@ let pgsql_expand ~genobject ?(flags = []) loc dbh query =
(* Have we prepared this statement already? If not, do so. *)
let is_prepared = Hashtbl.mem hash name in
PGOCaml.bind
(if not is_prepared then
PGOCaml.bind (PGOCaml.prepare dbh ~name ~query ()) (fun () ->
Hashtbl.add hash name true;
PGOCaml.return ()
)
else
PGOCaml.return ()) (fun () ->
(* Execute the statement, returning the rows. *)
PGOCaml.execute_rev dbh ~name ~params ())
( if not is_prepared then
PGOCaml.bind
(PGOCaml.prepare dbh ~name ~query ())
(fun () ->
Hashtbl.add hash name true;
PGOCaml.return ())
else
PGOCaml.return ())
(fun () ->
(* Execute the statement, returning the rows. *)
PGOCaml.execute_rev dbh ~name ~params ())
][@metaloc loc] in

(** decorate the results with the nullability heuristic *)
Expand Down Expand Up @@ -502,33 +504,149 @@ let pgsql_expand ~genobject ?(flags = []) loc dbh query =
match (genobject, results') with
| true, Some results ->
let list = mk_listpat ~loc results in
let fields =
List.map
(fun ({PGOCaml.name; field_type; _}, nullable) ->
name, coretype_of_type ~loc field_type, nullable)
results
in
let convert =
List.map2
(fun (name, _, _) conv ->
{ pcf_desc = Pcf_method(
{txt = name; loc}
, Public
, Cfk_concrete(Fresh, conv)
)
; pcf_loc = loc
; pcf_attributes = []
}
)
fields
(mk_conversions ~loc ~dbh:my_dbh results)
|> fun fields ->
Exp.mk (
Pexp_object({
pcstr_self = Pat.any ~loc ()
; pcstr_fields = fields
})
let fields =
List.map
(fun ({PGOCaml.name; table; _}, _) ->
name, table
)
results
in
(* we need a list of methods for the object *)
let kids =
if wrapobject
then begin
let module SMap = Map.Make(String) in
let query = "SELECT relname,oid FROM pg_class" in
let query_nam = "tables_oids_pgsql" in
let () = PGOCaml.prepare my_dbh ~name:query_nam ~query () in
let rows = PGOCaml.execute my_dbh ~name:query_nam ~params:[] () in
let module OIDsMap = Map.Make(struct
type t = int32
let compare = compare
end)
in
(* need to be able to get the name of a table from an OID *)
let oidsmap =
List.fold_left
(fun map [Some nam; Some oid] ->
OIDsMap.add (Int32.of_string oid) nam map)
OIDsMap.empty
rows
in
let descs =
List.map2
(fun (name, table) conv -> (name, table), conv)
fields
(mk_conversions ~loc ~dbh:my_dbh results)
in
let module FieldSet = Set.Make(struct
type t = (string * expression)
(* I've heard that the generic [compare] function is bad, but I'm
not about to write a comparator for [expression]s *)
let compare (a:t) (b:t) = compare a b
end)
in
let module StringMap = Map.Make(struct
type t = string option
let compare = compare
end) in
(* we need to collect the columns into tables *)
let collected =
List.fold_left
(fun acc ((label, oid), conv) ->
let tnam =
match oid with
| None -> None
| Some oid -> Some(OIDsMap.find oid oidsmap)
in
let new_val =
match StringMap.find_opt tnam acc with
| Some fs -> FieldSet.add (label, conv) fs
| None -> FieldSet.singleton (label, conv)
in
(* make sure that there's only one definition of any given set *)
StringMap.remove tnam acc
|> StringMap.add tnam new_val
)
StringMap.empty
descs
in
let sub_methods =
StringMap.bindings collected
|> List.map
(fun (tnam, fields) ->
let fields = FieldSet.elements fields in
match tnam with
| Some nam ->
(* make a sub-object *)
let methods =
List.map
(fun (name, conv) ->
{ pcf_desc = Pcf_method(
{txt = name; loc}
, Public
, Cfk_concrete(Fresh, conv)
)
; pcf_loc = loc
; pcf_attributes = []
})
fields
in
let sub_object = Exp.mk (
Pexp_object({
pcstr_self = Pat.any ~loc ()
; pcstr_fields = methods
})
)
in
[ { pcf_desc = Pcf_method(
{txt = nam; loc}
, Public
, Cfk_concrete(Fresh, sub_object)
)
; pcf_loc = loc
; pcf_attributes = []
}
]
| None ->
(* all the fields that aren't associated with a table *)
List.map
(fun (name, conv) ->
{ pcf_desc = Pcf_method(
{txt = name; loc}
, Public
, Cfk_concrete(Fresh, conv)
)
; pcf_loc = loc
; pcf_attributes = []
})
fields
)
in
List.flatten sub_methods
end
else
List.map2
(fun (name, _table) conv ->
{ pcf_desc = Pcf_method(
{txt = name; loc}
, Public
, Cfk_concrete(Fresh, conv)
)
; pcf_loc = loc
; pcf_attributes = []
}
)
fields
(mk_conversions ~loc ~dbh:my_dbh results)
in
Exp.mk (
Pexp_object({
pcstr_self = Pat.any ~loc ()
; pcstr_fields = kids
})
)
in
let expr = mkexpr ~convert ~list in
Ok expr
Expand All @@ -548,12 +666,12 @@ let pgsql_expand ~genobject ?(flags = []) loc dbh query =
| false, None ->
Ok ([%expr PGOCaml.bind [%e expr] (fun _rows -> PGOCaml.return ())][@metaloc loc])

let expand_sql ~genobject loc dbh extras =
let expand_sql ~genobject ~wrapobject loc dbh extras =
let query, flags =
match List.rev extras with
| [] -> assert false
| query :: flags -> query, flags in
try pgsql_expand ~genobject ~flags loc dbh query
try pgsql_expand ~genobject ~wrapobject ~flags loc dbh query
with
| Failure s -> Error(s, loc)
| PGOCaml.Error s -> Error(s, loc)
Expand Down Expand Up @@ -602,20 +720,21 @@ let pgocaml_mapper _argv =
; _
} when String.starts_with txt "pgsql" ->
let open Rresult in
let genobject = txt = "pgsql.object" in
let genobject = txt = "pgsql.object" || txt = "pgsql.nestedobject" in
let wrapobject = txt = "pgsql.nestedobject" in
( match list_of_string_args (default_mapper.expr mapper) args with
| [] -> unsupported loc
| args ->
let x = expand_sql ~genobject loc dbh args in
let x = expand_sql ~genobject ~wrapobject loc dbh args in
( match x with
| Rresult.Ok ({ pexp_desc; pexp_loc = _ ; pexp_attributes }) ->
{pexp_desc; pexp_loc = qloc; pexp_attributes}
| Error(s, loc) ->
| Error(s, errloc) ->
{ expr with
pexp_desc = Pexp_extension (
extension_of_error @@
Location.error ~loc ("PG'OCaml PPX error: " ^ s))
; pexp_loc = loc
Location.error ~loc:errloc ("PG'OCaml PPX error: " ^ s))
; pexp_loc = errloc
}
)
)
Expand Down
Loading