1  ;;; docker-utils.el --- Random utilities  -*- lexical-binding: t -*-
  2  
  3  ;; Author: Philippe Vaucher <philippe.vaucher@gmail.com>
  4  
  5  ;; This file is NOT part of GNU Emacs.
  6  
  7  ;; This program is free software; you can redistribute it and/or modify
  8  ;; it under the terms of the GNU General Public License as published by
  9  ;; the Free Software Foundation; either version 3, or (at your option)
 10  ;; any later version.
 11  ;;
 12  ;; This program is distributed in the hope that it will be useful,
 13  ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 14  ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 15  ;; GNU General Public License for more details.
 16  ;;
 17  ;; You should have received a copy of the GNU General Public License
 18  ;; along with GNU Emacs; see the file COPYING.  If not, write to the
 19  ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 20  ;; Boston, MA 02110-1301, USA.
 21  
 22  ;;; Commentary:
 23  
 24  ;;; Code:
 25  (eval-when-compile
 26    (setq-local byte-compile-warnings '(not docstrings)))
 27  
 28  (require 's)
 29  (require 'aio)
 30  (require 'dash)
 31  (require 'json)
 32  (require 'tramp)
 33  (require 'tablist)
 34  (require 'transient)
 35  
 36  (defun docker-utils-get-marked-items-ids ()
 37    "Get the id part of `tablist-get-marked-items'."
 38    (-map #'car (tablist-get-marked-items)))
 39  
 40  (defun docker-utils-ensure-items ()
 41    "Ensure at least one item is selected."
 42    (when (null (docker-utils-get-marked-items-ids))
 43      (user-error "This action cannot be used in an empty list")))
 44  
 45  (defun docker-utils-generate-new-buffer-name (program &rest args)
 46    "Wrapper around `generate-new-buffer-name' using PROGRAM and ARGS."
 47    (generate-new-buffer-name (format "* %s %s *" program (s-join " " args))))
 48  
 49  (defun docker-utils-generate-new-buffer (program &rest args)
 50    "Wrapper around `generate-new-buffer' using PROGRAM and ARGS."
 51    (generate-new-buffer (apply #'docker-utils-generate-new-buffer-name program args)))
 52  
 53  (defmacro docker-utils-with-buffer (name &rest body)
 54    "Wrapper around `with-current-buffer'.
 55  Execute BODY in a buffer named with the help of NAME."
 56    (declare (indent defun))
 57    `(with-current-buffer (docker-utils-generate-new-buffer "docker" ,name)
 58       (setq buffer-read-only nil)
 59       (erase-buffer)
 60       ,@body
 61       (setq buffer-read-only t)
 62       (goto-char (point-min))
 63       (pop-to-buffer (current-buffer))))
 64  
 65  (defmacro docker-utils-transient-define-prefix (name arglist &rest args)
 66    "Wrapper around `transient-define-prefix' forwarding NAME, ARGLIST and ARGS and calling `docker-utils-ensure-items'."
 67    `(transient-define-prefix ,name ,arglist
 68       ,@args
 69       (interactive)
 70       (docker-utils-ensure-items)
 71       (transient-setup ',name)))
 72  
 73  (defmacro docker-utils-define-transient-arguments (name)
 74    "Define the transient arguments function using NAME that return the latest transient value or its default."
 75    `(defun ,(intern (format "%s-arguments" name)) ()
 76       ,(format "Return the latest used arguments in the `%s' transient." name)
 77       (let ((history (alist-get ',name transient-history))
 78             (default (transient-default-value (get ',name 'transient--prefix))))
 79         (if (equal 0 (length history))
 80             (car default)
 81           (car history)))))
 82  
 83  (defmacro docker-utils-refresh-entries (promise)
 84    "Update the current buffer with the results of PROMISE."
 85    `(let ((buffer (current-buffer))
 86           (entries (aio-await ,promise)))
 87       (with-current-buffer buffer
 88         (setq tabulated-list-entries entries)
 89         (tabulated-list-print t))))
 90  
 91  (defvar docker-pop-to-buffer-action nil
 92    "Action to use internally when `docker-utils-pop-to-buffer' calls `pop-to-buffer'.")
 93  
 94  (defun docker-utils-pop-to-buffer (name)
 95    "Like `pop-to-buffer', but suffix NAME with the host if on a remote host."
 96    (pop-to-buffer
 97     (if (file-remote-p default-directory)
 98         (with-parsed-tramp-file-name default-directory nil (concat name " - " host))
 99       name)
100     docker-pop-to-buffer-action))
101  
102  (defun docker-utils-unit-multiplier (str)
103    "Return the correct multiplier for STR."
104    (let* ((unit (or str "B"))
105           (idx (-elem-index (upcase unit) '("B" "KB" "MB" "GB" "TB" "PB" "EB"))))
106      (expt 1024 (or idx 0))))
107  
108  (defun docker-utils-human-size-to-bytes (str)
109    "Parse STR and return size in bytes."
110    (let* ((parts (s-match "^\\([0-9\\.]+\\)\\([A-Za-z]+\\)?$" str)))
111      (unless parts
112        (error "Unexpected size format: %s" str))
113      (let* ((value (string-to-number (-second-item parts)))
114             (multiplier (docker-utils-unit-multiplier (-third-item parts))))
115        (* value multiplier))))
116  
117  (defun docker-utils-human-size-predicate (a b)
118    "Sort A and B by image size."
119      (< (docker-utils-human-size-to-bytes a) (docker-utils-human-size-to-bytes b)))
120  
121  (defun docker-utils-columns-list-format (columns-spec)
122    "Convert COLUMNS-SPEC (a list of plists) to 'tabulated-list-format', i.e. a vector of (name width sort-fn)."
123    (apply 'vector
124    (--map-indexed
125     (-let* (((&plist :name name :width width :sort sort-fn-inner) it)
126             (sort-fn (if sort-fn-inner
127                          (let ((idx it-index)) ;; Rebind the closure var!
128                            ;; Sort fn is called with (id [entries..])
129                            ;; Extract the column value and pass to inner function
130                            (-on sort-fn-inner (lambda (x) (elt (cadr x) idx))))
131                        t)))
132       (list name width sort-fn))
133     columns-spec)))
134  
135  (defun docker-utils-make-format-string (id-template column-spec)
136    "Make the format string to pass to docker-ls commands.
137  
138  ID-TEMPLATE is the Go template used to extract the property that
139  identifies the object (usually its id).
140  COLUMN-SPEC is the value of docker-X-columns."
141    (let* ((templates (--map (plist-get it :template) column-spec))
142           (delimited (string-join templates ",")))
143      (format "[%s,%s]" id-template delimited)))
144  
145  (defun docker-utils-parse (column-specs line)
146    "Convert a LINE from \"docker ls\" to a `tabulated-list-entries' entry.
147  
148  LINE is expected to be a JSON formatted array, and COLUMN-SPECS is the relevant
149  defcustom (e.g. `docker-image-columns`) used to apply any custom format functions."
150    (condition-case nil
151        (let* ((data (json-read-from-string line)))
152          ;; apply format function, if any
153          (--each-indexed
154              column-specs
155            (let ((fmt-fn (plist-get it :format))
156                  (data-index (+ it-index 1)))
157              (when fmt-fn (aset data data-index (apply fmt-fn (list (aref data data-index)))))))
158  
159          (list (aref data 0) (seq-drop data 1)))
160      (json-readtable-error
161       (error "Could not read following string as json:\n%s" line))))
162  
163  (defun docker-utils-columns-setter (sym new-value)
164    "Convert NEW-VALUE into a list of plists, then assign to SYM.
165  
166  If NEW-VALUE already looks like a list of plists, no conversion is performed and
167   NEW-VALUE is assigned to SYM unchanged.  This is expected to be used as the
168  value of :set in a defcustom."
169    (let ((is-plist (plist-member (car new-value) :name))
170          (new-value-plist (--map
171                            (-interleave '(:name :width :template :sort :format) it)
172                            new-value)))
173      (set sym (if is-plist new-value new-value-plist))))
174  
175  (defun docker-utils-columns-getter (sym)
176    "Convert the value of SYM for displaying in the customization menu.
177  
178  Just strips the plist symbols and returns only values.
179  This has no effect on the actual value of the variable."
180    (--map
181     (-map (-partial #'plist-get it) '(:name :width :template :sort :format))
182     (symbol-value sym)))
183  
184  (defun docker-utils-package-p (package)
185    "Check if PACKAGE is available."
186    (or (featurep package)
187        (ignore-errors (require package))))
188  
189  (provide 'docker-utils)
190  
191  ;;; docker-utils.el ends here