; Copyright (C) 2006, Ephemeral Security, LLC
; 
; This library is free software; you can redistribute it and/or modify it 
; under the terms of the GNU Lesser General Public License, version 2.1
; as published by the Free Software Foundation.
; 
; This library is distributed in the hope that it will be useful, but WITHOUT 
; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
; FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License 
; for more details.
; 
; You should have received a copy of the GNU Lesser General Public License 
; along with this library; if not, write to the Free Software Foundation, 
; Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

;;; USER API:
;;; (find-clue db parameter ...) -> list of records
;;; (put-clue db parameter ...) -> record
;;; (drop-clue record-list) 
;;; (set-clue record parameter ...) -> record
;;; (get-clue record key1 key2 keyN ...) -- list of values for the record
;;; (get-clue record key) -- value for the record key, or false
;;; (get-clue record) -- list of values for the record
;;; (get-clue record-list key1 key2 keyN ...) -- list of list of values for each record for each key
;;; (get-clue record-list key)  -> list of values for each record
;;; (get-clue record-list) -> list of parameter lists for each record
;;; parameter -- either a pair of key and value, or a key
;;; record -- a record object, as generated by find-clue, put-clue

(module "lib/clue")
(import "lib/object")

(define-class clue-db <object> (make-clue-db records indexes index-by-key)
              clue-db?
              (records clue-db-records)
              (indexes clue-db-indexes)
              (index-by-key clue-db-index-by-key))

(define-class clue-index <object> (make-clue-index records records-by-value)
              clue-index?
              (records clue-index-records)
              (records-by-value clue-index-records-by-value))

(define-class clue-record <object> (make-clue-record db parameters)
              clue-record?
              (db clue-record-db)
              (parameters clue-record-parameters set-clue-record-parameters!))

(define (new-clue-db)
  (make-clue-db (set) (set) (dict)))

(export new-clue-db)

(define (new-index db key)
  (define index (make-clue-index (set) (dict)))
  (set-add! (clue-db-indexes db) index)
  (dict-set! (clue-db-index-by-key db) key index)
  index)

(define (find-index db key)
  (dict-ref (clue-db-index-by-key db) key))

(define make-parameter cons)
(define parameter-key car)
(define parameter-value cdr)

(define (put-record-in-index index record value)
  (define row (dict-ref (clue-index-records-by-value index) value))
  (unless row
    (set! row (make-tc))
    (dict-set! (clue-index-records-by-value index) value row))
  (tc-append! row record)
  (set-add! (clue-index-records index) record))

(define (drop-record-from-index index record value)
  (define row (dict-ref (clue-index-records-by-value index) value))
  (when row (tc-remove! row record))
  (set-remove! (clue-index-records index) record))

(define (move-record-in-index index record old-value new-value)
  (define old-row (dict-ref (clue-index-records-by-value index) old-value))
  (define new-row (dict-ref (clue-index-records-by-value index) new-value))
  (unless (eq? old-row new-row)
    (when old-row (tc-remove! old-row record))
    (unless new-row 
      (set! new-row (make-tc))
      (dict-set! (clue-index-records-by-value index) new-value new-row))
    (tc-append! new-row record)))

(define (new-clue-record db parameters)
  (define record (make-clue-record db parameters))
  (for-each (lambda (parameter)
               (define key (parameter-key parameter))
               (define value (parameter-value parameter))
               (put-record-in-index (or (find-index db key)
                                        (new-index db key))
                                    record
                                    value))
            parameters)
  (set-add! (clue-db-records db) record)
  record)

