#lang scheme/base

(require (file "util.scm")
         (file "record.scm")
         (file "session.scm"))

(provide store-rec!
         delete-rec!
         add-child-and-save!
         remove-child-and-save!
         load-children
         contains-child?
         load-rec
         rec-rec-prop
         load-where
         load-one-where
         fresh-rec-from-data
         )

(define (store-rec! r)
  (write-record! r)
  r)

(define (delete-rec! r)
  (delete-file (abs-path-to-record (rec-id r))))

;; pass #:ensure if you want to make sure that the record you are loading has particular
;; properties.  A common use case is a security check so user can't url hack to load
;; arbitrary records: (load-rec some-id #:ensure '((type . blog-post))
(define (load-rec id #:ensure (ensure '()))
  (let ((result (rec-filter-where (list (make-rec (read-record-data id) id)) ensure)))
    (if (empty? result)
        #f
        (first result))))

;; adds the given child to the parent and saves the parent (not the child).
;; if #:to-end is non-#f, then add the child to the end of the child list.
(define (add-child-and-save! parent prop child #:to-end (to-end #f))
  (rec-add-child! parent prop child #:to-end to-end)
  (store-rec! parent))

(define (remove-child-and-save! parent prop child)
  (rec-remove-child! parent prop child)
  (store-rec! parent))

(define (load-children parent prop)
  (map load-rec (rec-child-prop parent prop)))

;; returns #f if nothing exists for the property.
(define (rec-rec-prop rec prop)
  (aand (rec-prop rec prop) (load-rec it)))

(define (contains-child? parent prop putative-child)
  (any (cute string=? <> (rec-id putative-child)) (rec-child-prop parent prop)))

;; if id is already provided then don't overwrite
(define (fresh-rec-from-data data #:stamp-time (stamp-time #f))
  (let* ((id (or (assoc-val 'id data) (random-key-string 5)))
         ;; XXX  make it verify that it's not already taken.
         (rec (make-rec data id)))
    (when stamp-time (rec-set-prop! rec 'created_at (current-seconds)))
    rec))

(define ignore-filename?
  (let ((to-ignore '(".svn")))
    (lambda (filename-path)
      (and (member filename-path to-ignore) #t))))


(define (load-all-recs)
  (filter-map (lambda (filename-path)
                (let ((filename (path->string filename-path)))
                  (and (not (ignore-filename? filename))
                       (load-rec filename))))
              (directory-list PATH_TO_PERSISTENT_STORAGE)))

;; uses AND logic
;; restricted-to should be a list of record ids if given.
(define (load-where pairs
                    #:restricted-to (restricted-to #f)
                    #:sort-by (sort-by #f)
                    #:compare (compare <))
  (let ((result
         (rec-filter-where (if restricted-to (map load-rec restricted-to) (load-all-recs))
                           pairs)))
    (if sort-by
        (sort result (lambda (a b) (compare (rec-prop a sort-by)
                                            (rec-prop b sort-by))))
        result)))

;; restricted-to should be a list of record ids if given.
(define (load-one-where pairs #:restricted-to (restricted-to #f))
  (let ((results (load-where pairs)))
    (if (empty? results)
        #f
        (first results))))

(define PATH_TO_PERSISTENT_STORAGE (build-path (current-directory) "data"))

;; persists the given record on disk, overwriting any previous record of the same id
;; that may have been there.
(define (write-record! r)
  (let ((id (rec-id r)))
    (call-with-output-file (abs-path-to-record id)
      (lambda (port)
        (write (rec-data r) port))
      #:exists 'replace)))

(define (read-record-data id)
  (call-with-input-file (abs-path-to-record id)
    (lambda (port)
      (read port))))

(define (abs-path-to-record id)
  (unless (directory-exists? PATH_TO_PERSISTENT_STORAGE)
    (e "Can't find data directory '~A'. Current directory is ~A."
       PATH_TO_PERSISTENT_STORAGE (current-directory)))
  (build-path PATH_TO_PERSISTENT_STORAGE id))