Source file caqti_driver_info.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
108
109
110
111
112
113
114
(* Copyright (C) 2017--2024  Petter A. Urkedal <paurkedal@gmail.com>
 *
 * This library is free software; you can redistribute it and/or modify it
 * under the terms of the GNU Lesser General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or (at your
 * option) any later version, with the LGPL-3.0 Linking Exception.
 *
 * This library is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
 * License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public License
 * and the LGPL-3.0 Linking Exception along with this library.  If not, see
 * <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.
 *)

[@@@alert "-caqti_private"]

open Caqti_template

type dialect_tag = [`Mysql | `Pgsql | `Sqlite | `Other]
type sql_dialect_tag = [`Mysql | `Pgsql | `Sqlite]
type parameter_style =
  [ `None
  | `Linear of string
  | `Indexed of (int -> string) ]

type t = {
  uri_scheme: string;
  dialect_tag: dialect_tag;
  parameter_style: parameter_style;
  can_transact: bool;
  can_pool: bool;
  can_concur: bool;
  dummy_dialect: Dialect.t;
}

let create
    ~uri_scheme
    ?(dialect_tag = `Other)
    ?(parameter_style = `None)
    ~can_pool
    ~can_concur
    ~can_transact
    ~dummy_dialect
    () =
  {
    uri_scheme;
    dialect_tag;
    parameter_style;
    can_transact;
    can_pool;
    can_concur;
    dummy_dialect;
  }

let dummy = create
  ~uri_scheme:"dummy"
  ~can_pool:false ~can_concur:false ~can_transact:false
  ~dummy_dialect:(Dialect.create_unknown ~purpose:`Dummy ())
  ()

let uri_scheme di = di.uri_scheme
let dialect_tag di = di.dialect_tag
let parameter_style di = di.parameter_style
let can_pool di = di.can_pool
let can_concur di = di.can_concur
let can_transact di = di.can_transact

let dummy_dialect di = di.dummy_dialect

let of_dialect = function
 | Dialect.Pgsql {client_library = `postgresql; _} as dialect ->
    create
      ~uri_scheme:"postgresql"
      ~dialect_tag:`Pgsql
      ~parameter_style:(`Indexed (fun i -> "$" ^ string_of_int (succ i)))
      ~can_pool:true
      ~can_concur:true
      ~can_transact:true
      ~dummy_dialect:dialect
      ()
 | Dialect.Pgsql {client_library = `pgx; _} as dialect ->
    create
      ~uri_scheme:"pgx"
      ~dialect_tag:`Pgsql
      ~parameter_style:(`Indexed (fun i -> "$" ^ string_of_int (succ i)))
      ~can_pool:true
      ~can_concur:true
      ~can_transact:true
      ~dummy_dialect:dialect
      ()
 | Dialect.Mysql _ as dialect ->
    create
      ~uri_scheme:"mariadb"
      ~dialect_tag:`Mysql
      ~parameter_style:(`Linear "?")
      ~can_pool:true
      ~can_concur:true
      ~can_transact:true
      ~dummy_dialect:dialect
      ()
 | Dialect.Sqlite _ as dialect ->
    create
      ~uri_scheme:"sqlite3"
      ~dialect_tag:`Sqlite
      ~parameter_style:(`Linear "?")
      ~can_pool:true
      ~can_concur:false
      ~can_transact:true
      ~dummy_dialect:dialect
      ()
 | _ -> dummy