(define (member* item sets)
  (if (null? sets) 
    #t
    (let ((set (car sets)))
      (and (cond ((set? set)  (set-member? set item))
                 ((tc? set)   (memq item (tc->list set)))
                 ((pair? set) (memq item set))
                 (else #f))
           (member* item (cdr sets))))))

(define (clue-union set0 . sets)
  (or (filter (lambda (item)
                  (member* item sets))
              (cond 
                ((set? set0) (set->list set0))
                ((tc? set0) (tc->list set0))
                ((list? set0) set0)
                (else '())))
      '()))

(define-macro (put-clue db . parameters)
   `(new-clue-record ,db 
                     ,(cons 'list 
                            (map (lambda (parameter)
                                   (if (pair? parameter) 
                                     (list 'cons 
                                           (list 'quote (car parameter))
                                           (cadr parameter))
                                     (list 'cons 
                                           (list 'quote parameter)
                                           #t)))
                                 parameters))))

(export put-clue new-clue-record)

(define (find-clue-records db . parameters)
  (if (null? parameters)
    (set->list (clue-db-records db))
    (apply clue-union (map (lambda (parameter)
                             (if (not (pair? parameter))
                               (clue-records-with-key db parameter)
                               (clue-records-with-parameter db (car parameter)
                                                            (cadr parameter))))
                           parameters))))
                            

(define-macro (find-clue db . parameters)
   `(find-clue-records ,db ,@(map (lambda (parameter)
                                   (if (not (pair? parameter))
                                     `(quote ,parameter)
                                     `(list (quote ,(car parameter))
                                            ,(cadr parameter))))
                                 parameters)))

; (find-clue db (last-name "Doe")) -> ( [record (first-name "Bob") (last-name "Doe")] [record (first-name "Abel") (last-name "Doe")] )

(define (clue-records-with-key db key)
  (define index (find-index db key))
  (if index
    (clue-index-records index)
    '()))

(define (clue-records-with-parameter db key value)
  (define index (find-index db key))
  (if index 
    (or (dict-ref (clue-index-records-by-value index) 
                  value)
        '())))

(export find-clue clue-union clue-records-with-parameter clue-records-with-key
        clue-db-records find-clue-records)

(define (get-clue-record-value record key)
  (cond 
    ((list? record) (map (lambda (record)
                           (get-clue-record-value record key))
                         record))
    ((list? key) (map (lambda (key)
                        (get-clue-record-value record key))
                      key))
    (else
      (let ((parameter (assq key (clue-record-parameters record))))
        (if parameter (cdr parameter) #f)))))

(define (get-clue-record-parameters record)
  (if (list? record)
    (map get-clue-record-parameters record)
    (clue-record-parameters record)))

(define-macro (get-clue records . keys)
  (cond 
    ((null? keys) 
     `(get-clue-record-parameters ,records))
    ((null? (cdr keys))
     `(get-clue-record-value ,records (quote ,(car keys))))
    (else
      `(get-clue-record-value ,records ,(cons 'list 
                                              (map (lambda (key)
                                                     (list 'quote key))
                                                   keys))))))

(export get-clue-record-value get-clue get-clue-record-parameters)

(define (set-clue-record-parameter record key value)
  (define db (clue-record-db record))
  (define parameters (clue-record-parameters record))
  (define parameter (assq key parameters))
  (define index (or (find-index db key) (new-index db key)))
  (cond (parameter (move-record-in-index index record (cdr parameter) value)
                   (set-cdr! parameter value))
        (else (put-record-in-index index record value)
              (set-clue-record-parameters! 
                record (cons (cons key value) parameters))))
  record)

(define (set-clue-record-parameters record parameters)
  (cond
    ((list? record) 
     (map (lambda (record)
            (set-clue-record-parameters record parameters))
          record))
    (else (for-each 
            (lambda (parameter)
              (set-clue-record-parameter record (car parameter) 
                                         (cdr parameter)))
            parameters)
          record)))

(define-macro (set-clue records . parameters)
   `(set-clue-record-parameters 
      ,records 
      ,(cons 'list (map (lambda (parameter)
                          (list 'cons (list 'quote (car parameter))
                                      (cadr parameter)))
                          parameters))))

(export set-clue set-clue-record-parameter set-clue-record-parameters)

;(set-clue (find-clue db customer (billing-day 15))
;          (last-bill-date today))

(define (drop-clue records)
  (cond ((list? records) 
         (for-each drop-clue records))
        (else
          (define record records)
          (define parameters (clue-record-parameters record))
          (define db (clue-record-db record))
          (set-remove! (clue-db-records db) record)
          (for-each (lambda (parameter)
                      (define key (parameter-key parameter))
                      (define value (parameter-value parameter))
                      (define index (find-index db key))
                      (drop-record-from-index index record value))
                    parameters)))
  records)

(export drop-clue)

(define (clue-parameter->list parameter)
  (list (parameter-key parameter)
        (parameter-value parameter)))

(define (clue-record->list record)
  (map clue-parameter->list
       (clue-record-parameters record)))

(define (clue-db->list db)
  (map clue-record->list
       (set->list (clue-db-records db))))

(define (list->clue-record db data)
  (new-clue-record db (map (lambda (p)
                             (cons (car p) (cadr p)))
                           data)))

(define (list->clue-db data)
  (define db (new-clue-db))
  (for-each (lambda (data)
              (list->clue-record db data))
            data)
  db)

(export clue-db->list list->clue-db clue-record->list list->clue-record)
