(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))