#lang scheme

(require (planet jaymccarthy/mongodb:1:4)
         (rename-in (planet jaymccarthy/mongodb:1:4)
                    (mongo? mongo-connection?)))

(provide (all-from-out (planet jaymccarthy/mongodb:1:4))
         mongo-connection?)

(provide/contract
 [current-mongo-connection (parameter/c (or/c mongo-connection? false?))]
 [current-mongo-collection (parameter/c (or/c mongo-collection? false?))]
 [mongo-use-database ((or/c mongo-db? string? false?) . -> . (or/c mongo-db? false?))]
 [mongo-use-db ((or/c mongo-db? string? false?) . -> . (or/c mongo-db? false?))]
 [mongo-use-collection ((or/c mongo-collection? string? false?) . -> . (or/c mongo-collection? false?))]
 [mongo-use (() (#:collection (or/c mongo-collection? string? false? void?) #:database (or/c mongo-db? string? false? void?)) . ->* . 
                (or/c false? mongo-collection? mongo-db?))]
 
 [connect-to-mongo (() (#:dbname (or/c string? false?) #:host string? #:port number? #:collection (or/c string? false?)) . ->* .
                       (or/c mongo-connection? mongo-collection? mongo-db?))]
 [mongo-connect (() (#:dbname (or/c string? false?) #:host string? #:port number? #:collection (or/c string? false?)) . ->* .
                    (or/c mongo-connection? mongo-collection? mongo-db?))]
 
 [mongo-save (((or/c list? hash?)) (#:collection (or/c mongo-collection? string?)) . ->* . void?)]
 [mongo-save** (((or/c list? hash?)) (#:collection (or/c mongo-collection? string?)) . ->* . bson-objectid?)]
 
 [mongo-find-cursor (() ((or/c list? hash?) #:collection (or/c mongo-collection? string?)) . ->* . mongo-cursor?)]
 [mongo-find (() ((or/c list? hash?) #:collection (or/c mongo-collection? string?)) . ->* . list?)]
 [mongo-findOne (() ((or/c list? hash?) #:collection (or/c mongo-collection? string?)) . ->* . (or/c hash? false?))]
 
 [mongo-update (((or/c list? hash?) (or/c list? hash?)) (boolean? boolean? #:collection mongo-collection?) . ->* . void?)]
 
 [mongo-getCollectionNames (() (#:database (or/c mongo-db? string?)) . ->* . list?)]
 [mongo-collections (() (#:database (or/c mongo-db? string?)) . ->* . list?)]
 [mongo-dbs (() (#:connection mongo-connection?) . ->* . list?)]
 
 [mongo-object-id ((or/c hash? list?) . -> . (or/c bson-objectid? false?))]
 [mongo-find-by-id (bson-objectid? . -> . (or/c hash? false?))]
 )

(define current-mongo-connection (make-parameter #f))
;current-mongo-db from mongodb
(define current-mongo-collection (make-parameter #f))

(define (make-mongo-db-with-current-connection name)
  (cond ((false? (current-mongo-connection)) (error "not connected to database server"))
        (#t (make-mongo-db (current-mongo-connection) name))))

(define (make-mongo-collection-with-current-db name)
  (cond ((false? (current-mongo-db)) (error "database is not selected"))
        (#t (make-mongo-collection (current-mongo-db) name))))

(define (mongo-use-database database)
  (let ((new-database
         (cond 
           ((false? database) #f)
           ((mongo-db? database) database)
           (#t (make-mongo-db-with-current-connection database)))))
    (current-mongo-db new-database)
    (when (not (false? (current-mongo-collection)))
      (current-mongo-collection #f))
    new-database))

(define (mongo-use-db database)
  (mongo-use-database database))

(define (mongo-use-collection collection)
  (let ((new-collection
         (cond 
           ((false? collection) #f)
           ((mongo-collection? collection) collection)
           (#t (make-mongo-collection-with-current-db collection)))))
    (current-mongo-collection new-collection)
    new-collection))

(define (mongo-use 
         #:collection [collection (void)] 
         #:database [database (void)])
  (cond
    ((not (void? database))
     (mongo-use-database database)
     (cond 
       ((not (void? collection))
        (mongo-use #:collection collection))
       (#t (current-mongo-db))))
    ((not (void? collection))
     (mongo-use-collection collection))
    (else #f)))

(define (connect-to-mongo 
         #:dbname [dbname #f] 
         #:host [host "localhost"] 
         #:port [port 27017] 
         #:collection [collection #f])
  (current-mongo-connection (create-mongo #:host host #:port port))
  (mongo-use #:collection collection #:database dbname)
  (findf (lambda (expr) (not (false? expr)))
         (list 
          (current-mongo-collection)
          (current-mongo-db)
          (current-mongo-connection))))

(define (mongo-connect
         #:dbname [dbname #f] 
         #:host [host "localhost"] 
         #:port [port 27017] 
         #:collection [collection #f])
  (connect-to-mongo 
   #:dbname dbname
   #:host host
   #:port port
   #:collection collection))

;;;;;;;;;;;;;;;;;;;;;;;

(define (mongo-find-cursor [query '()] #:collection [collection (current-mongo-collection)])
  (cond
    ((false? collection) (error "can`t mongo-find, mongo collection is not selected"))
    ((string? collection) 
     (mongo-find-cursor query 
                        #:collection (make-mongo-collection-with-current-db collection)))
    (#t (mongo-collection-find collection query))))

(define (mongo-find [query '()] #:collection [collection (current-mongo-collection)])
  (let* ((cursor (mongo-find-cursor query #:collection collection))
         (records (for/list ([item cursor]) item))
         (mongo-cursor-kill! cursor))
    records))

(define (mongo-findOne [query '()] #:collection [collection (current-mongo-collection)])
  (let* ((cursor (mongo-find-cursor query #:collection collection))
         (record (for/first ([item cursor]) item))
         (mongo-cursor-kill! cursor))
    record))

(define (mongo-save query #:collection [collection (current-mongo-collection)])
  (cond 
    ((false? collection) (error "can`t mongo-save, mongo collection is not selected"))
    ((string? collection) 
     (mongo-save query #:collection (make-mongo-collection-with-current-db collection)))
    (#t
      (let ((id (mongo-object-id query)))
        (if (false? id)
            (mongo-collection-insert!
             collection
             query)
            (mongo-collection-repsert! 
             collection
             (list (cons '_id id))
             query))))))

(define (mongo-update criteria objNew [upsert #f] [multi #f] 
                      #:collection [collection (current-mongo-collection)])
  (if upsert
      (if multi
          (if (eq? (mongo-collection-count collection criteria) 0)
              (mongo-update criteria objNew #t)
              (mongo-update criteria objNew #f #t))
          (mongo-collection-repsert! collection criteria objNew))
      (if multi
          (mongo-collection-modify! collection criteria objNew) 
          (mongo-collection-replace! collection criteria objNew))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (mongo-getCollectionNames #:database [database (current-mongo-db)])
  (cond 
    ((string? database)
     (mongo-getCollectionNames #:database (make-mongo-db-with-current-connection 
                                           database)))
    (#t (mongo-db-collections database))))

(define (mongo-collections #:database [database (current-mongo-db)])
  (mongo-getCollectionNames #:database database))

(define (mongo-dbs #:connection [connection (current-mongo-connection)])
  (mongo-db-names connection))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (mongo-object-id object)
  (cond ((hash? object) (hash-ref object '_id #f))
        (#t (let ((id-pair (assoc '_id object)))
              (if (false? id-pair)
                  #f
                  (cdr id-pair))))))

(define (mongo-find-by-id id)
  (mongo-findOne 
   (list 
    (cons '_id id))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (mongo-save** query #:collection [collection (current-mongo-collection)])
  (let ((id (mongo-object-id query)))
    (if (false? id)
        (let* ((unique-key (string->symbol (number->string (current-seconds))))
               (unique-data (number->string (random)))
               (query-with-unique 
                (cond ((hash? query)
                       (let ((query-copy (hash-copy query)))
                         (hash-set! query-copy unique-key unique-data)
                         query-copy))
                      (#t 
                       (append query (list (cons unique-key unique-data)))))))
          (mongo-save query-with-unique #:collection collection)
          (let* ((record-from-db (mongo-findOne query-with-unique))
                 (id (hash-ref record-from-db '_id)))
            (hash-remove! record-from-db unique-key)
            (mongo-update (list (cons '_id id)) record-from-db)
            id))
        (begin
          (mongo-save query #:collection collection)
          id))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(mongo-save '((a . 5) (b . 7) (c . "qweqweqwe")))
;(mongo-save '((a . null))) ; !!! failed
;(mongo-find '())
;(mongo-find '((|a b| . ((|d c| . 1.0)))))
;(mongo-update (list (cons '_id a)) (list (cons '|$push| (list (cons 'c 'a)))))
;(mongo-update (mongo-find-by-id a) (list (cons '|$push| (list (cons 'c (list 1 2 3))))))