[elpa] externals/dtache 7c07950642 043/158: Implement better encapsulation of database

[ELPA Syncer]

branch: externals/dtache
commit 7c07950642cee8b4bd8c45797627e21f2c772f6d
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>

    Implement better encapsulation of database
    
    The code was too exposed to working with dtache--sessions. This patch
    introduces more functions to limit the exposure of the backend. The
    backend storage also changed from a list to an alist, which id as the
    key. This makes it easier to access a particular session.
---
 dtache-shell.el     |   2 +-
 dtache.el           | 171 +++++++++++++++++++++++++---------------------------
 test/dtache-test.el |  64 ++++++++++----------
 3 files changed, 113 insertions(+), 124 deletions(-)

diff --git a/dtache-shell.el b/dtache-shell.el
index cb0b3db74e..df4bf05f3c 100755
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -92,7 +92,7 @@ This function also makes sure that the HISTFILE is disabled 
for local shells."
   (dtache-update-sessions)
   (let* ((current-host (dtache--host))
          (sessions
-          (thread-last dtache--sessions
+          (thread-last (dtache--db-get-sessions)
             (seq-filter (lambda (it)
                           (string= (dtache--session-host it) current-host)))
             (seq-filter #'dtache--session-active-p))))
diff --git a/dtache.el b/dtache.el
index 384638ef34..f89d5f0bed 100644
--- a/dtache.el
+++ b/dtache.el
@@ -206,7 +206,7 @@
   (dtache-sessions-mode)
   (dtache-update-sessions)
   (let* ((tabulated-list-entries
-          (seq-map #'dtache-get-sesssion-entry dtache--sessions)))
+          (seq-map #'dtache-get-sesssion-entry (dtache--db-get-sessions))))
     (tabulated-list-print t)))
 
 ;;;###autoload
@@ -300,7 +300,7 @@
            (dtache-select-session))))
   (if (dtache--session-active-p session)
       (message "Kill session first before removing it.")
-    (dtache--db-remove-session session)))
+    (dtache--db-remove-entry session)))
 
 ;;;###autoload
 (defun dtache-kill-session (session)
@@ -399,33 +399,27 @@ nil before closing."
 (defun dtache-select-session ()
   "Return selected session."
   (dtache-update-sessions)
-  (let ((sessions dtache--sessions))
-    (dtache-completing-read sessions)))
+  (dtache-completing-read (dtache--db-get-sessions)))
 
 (defun dtache-update-sessions ()
   "Update `dtache' sessions.
 
 Sessions running on  current host or localhost are updated."
-  (let ((current-host (dtache--host))
-        (updated-sessions))
-    (setq updated-sessions
-          (thread-last
-            dtache--sessions
-            (seq-map (lambda (it)
-                       (if (and (or (string= current-host 
(dtache--session-host it))
-                                    (string= "localhost" (dtache--session-host 
it)))
-                                (or (dtache--session-active it)
-                                    (dtache--session-deactivated-p it)))
-                           (dtache-update-session it)
-                         it)))
-            (seq-remove #'null)))
-    (dtache--db-update-sessions updated-sessions)))
+  (let ((current-host (dtache--host)))
+    (seq-do (lambda (it)
+              (if (and (or (string= current-host (dtache--session-host it))
+                           (string= "localhost" (dtache--session-host it)))
+                       (or (dtache--session-active it)
+                           (dtache--session-deactivated-p it)))
+                  (dtache-update-session it)))
+            (dtache--db-get-sessions))))
 
 (defun dtache-session-file (session file)
   "Return the path to SESSION's FILE."
   (let ((file-name
          (concat
-          (dtache--session-id session)
+          (symbol-name
+           (dtache--session-id session))
           (pcase file
             ('socket ".socket")
             ('log ".log"))))
@@ -481,7 +475,7 @@ Sessions running on  current host or localhost are updated."
     (setf (dtache--session-output-size session)
           (file-attribute-size (file-attributes
                                 (dtache-session-file session 'log))))
-    session))
+    (dtache--db-update-entry session)))
 
 (defun dtache-initialize ()
   "Initialize `dtache'."
@@ -491,24 +485,24 @@ Sessions running on  current host or localhost are 
updated."
     (unless (file-exists-p dtache-db-directory)
       (make-directory dtache-db-directory t))
 
-    (setq dtache--sessions
-          (thread-last (dtache--db-select-sessions)
-                       ;; Remove missing local sessions
-                       (seq-remove (lambda (it)
-                                     (and (string= "localhost" 
(dtache--session-host it))
-                                          (dtache--session-missing-p it))))
-                       ;; Update local active sessions
-                       (seq-map (lambda (it)
-                                  (if (and (string= "localhost" 
(dtache--session-host it))
-                                           (dtache--session-active it))
-                                      (dtache-update-session it)
-                                    it)))
-                       (seq-remove #'null)))
+    ;; Update database
+    (dtache--db-initialize)
+    (seq-do (lambda (session)
+              ;; Remove missing local sessions
+              (if (and (string= "localhost" (dtache--session-host session))
+                       (dtache--session-missing-p session))
+                  (dtache--db-remove-entry session)
+
+                  ;; Update local active sessions
+                  (when (and (string= "localhost" (dtache--session-host 
session))
+                             (dtache--session-active session))
+                    (dtache-update-session session))))
+            (dtache--db-get-sessions))
 
     ;; Setup notifications
-    (thread-last dtache--sessions
-      (seq-filter #'dtache--session-active)
-      (seq-do #'dtache-setup-notification))))
+    (thread-last (dtache--db-get-sessions)
+                 (seq-filter #'dtache--session-active)
+                 (seq-do #'dtache-setup-notification))))
 
 (defun dtache-update-remote-sessions ()
   "Update active remote sessions."
@@ -517,26 +511,25 @@ Sessions running on  current host or localhost are 
updated."
                      (dtache--session-active s)))))
 
     ;; Update sessions
-    (thread-last dtache--sessions
-      (seq-map (lambda (it)
+    (thread-last (dtache--db-get-sessions)
+      (seq-do (lambda (it)
                  (if (funcall predicate it)
                      (dtache-update-session it)
-                   it)))
-      (dtache--db-update-sessions))
+                   it))))
 
     ;; Cancel timer if no active remote sessions
-    (unless (> (seq-count predicate dtache--sessions) 0)
+    (unless (> (seq-count predicate (dtache--db-get-sessions)) 0)
       (cancel-timer dtache--remote-session-timer)
       (setq dtache--remote-session-timer nil))))
 
 (defun dtache-cleanup-host-sessions (host)
   "Run cleanuup on HOST sessions."
-  (dtache--db-update-sessions
-   (seq-remove
-    (lambda (it)
-      (and (string= host (dtache--session-host it))
-           (dtache--session-missing-p it)))
-    dtache--sessions)))
+  (seq-do
+   (lambda (it)
+     (when (and (string= host (dtache--session-host it))
+                (dtache--session-missing-p it))
+       (dtache--db-remove-entry it)))
+   (dtache--db-get-sessions)))
 
 (defun dtache-session-exit-code-status (session)
   "Return status based on exit-code in SESSION."
@@ -614,7 +607,7 @@ Sessions running on  current host or localhost are updated."
   "Return a dtach command for SESSION."
   (with-connection-local-variables
    (let* ((directory (dtache--session-session-directory session))
-          (file-name (dtache--session-id session))
+          (file-name (symbol-name (dtache--session-id session)))
           (socket (concat directory file-name ".socket"))
           ;; Construct the command line
           (command (dtache--magic-command session))
@@ -666,7 +659,7 @@ Sessions running on  current host or localhost are updated."
   "Create a `dtache' session from COMMAND."
   (dtache-create-session-directory)
   (let ((session
-         (dtache--session-create :id (dtache--create-id command)
+         (dtache--session-create :id (intern (dtache--create-id command))
                                  :command command
                                  :type dtache-session-type
                                  :open-function dtache-open-session-function
@@ -681,10 +674,8 @@ Sessions running on  current host or localhost are 
updated."
                                  :host (dtache--host)
                                  :metadata (dtache-metadata)
                                  :active t)))
-    ;; Update list of sessions
-    (push session dtache--sessions)
     ;; Update database
-    (dtache--db-update-sessions dtache--sessions)
+    (dtache--db-insert-entry session)
     session))
 
 (defun dtache--session-pid (session)
@@ -692,7 +683,7 @@ Sessions running on  current host or localhost are updated."
   (let* ((socket
           (concat
            (dtache--session-session-directory session)
-           (dtache--session-id session)
+           (symbol-name (dtache--session-id session))
            ".socket"))
          (regexp (rx-to-string `(and "dtach " (or "-n " "-c ") ,socket)))
          (ps-args '("aux" "-w")))
@@ -724,11 +715,6 @@ Sessions running on  current host or localhost are 
updated."
        "..."
        (substring command (- (length command) (/ dtache-max-command-length 2)) 
(length command))))))
 
-(defun dtache--session-short-id (session)
-  "Return the short representation of the SESSION's id."
-  (let ((id (dtache--session-id session)))
-    (substring  id (- (length id) 8) (length id))))
-
 (defun dtache--session-active-p (session)
   "Return t if SESSION is active."
   (file-exists-p
@@ -760,7 +746,7 @@ Sessions running on  current host or localhost are updated."
      ,(format "Working directory: %s" (dtache--working-dir-str session))
      ,(format "Status: %s" (dtache--session-status session))
      ,(format "Created at: %s" (dtache--creation-str session))
-     ,(format "Id: %s" (dtache--session-id session))
+     ,(format "Id: %s" (symbol-name (dtache--session-id session)))
      ,(format "Metadata: %s" (dtache--metadata-str session))
      ,(format "Duration: %s" (dtache--duration-str session))
      "")
@@ -768,38 +754,43 @@ Sessions running on  current host or localhost are 
updated."
 
 ;;;;; Database
 
-(defun dtache--db-select-sessions ()
+(defun dtache--db-initialize ()
   "Return all sessions stored in database."
   (let ((db (expand-file-name "dtache.db" dtache-db-directory)))
     (when (file-exists-p db)
       (with-temp-buffer
         (insert-file-contents db)
         (cl-assert (eq (point) (point-min)))
-        (read (current-buffer))))))
-
-(defun dtache--db-remove-session (session)
-  "Remove SESSION from database."
-  (let ((id (dtache--session-id session)))
-    (setq dtache--sessions
-          (seq-remove (lambda (it)
-                        (string= id (dtache--session-id it)))
-                      dtache--sessions))
-    (dtache--db-update-sessions dtache--sessions)))
-
-(defun dtache--db-update-session (session)
-  "Update SESSION in database."
-  (let ((id (dtache--session-id session)))
-    (setq dtache--sessions
-          (seq-map (lambda (it)
-                     (if (string= (dtache--session-id it) id)
-                         session
-                       it))
-                   dtache--sessions))
-    (dtache--db-update-sessions dtache--sessions)))
-
-(defun dtache--db-update-sessions (sessions)
-  "Write SESSIONS to database."
-  (setq dtache--sessions sessions)
+        (setq dtache--sessions
+              (read (current-buffer)))))))
+
+(defun dtache--db-insert-entry (session)
+  "Insert SESSION into `dtache--sessions' and update database."
+  (push `(,(dtache--session-id session) . ,session) dtache--sessions)
+  (dtache--db-update-sessions))
+
+(defun dtache--db-remove-entry (session)
+  "Remove SESSION from `dtache--sessions' and update database."
+  (setq dtache--sessions
+        (assq-delete-all (dtache--session-id session) dtache--sessions ))
+  (dtache--db-update-sessions))
+
+(defun dtache--db-update-entry (session &optional update)
+  "Update SESSION in `dtache--sessions' optionally UPDATE database."
+  (setf (alist-get (dtache--session-id session) dtache--sessions) session)
+  (when update
+    (dtache--db-update-sessions)))
+
+(defun dtache--db-get-session (id)
+  "Return session with ID."
+  (alist-get id dtache--sessions))
+
+(defun dtache--db-get-sessions ()
+  "Return all sessions stored in the database."
+  (seq-map #'cdr dtache--sessions))
+
+(defun dtache--db-update-sessions ()
+  "Write `dtache--sessions' to database."
   (let ((db (expand-file-name "dtache.db" dtache-db-directory)))
     (with-temp-file db
       (prin1 dtache--sessions (current-buffer)))))
@@ -828,7 +819,7 @@ Sessions running on  current host or localhost are updated."
   "Make a final update to SESSION."
   (if (dtache--session-missing-p session)
       ;; Remove missing session
-      nil
+      (dtache--db-remove-entry session)
 
     ;; Update session
     (setf (dtache--session-output-size session)
@@ -840,9 +831,6 @@ Sessions running on  current host or localhost are updated."
     (setf (dtache--session-duration session)
           (- (time-to-seconds) (dtache--session-creation-time session)))
 
-    ;; Update session in database
-    (dtache--db-update-session session)
-
     ;; Update status
     (if-let ((status (dtache--session-status-function session)))
         (setf (dtache--session-status session) (funcall status session))
@@ -851,6 +839,9 @@ Sessions running on  current host or localhost are updated."
     ;; Send notification
     (dtache-session-finish-notification session)
 
+    ;; Update session in database
+    (dtache--db-update-entry session t)
+
     ;; Execute callback
     (when-let ((callback (dtache--session-callback-function session)))
       (funcall callback session))))
@@ -876,7 +867,7 @@ Otherwise use tee to log stdout and stderr individually."
                  ,(shell-quote-argument (dtache--session-command session))) " 
")
             `(,dtache-shell-program "-c" ,(shell-quote-argument 
(dtache--session-command session)))))
          (directory (dtache--session-session-directory session))
-         (file-name (dtache--session-id session))
+         (file-name (symbol-name (dtache--session-id session)))
          (log (concat directory file-name ".log")))
     (if (dtache--session-redirect-only session)
         (format "{ %s; } &> %s" command log)
diff --git a/test/dtache-test.el b/test/dtache-test.el
index 7d00db6aff..4b4d4f586d 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -76,8 +76,8 @@
              (dtache--dtach-mode 'create)
              (actual
               (dtache-dtach-command
-               (dtache--session-create :id "12345" :session-directory 
"/tmp/dtache/")))
-             (expected `(, "-c" "/tmp/dtache/12345.socket" "-z" "zsh" "-c" 
"command")))
+               (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/")))
+             (expected `(, "-c" "/tmp/dtache/s12345.socket" "-z" "zsh" "-c" 
"command")))
     (should (equal expected actual))))
 
 (ert-deftest dtache-test-metadata ()
@@ -97,20 +97,16 @@
   ;; Local files
   (cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory) 
(concat directory file)))
              ((symbol-function #'file-remote-p) (lambda (_directory) nil))
-             (session (dtache--session-create :id "12345" :session-directory 
"/home/user/tmp/")))
-    (should (string= "/home/user/tmp/12345.log" (dtache-session-file session 
'log)))
-    (should (string= "/home/user/tmp/12345.socket" (dtache-session-file 
session 'socket))))
+             (session (dtache--session-create :id 's12345 :session-directory 
"/home/user/tmp/")))
+    (should (string= "/home/user/tmp/s12345.log" (dtache-session-file session 
'log)))
+    (should (string= "/home/user/tmp/s12345.socket" (dtache-session-file 
session 'socket))))
 
   ;; Remote files
   (cl-letf* (((symbol-function #'expand-file-name) (lambda (file directory) 
(concat directory file)))
              ((symbol-function #'file-remote-p) (lambda (_directory) 
"/ssh:foo:"))
-             (session (dtache--session-create :id "12345" :session-directory 
"/home/user/tmp/")))
-    (should (string= "/ssh:foo:/home/user/tmp/12345.log" (dtache-session-file 
session 'log)))
-    (should (string= "/ssh:foo:/home/user/tmp/12345.socket" 
(dtache-session-file session 'socket)))))
-
-(ert-deftest dtache-test-session-short-id ()
-  (let ((session (dtache--session-create :id "abcdefg12345678")))
-    (should (string= "12345678" (dtache--session-short-id session)))))
+             (session (dtache--session-create :id 's12345 :session-directory 
"/home/user/tmp/")))
+    (should (string= "/ssh:foo:/home/user/tmp/s12345.log" (dtache-session-file 
session 'log)))
+    (should (string= "/ssh:foo:/home/user/tmp/s12345.socket" 
(dtache-session-file session 'socket)))))
 
 (ert-deftest dtache-test-session-truncate-command ()
   (let ((dtache-max-command-length 7))
@@ -159,7 +155,7 @@
      (dtache-test--change-session-state session2 'kill)
      (dtache-cleanup-host-sessions host)
      (should (seq-set-equal-p
-              (dtache--db-select-sessions)
+              (dtache--db-get-sessions)
               `(,session1 ,session3))))))
 
 ;;;;; Database
@@ -167,25 +163,27 @@
 (ert-deftest dtache-test-db-insert-session ()
   (dtache-test--with-temp-database
    (let* ((session (dtache-test--create-session :command "foo" :host 
"localhost")))
-     (should (equal (dtache--db-select-sessions) `(,session))))))
+     (should (equal (dtache--db-get-sessions) `(,session))))))
 
 (ert-deftest dtache-test-db-remove-session ()
   (dtache-test--with-temp-database
    (let* ((host "localhost")
           (session1 (dtache-test--create-session :command "foo" :host host))
           (session2 (dtache-test--create-session :command "bar" :host host)))
-     (should (seq-set-equal-p `(,session1 ,session2) 
(dtache--db-select-sessions)))
-     (dtache--db-remove-session session1)
-     (should (seq-set-equal-p `(,session2) (dtache--db-select-sessions))))))
+     (should (seq-set-equal-p `(,session1 ,session2) 
(dtache--db-get-sessions)))
+     (dtache--db-remove-entry session1)
+     (should (seq-set-equal-p `(,session2) (dtache--db-get-sessions))))))
 
 (ert-deftest dtache-test-db-update-session ()
   (dtache-test--with-temp-database
    (let* ((session (dtache-test--create-session :command "foo" :host 
"localhost"))
-          (id (dtache--session-id session)))
-     (setf (dtache--session-active session) nil)
-     (should (not (equal session (car (dtache--db-select-sessions)))))
-     (dtache--db-update-session session)
-     (should (equal session (car (dtache--db-select-sessions)))))))
+          (id (dtache--session-id session))
+          (copy))
+     (setq copy (copy-dtache-session session))
+     (setf (dtache--session-active copy) nil)
+     (should (not (equal copy (dtache--db-get-session id))))
+     (dtache--db-update-entry copy t)
+     (should (equal copy (car (dtache--db-get-sessions)))))))
 
 (ert-deftest dtache-test-magic-command ()
   ;; Redirect only without dtache-env
@@ -193,8 +191,8 @@
          (dtache-shell-program "bash")
          (actual
           (dtache--magic-command
-           (dtache--session-create :id "12345" :session-directory 
"/tmp/dtache/" :command "ls" :redirect-only t)))
-         (expected "{ (bash -c ls); } &> /tmp/dtache/12345.log"))
+           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls" :redirect-only t)))
+         (expected "{ (bash -c ls); } &> /tmp/dtache/s12345.log"))
     (should (string= actual expected)))
 
   ;; Normal without dtache-env
@@ -202,8 +200,8 @@
          (dtache-shell-program "bash")
          (actual
           (dtache--magic-command
-           (dtache--session-create :id "12345" :session-directory 
"/tmp/dtache/" :command "ls")))
-         (expected "{ (bash -c ls); } 2>&1 | tee /tmp/dtache/12345.log"))
+           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls")))
+         (expected "{ (bash -c ls); } 2>&1 | tee /tmp/dtache/s12345.log"))
     (should (string= actual expected)))
 
   ;; Redirect only with dtache-env
@@ -211,8 +209,8 @@
          (dtache-shell-program "bash")
          (actual
           (dtache--magic-command
-           (dtache--session-create :id "12345" :session-directory 
"/tmp/dtache/" :command "ls" :redirect-only t)))
-         (expected "{ dtache-env ls; } &> /tmp/dtache/12345.log"))
+           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls" :redirect-only t)))
+         (expected "{ dtache-env ls; } &> /tmp/dtache/s12345.log"))
     (should (string= actual expected)))
 
   ;; Normal with dtache-env
@@ -220,8 +218,8 @@
          (dtache-shell-program "bash")
          (actual
           (dtache--magic-command
-           (dtache--session-create :id "12345" :session-directory 
"/tmp/dtache/" :command "ls")))
-         (expected "{ dtache-env ls; } 2>&1 | tee /tmp/dtache/12345.log"))
+           (dtache--session-create :id 's12345 :session-directory 
"/tmp/dtache/" :command "ls")))
+         (expected "{ dtache-env ls; } 2>&1 | tee /tmp/dtache/s12345.log"))
     (should (string= actual expected))))
 
 (ert-deftest dtache-test-redirect-only-p ()
@@ -233,9 +231,9 @@
   (cl-letf* (((symbol-function #'process-file) (lambda (_program _infile 
_buffer _display &rest _args)
                                                  (insert "\"USER       PID 
%CPU %MEM    VSZ   RSS TTY      STAT START   TIME COMMAND\nuser    6699  0.0  
0.0   4752  2304 ?        Ss   13:06   0:00 dtach -n /tmp/foo.socket\nuser    
6698  0.0  0.0   4752  2304 ?        Ss   13:07   0:00 dtach -c 
/tmp/bar.socket\n")))
 
-             (session1 (dtache--session-create :id "foo" :session-directory 
"/tmp/"))
-             (session2 (dtache--session-create :id "bar" :session-directory 
"/tmp/"))
-             (session3 (dtache--session-create :id "baz" :session-directory 
"/tmp/")))
+             (session1 (dtache--session-create :id 'foo :session-directory 
"/tmp/"))
+             (session2 (dtache--session-create :id 'bar :session-directory 
"/tmp/"))
+             (session3 (dtache--session-create :id 'baz :session-directory 
"/tmp/")))
     (should (string= "6699" (dtache--session-pid session1)))
     (should (string= "6698" (dtache--session-pid session2)))
     (should (not (dtache--session-pid session3)))))