Acessando base de dados SQL com Scheme

Em alguns projetos em que estou trabalhando seguidamente tenho que acessar tabelas de bases de dados. Costumo usar o Postgres através do egg postgresql do sistema Chicken.

Para evitar de esquecer de fechar as conexões com o banco, normalmente uso um procedimento que recebe uma query como argumento. Este procedimento abre a conexão com o banco, executa a query e fecha a conexão automaticamente (o desempenho que se dane :-)). As credenciais do banco mantenho em um parâmetro (definido com make-parameter). O procedimento é algo como:

(define db-credentials (make-parameter '()))

(define (db-query query)
  (let* ((db (pg:connect (db-credentials)))
         (output (pg:query-tuples query db)))
    (pg:close db)
    output))

Mesmo com o uso do procedimento db-query, o acesso a colunas do banco não é das tarefas mais simples. Abaixo está um exemplo em que quero acessar as colunas username e email de uma tabela e associar o valor delas à variáveis em Scheme:

(db-credentials '((host . "localhost")
                  (user . "usuario")
                  (password . "****")
                  (dbname . "nome-da-base")))

(let* ((results
        (let ((results
               (db-query
                "select username,email from users where user_id=1")))
          (if (null? results)
              #f
              (car results))))
       (username (and results (vector-ref results 0)))
       (email (and results (vector-ref results 1))))
  (print username)
  (print email))

Como pode ser visto no exemplo, associar valores de colunas da base de dados a variáveis em Scheme é uma certa novela. Para facilitar esta tarefa, fiz o esquema mostrado abaixo:

(use postgresql)

(define db-map:credentials (make-parameter '()))

(define db-map:create-object
  (let ()
    (define (db-query query)
      (let* ((db (pg:connect (db-map:credentials)))
             (output (pg:query-tuples query db)))
        (pg:close db)
        output))
    (lambda (query fields)
      (let* ((query-results (let ((results (db-query query)))
                              (if (null? results)
                                  #f
                                  (car results)))))
        (lambda (field)
          (and query-results
               (let ((pos (list-index (cut eq? <> field)
                                      fields)))
                 (vector-ref query-results pos))))))))

O procedimento db-map:create-object recebe uma query SQL e uma lista de símbolos a serem associados com os valores das colunas obtidos como resultado da execução da query. db-map:create-object retorna um procedimento que recebe como argumento um símbolo representando uma coluna da base de dados e que retorna o valor associado ao símbolo.

Assim, para acessar o valor das colunas username e email, faço o seguinte:

(let ((obj (db-map:create-object
            "select username,email from users where user_id=1"
            '(username email))))
  (print (obj 'username))
  (print (obj 'email)))

A ordem dos símbolos da lista passada como segundo argumento deve ser a mesma dos valores das colunas resultantes da query SQL.