Try to adapt the PostgreSQL paramstring to use with sqitch
This commit is contained in:
parent
673d762e68
commit
0dc05982cd
|
@ -21,7 +21,9 @@
|
||||||
#:use-module (ice-9 threads)
|
#:use-module (ice-9 threads)
|
||||||
#:use-module (squee)
|
#:use-module (squee)
|
||||||
#:use-module (guix-data-service config)
|
#:use-module (guix-data-service config)
|
||||||
#:export (with-postgresql-connection
|
#:export (get-database-config
|
||||||
|
|
||||||
|
with-postgresql-connection
|
||||||
|
|
||||||
with-postgresql-connection-per-thread
|
with-postgresql-connection-per-thread
|
||||||
with-thread-postgresql-connection
|
with-thread-postgresql-connection
|
||||||
|
@ -39,6 +41,22 @@
|
||||||
(define pg-conn-finish
|
(define pg-conn-finish
|
||||||
(@@ (squee) pg-conn-finish))
|
(@@ (squee) pg-conn-finish))
|
||||||
|
|
||||||
|
(define (paramstring->alist s)
|
||||||
|
(map
|
||||||
|
(lambda (param)
|
||||||
|
(match (string-split param #\=)
|
||||||
|
((key val)
|
||||||
|
(cons key val))))
|
||||||
|
(string-split s #\space)))
|
||||||
|
|
||||||
|
(define (get-database-config)
|
||||||
|
(let ((paramstring (getenv "GUIX_DATA_SERVICE_DATABASE_PARAMSTRING")))
|
||||||
|
(if paramstring
|
||||||
|
(paramstring->alist paramstring)
|
||||||
|
`(("dbname" . ,(%config 'database-name))
|
||||||
|
("user" . ,(%config 'database-user))
|
||||||
|
("host" . ,(%config 'database-host))))))
|
||||||
|
|
||||||
(define (open-postgresql-connection name statement-timeout)
|
(define (open-postgresql-connection name statement-timeout)
|
||||||
(define paramstring
|
(define paramstring
|
||||||
(string-append
|
(string-append
|
||||||
|
|
|
@ -141,18 +141,36 @@
|
||||||
(list (%config 'sqitch)
|
(list (%config 'sqitch)
|
||||||
"deploy"
|
"deploy"
|
||||||
"--db-client" (%config 'sqitch-psql)
|
"--db-client" (%config 'sqitch-psql)
|
||||||
"--chdir" (dirname (%config 'sqitch-plan))
|
"--chdir" (dirname (dirname (%config 'sqitch-plan)))
|
||||||
"--plan-file" (%config 'sqitch-plan)
|
"--plan-file" (%config 'sqitch-plan)
|
||||||
(string-append "db:pg://"
|
(let* ((database-config (get-database-config))
|
||||||
(%config 'database-user)
|
(params (string-join
|
||||||
"@"
|
(map
|
||||||
(if (string=? (%config 'database-host)
|
(match-lambda
|
||||||
"localhost")
|
((key . val)
|
||||||
"" ; This means the unix socket
|
(string-append key "=" val)))
|
||||||
|
(filter
|
||||||
|
(match-lambda
|
||||||
|
((key . _)
|
||||||
|
(not (member key '("user"
|
||||||
|
"host"
|
||||||
|
"dbname")))))
|
||||||
|
database-config))
|
||||||
|
"&")))
|
||||||
|
(string-append "db:pg://"
|
||||||
|
(assoc-ref database-config "user")
|
||||||
|
"@"
|
||||||
|
(if (string=? (assoc-ref database-config "host")
|
||||||
|
"localhost")
|
||||||
|
"" ; This means the unix socket
|
||||||
; connection will be used
|
; connection will be used
|
||||||
(%config 'database-host))
|
(assoc-ref database-config "host"))
|
||||||
"/"
|
"/"
|
||||||
(%config 'database-name)))))
|
(assoc-ref database-config "dbname")
|
||||||
|
(if (string-null? params)
|
||||||
|
""
|
||||||
|
"?")
|
||||||
|
params)))))
|
||||||
(simple-format #t "running command: ~A\n"
|
(simple-format #t "running command: ~A\n"
|
||||||
(string-join command))
|
(string-join command))
|
||||||
(unless (zero? (apply system* command))
|
(unless (zero? (apply system* command))
|
||||||
|
|
Loading…
Reference in New Issue