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 fun cerrmsg con
= Int32
.toString (F_PQstatus
.f
' (C
.Ptr
.ro
' con
)) ^
": "
29 ^ ZString
.toML
' (F_PQerrorMessage
.f
' (C
.Ptr
.ro
' con
))
31 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
35 val params
= ZString
.dupML
' params
36 val c
= F_PQconnectdb
.f
' params
37 val _
= C
.free
' params
39 if C
.Ptr
.isNull
' c
then
40 raise Sql
"Null connection returned"
42 (case F_PQstatus
.f
' (C
.Ptr
.ro
' c
) of
53 fun close c
= ignore (F_PQfinish
.f
' c
)
57 val q
= ZString
.dupML
' q
58 val res
= F_PQexec
.f
' (c
, q
)
59 val roRes
= C
.Ptr
.ro
' res
60 val code
= F_PQresultStatus
.f
' roRes
61 fun done () = (C
.free
' q
;
69 val msg
= errmsg (c
, res
, q
)
78 val q
= ZString
.dupML
' q
79 val res
= F_PQexec
.f
' (c
, q
)
80 val roRes
= C
.Ptr
.ro
' res
81 fun done () = (C
.free
' q
;
84 val code
= F_PQresultStatus
.f
' roRes
89 val nt
= F_PQntuples
.f
' roRes
90 val nf
= F_PQnfields
.f
' roRes
92 fun builder (i
, acc
) =
97 fun build (~
1, acc
) = acc
99 build (j
-1, ZString
.toML
' (F_PQgetvalue
.f
' (roRes
, i
, j
)) :: acc
)
101 builder (i
+1, f (build (nf
-1, []), acc
))
109 val msg
= errmsg (c
, res
, q
)
117 type timestamp
= Time
.time
118 exception Format
of string
120 fun isNull s
= s
= ""
124 "-" ^
Int.toString(~n
)
127 fun intFromSql
"" = 0
129 (case Int.fromString s
of
130 NONE
=> raise Format ("Bad integer: " ^ s
)
140 foldl (fn (c
, s
) => s ^ xch c
) "'" (String.explode s
) ^
"'"
142 fun stringFromSql s
= s
146 "-" ^
Real.toString(~s
)
149 fun realFromSql
"" = 0.0
151 (case Real.fromString s
of
152 NONE
=> raise Format ("Bad real: " ^ s
)
154 fun realToString s
= realToSql s
173 | _
=> raise Format
"Invalid month number"
196 | pad
' (s
, n
) = pad
' ("0" ^ s
, n
-1)
199 val base
= Int.toString n
201 pad
' (base
, Int.max (i
- size base
, 0))
204 fun offsetStr NONE
= "+00"
205 |
offsetStr (SOME n
) =
207 val n
= LargeInt
.toInt (Time
.toSeconds n
) div 3600
215 fun timestampToSqlUnquoted t
=
217 val d
= Date
.fromTimeLocal t
219 pad (Date
.year d
, 4) ^
"-" ^
pad (fromMonth (Date
.month d
), 2) ^
"-" ^
pad (Date
.day d
, 2) ^
220 " " ^
pad (Date
.hour d
, 2) ^
":" ^
pad (Date
.minute d
, 2) ^
":" ^
pad (Date
.second d
, 2) ^
221 ".000000" ^
offsetStr (Date
.offset d
)
223 fun timestampToSql t
= "'" ^ timestampToSqlUnquoted t ^
"'"
224 fun timestampFromSql s
=
226 val tokens
= String.tokens (fn ch
=> ch
= #
"-" orelse ch
= #
" " orelse ch
= #
":"
227 orelse ch
= #
"." orelse ch
= #
"+") s
230 [year
, mon
, day
, hour
, minute
, second
, _
, offset
] =>
231 Date
.toTime (Date
.date
{day
= intFromSql day
, hour
= intFromSql hour
, minute
= intFromSql minute
,
232 month
= toMonth (intFromSql mon
),
233 offset
= SOME (Time
.fromSeconds (LargeInt
.fromInt (intFromSql offset
* 3600))),
234 second
= intFromSql second
div 1000, year
= intFromSql year
})
235 |
[year
, mon
, day
, hour
, minute
, second
, _
] =>
236 Date
.toTime (Date
.date
{day
= intFromSql day
, hour
= intFromSql hour
, minute
= intFromSql minute
,
237 month
= toMonth (intFromSql mon
),
239 second
= intFromSql second
, year
= intFromSql year
})
240 |
[year
, mon
, day
, hour
, minute
, second
] =>
241 Date
.toTime (Date
.date
{day
= intFromSql day
, hour
= intFromSql hour
, minute
= intFromSql minute
,
242 month
= toMonth (intFromSql mon
),
244 second
= intFromSql second
div 1000, year
= intFromSql year
})
245 | _
=> raise Format ("Invalid timestamp " ^ s
)
249 fun boolToSql
true = "TRUE"
250 | boolToSql
false = "FALSE"
252 fun boolFromSql
"FALSE" = false
253 | boolFromSql
"f" = false
254 | boolFromSql
"false" = false
255 | boolFromSql
"n" = false
256 | boolFromSql
"no" = false
257 | boolFromSql
"0" = false
258 | boolFromSql
"" = false
259 | boolFromSql _
= true
262 structure PgClient
= SqlClient(PgDriver
)