Welcome to the CHICKEN Scheme pasting service

mongo-client.scm added by anonymous on Tue Nov 13 07:35:31 2012

(import chicken scheme)
(use http-client json intarweb uri-common)

(define endpoint (make-parameter "http://localhost:27080"))
(define database (make-parameter #f))
(define connection-name (make-parameter #f))
(define safe (make-parameter #f))

(define (mongo-req #!key (connection-name (connection-name))
                   (endpoint (endpoint)) parameters path (method 'GET)
                   (action ""))
  (with-input-from-request
   (make-request method: method
                 uri: (uri-reference
                       (string-append endpoint "/"
                                      (if (database) (string-append (database) "/") "")
                                      (if path (string-append path "/") "")
                                      action)))
   (if parameters
       (append (if connection-name `((name . ,connection-name)) '())
               (if (safe) '((safe . 1)) '())
               parameters)
       #f)
   json-read))

(define (connect #!key server connection-name)
  (parameterize
   ((database #f))
   (mongo-req path: #f connection-name: connection-name
              method: 'POST action: "_connect"
              parameters: (if server `((server . ,server)) '((nothing . nothing))))))

(define-syntax with-database
  (syntax-rules ()
    ((_ the-database body ...)
     (parameterize ((database the-database)) body ...))))

(define (->json-string vector)
  (with-output-to-string (λ () (json-write vector))))

(define (insert resource document)
  (mongo-req
   path: resource action: "_insert" method: 'POST
   parameters:
   `((docs . ,(->json-string document)))))

(define (update resource document criteria)
  (mongo-req
   path: resource action: "_update" method: 'POST
   parameters:
   `((newobj . ,(->json-string document)) (criteria . ,(->json-string criteria)))))

(define (remove resource criteria)
  (mongo-req
   path: resource action: "_remove" method: 'POST
   parameters:
   `((criteria . ,(->json-string criteria)))))

(define (find resource #!key criteria fields sort skip limit explain batch-size)
  (mongo-req
   action: (string-append "_find?criteria="
                          (uri-encode-string (->json-string '#((name . "food")))))
   method: 'GET path: resource))

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
Which module provides `process-wait'?
Visually impaired? Let me spell it for you (wav file) download WAV