2 * SQL database interfaces for Standard ML
3 * Copyright (C
) 2003 Adam Chlipala
5 * This library is free software
; you can redistribute it
and/or
6 * modify it under the terms
of the GNU Lesser General Public
7 * License
as published by the Free Software Foundation
; either
8 * version
2.1 of the License
, or (at your option
) any later version
.
10 * This library is distributed
in the hope that it will be useful
,
11 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the GNU
13 * Lesser General Public License for more details
.
15 * You should have received a copy
of the GNU Lesser General Public
16 * License along
with this library
; if not
, write to the Free Software
17 * Foundation
, Inc
., 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
20 structure PgDriver
:> SQL_DRIVER
=
22 val print
= TextIO.print
24 type conn
= (ST_pg_conn
.tag
, C
.rw
) C
.su_obj C
.ptr
'
26 exception Sql
of string
28 type value
= string option
30 fun cerrmsg con
= Int32
.toString (F_PQstatus
.f
' (C
.Ptr
.ro
' con
)) ^
": "
31 ^ ZString
.toML
' (F_PQerrorMessage
.f
' (C
.Ptr
.ro
' con
))
33 fun errmsg (con
, res
, query
) = Int32
.toString (F_PQresultStatus
.f
' (C
.Ptr
.ro
' res
)) ^
": " ^ ZString
.toML
' (F_PQresultErrorMessage
.f
' (C
.Ptr
.ro
' res
)) ^
": " ^ ZString
.toML
' query
37 val params
= ZString
.dupML
' params
38 val c
= F_PQconnectdb
.f
' params
39 val _
= C
.free
' params
41 if C
.Ptr
.isNull
' c
then
42 raise Sql
"Null connection returned"
44 (case F_PQstatus
.f
' (C
.Ptr
.ro
' c
) of
55 fun close c
= ignore (F_PQfinish
.f
' c
)
59 val q
= ZString
.dupML
' q
60 val res
= F_PQexec
.f
' (c
, q
)
61 val roRes
= C
.Ptr
.ro
' res
62 val code
= F_PQresultStatus
.f
' roRes
63 fun done () = (C
.free
' q
;
71 val msg
= errmsg (c
, res
, q
)
79 if C
.Ptr
.isNull
' v
then
82 SOME (ZString
.toML
' v
)
86 val q
= ZString
.dupML
' q
87 val res
= F_PQexec
.f
' (c
, q
)
88 val roRes
= C
.Ptr
.ro
' res
89 fun done () = (C
.free
' q
;
92 val code
= F_PQresultStatus
.f
' roRes
97 val nt
= F_PQntuples
.f
' roRes
98 val nf
= F_PQnfields
.f
' roRes
100 fun builder (i
, acc
) =
105 fun build (~
1, acc
) = acc
108 if F_PQgetisnull
.f
' (roRes
, i
, j
) <> 0 then
111 makeValue (F_PQgetvalue
.f
' (roRes
, i
, j
)) :: acc
)
113 builder (i
+1, f (build (nf
-1, []), acc
))
121 val msg
= errmsg (c
, res
, q
)
129 type timestamp
= Time
.time
130 exception Format
of string
134 NONE
=> raise Sql
"Trying to read NULL value"
144 "-" ^
Int.toString(~n
)
147 fun intFromSql
' "" = 0
149 (case Int.fromString s
of
150 NONE
=> raise Format ("Bad integer: " ^ s
)
152 fun intFromSql v
= intFromSql
' (valueOf v
)
161 foldl (fn (c
, s
) => s ^ xch c
) "'" (String.explode s
) ^
"'"
163 val stringFromSql
= valueOf
167 "-" ^
Real.toString(~s
)
170 fun realFromSql
' "" = 0.0
172 (case Real.fromString s
of
173 NONE
=> raise Format ("Bad real: " ^ s
)
175 fun realFromSql v
= realFromSql
' (valueOf v
)
176 fun realToString s
= realToSql s
195 | _
=> raise Format
"Invalid month number"
218 | pad
' (s
, n
) = pad
' ("0" ^ s
, n
-1)
221 val base
= Int.toString n
223 pad
' (base
, Int.max (i
- size base
, 0))
226 fun offsetStr NONE
= "+00"
227 |
offsetStr (SOME n
) =
229 val n
= LargeInt
.toInt (Time
.toSeconds n
) div 3600
237 fun timestampToSqlUnquoted t
=
239 val d
= Date
.fromTimeLocal t
241 pad (Date
.year d
, 4) ^
"-" ^
pad (fromMonth (Date
.month d
), 2) ^
"-" ^
pad (Date
.day d
, 2) ^
242 " " ^
pad (Date
.hour d
, 2) ^
":" ^
pad (Date
.minute d
, 2) ^
":" ^
pad (Date
.second d
, 2) ^
243 ".000000" ^
offsetStr (Date
.offset d
)
245 fun timestampToSql t
= "'" ^ timestampToSqlUnquoted t ^
"'"
246 fun timestampFromSql
' s
=
248 val tokens
= String.tokens (fn ch
=> ch
= #
"-" orelse ch
= #
" " orelse ch
= #
":"
249 orelse ch
= #
"." orelse ch
= #
"+") s
252 [year
, mon
, day
, hour
, minute
, second
, _
, offset
] =>
253 Date
.toTime (Date
.date
{day
= valOf (Int.fromString day
), hour
= valOf (Int.fromString hour
), minute
= valOf (Int.fromString minute
),
254 month
= toMonth (valOf (Int.fromString mon
)),
255 offset
= SOME (Time
.fromSeconds (LargeInt
.fromInt (valOf (Int.fromString offset
) * 3600))),
256 second
= valOf (Int.fromString second
) div 1000, year
= valOf (Int.fromString year
)})
257 |
[year
, mon
, day
, hour
, minute
, second
, _
] =>
258 Date
.toTime (Date
.date
{day
= valOf (Int.fromString day
), hour
= valOf (Int.fromString hour
), minute
= valOf (Int.fromString minute
),
259 month
= toMonth (valOf (Int.fromString mon
)),
261 second
= valOf (Int.fromString second
), year
= valOf (Int.fromString year
)})
262 |
[year
, mon
, day
, hour
, minute
, second
] =>
263 Date
.toTime (Date
.date
{day
= valOf (Int.fromString day
), hour
= valOf (Int.fromString hour
), minute
= valOf (Int.fromString minute
),
264 month
= toMonth (valOf (Int.fromString mon
)),
266 second
= valOf (Int.fromString second
) div 1000, year
= valOf (Int.fromString year
)})
267 | _
=> raise Format ("Invalid timestamp " ^ s
)
269 fun timestampFromSql v
= timestampFromSql
' (valueOf v
)
272 fun boolToSql
true = "TRUE"
273 | boolToSql
false = "FALSE"
275 fun boolFromSql
' "FALSE" = false
276 | boolFromSql
' "f" = false
277 | boolFromSql
' "false" = false
278 | boolFromSql
' "n" = false
279 | boolFromSql
' "no" = false
280 | boolFromSql
' "0" = false
281 | boolFromSql
' "" = false
282 | boolFromSql
' _
= true
284 fun boolFromSql v
= boolFromSql
' (valueOf v
)
287 structure PgClient
= SqlClient(PgDriver
)