#lang racket

#|
lattice is an imagining of what this data store might look like, how
users might interface with it. This prototype is based on hash-tables,
with reader serialisation to and from disk for persistence --- a very
crude beginning, but it's meant as the set on a stage: it's no way to
build a house, but we can talk about living.

The code aims to avoid exposing users to its implementation, and
instead provides utilities to focus on the semantics.
|#

(provide write-store!
         load-store!
         store!
         lookup
         select)

(define WORKSPACES (make-hash))

;; Store the global workspaces to file.
(define (write-store! filespec)
  (write-to-file WORKSPACES
                 filespec
                 #:mode 'binary
                 #:exists 'replace))

;; Read the global workspaces from a file, preferably created with
;; load-store!.
(define (load-store! filespec)
  (set! WORKSPACES (file->value filespec)))

;; Create a new workspace and return it; this is less-useful for
;; direct calling but is used internally.
(define (create-workspace name)
  (hash-set! WORKSPACES name (make-hash))
  (hash-ref  WORKSPACES name))

;; workspace-exists returns true if the workspace exists in the data
;; store.
(define (workspace-exists? name)
  (hash-has-key? WORKSPACES name))

;; store writes the record to the named workspace under the given
;; name. record should be an alist; e.g.
;;
;; (store 'users "John Q. Public" '((#:id 42)
;;                                  (#:plan #:basic)
;;                                  (#:email "jqp@example.net")
;;                                  (#:documents ("7C19B" "23FA6" "48ABD"))))
(define (store! workspace name record)
  (eprintf "Will attempt to store [~a] under ~a in ~a\n" record name workspace)
  (let ([workspace-ht (if (workspace-exists? workspace)
                          (hash-ref WORKSPACES workspace)
                          (create-workspace workspace))])
    (let ([record-ht (make-hash)])
      (for ([rec record])
        (hash-set! record-ht (car rec) (cadr rec)))
      (hash-set! workspace-ht name record-ht)
      'ok)))

;; record-exists? returns true if a record named by name is present
;; in the named workspace.
(define (record-exists? workspace name)
  (if (workspace-exists? workspace)
      (hash-has-key? (hash-ref WORKSPACES workspace) name)
      #f))

;; Retrieve the record from the named workspace; if no such record
;; exists, return an empty list.
(define (lookup workspace name)
  (if (and (workspace-exists? workspace) (record-exists? workspace name))
      (hash->list
       (hash-ref
        (hash-ref WORKSPACES workspace)
        name))
      '()))

;; Return all records in the workspace for which the application of
;; the predicate on the search-key for each record returns true.
;;
;; For example, given the user workspace and "John Q. Public" entry
;; from the comment on store:
;;
;; > (select 'users '#:id (λ (id) (equal? id 42)))
;; '(("John Q. Public"
;;    (#:plan . #:basic)
;;    (#:id . 42)
;;    (#:documents "7C19B" "23FA6" "48ABD")
;;    (#:email . "jqp@example.net")))
;;
;; If we add some more users:
;; > (store 'users "Alyssa P. Hacker" '((#:id 314)
;;                                      (#:plan #:basic)
;;                                      (#:email "aph@example.net")
;;                                      (#:documents ("87FAC" "19D1A" "86BC2"))))
;; > (store 'users "Ben Bitdiddle" '((#:id 17)
;;                                      (#:plan #:pro)
;;                                      (#:email "bb@example.net")
;;                                      (#:documents ())))
;; > (select 'users '#:plan (λ (plan) (equal? plan '#:basic)))
;; '(("Alyssa P. Hacker"
;;    (#:plan . #:basic)
;;    (#:id . 314)
;;    (#:documents "87FAC" "19D1A" "86BC2")
;;    (#:email . "aph@example.net"))
;;   ("John Q. Public"
;;    (#:plan . #:basic)
;;    (#:id . 42)
;;    (#:documents "7C19B" "23FA6" "48ABD")
;;    (#:email . "jqp@example.net")))
(define (select workspace search-key pred)
  (when (workspace-exists? workspace)
    (let ([lookup-key (lambda (key) (lookup workspace key))]
          [workspace (hash-ref WORKSPACES workspace)])
      (filter-not empty?
       (hash-map workspace
                 (lambda (key value)
                   (if (pred (hash-ref value search-key))
                     (cons key (hash->list value))
                     '())))))))