Split off format-human-size and human-size-formatter.

See ruricolist#37.

Author: ruricolist

files.lisp

@@ -165,15 +165,18 @@ only cares about its name and type."
 
 (defun format-file-size-human-readable (stream file-size
                                         &key flavor
-                                             (space (and (eql flavor :si) t))
+                                             (space (eql flavor :si))
                                              (suffix (if (eql flavor :iec) "B" "")))
-  "Write SIZE, a file size in bytes, to STREAM, in human-readable form.
+  "Write FILE-SIZE, a file size in bytes, to STREAM, in human-readable form.
+
+STREAM is interpreted as by `format'.
+
 If FLAVOR is nil, kilobytes are 1024 bytes and SI prefixes are used.
 
 If FLAVOR is `:si', kilobytes are 1000 bytes and SI prefixes are used.
 
-If FLAVOR is `:iec', kilobytes are 1024 bytes and SI prefixes (KiB,
-MiB, etc.) are used.
+If FLAVOR is `:iec', kilobytes are 1024 bytes and IEC prefixes (Ki,
+Mi, etc.) are used.
 
 If SPACE is non-nil, include a space between the number and the
 prefix. (Defaults to T if FLAVOR is `:si'.)
@@ -182,37 +185,13 @@ SUFFIX is the suffix to use; defaults to B if FLAVOR is `:iec',
 otherwise empty.
 
 Inspired by the function of the same name in Emacs."
-  (when (zerop file-size)
-    (return-from format-file-size-human-readable
-      (format stream "0")))
-  (let ((file-size (coerce file-size 'double-float))
-        ;; Avoid printing exponent markers.
-        (*read-default-float-format* 'double-float)
-        (base (ecase flavor
-                ((nil) 1024)
-                (:si   1000)
-                (:iec  2))))
-    (multiple-value-bind (long short factor)
-        (si-prefix file-size :base base)
-      (declare (ignore long))
-      (let* ((file-size (/ file-size factor))
-             (int (round file-size))
-             (file-size
-               (if (> (abs (- file-size int))
-                      0.05d0)
-                   file-size
-                   int))
-             (control-string
-               (if (floatp file-size)
-                   (formatter "~,1f")
-                   (formatter "~d"))))
-        (format stream
-                "~@?~:[~; ~]~a~a"
-                control-string
-                file-size
-                space
-                short
-                suffix)))))
+  (check-type file-size (integer 0 *))
+  (if (zerop file-size)
+      (format stream "0")
+      (let ((flavor (if (null flavor) :file flavor)))
+        (multiple-value-bind (formatter args)
+            (human-size-formatter file-size :flavor flavor :space space)
+          (format stream "~?~a" formatter args suffix)))))
 
 (defun file-size-human-readable (file &key flavor space suffix stream)
   "Format the size of FILE (in octets) using `format-file-size-human-readable'.

package.lisp

@@ -252,7 +252,6 @@
    #:random-in-range
    #:float-precision-contagion
    #:range
-   #:si-prefix
    ;; Octets.
    #:octet
    #:octet-vector
@@ -423,7 +422,11 @@
    #:package-exports
    #:package-names
    #:package-name-keyword
-   #:find-external-symbol))
+   #:find-external-symbol
+   ;; Units.
+   #:si-prefix
+   #:human-size-formatter
+   #:format-human-size))
 
 (defpackage #:serapeum-user
   (:use #:cl #:alexandria #:serapeum))

tests/units.lisp

@@ -23,3 +23,14 @@
   (is (equal "kilo" (si-prefix (expt 2 10))))
   (is (equal "kibi" (si-prefix (expt 2 10) :base 2)))
   (is (equal "yocto" (si-prefix (expt 10 -23)))))
+
+(test format-human-size
+  (is (equal "0" (format-human-size nil 0)))
+  (is (equal "0" (format-human-size nil 0 :flavor :iec)))
+  (is (equal "0" (format-human-size nil 0 :flavor :si)))
+  (is (equal "1 k" (format-human-size nil 1000)))
+  (is (equal "-1 k" (format-human-size nil -1000)))
+  (is (equal "1Ki" (format-human-size nil 1024 :flavor :iec)))
+  (is (equal "-1Ki" (format-human-size nil -1024 :flavor :iec)))
+  (is (equal "500 k" (format-human-size nil 500000 :flavor :si)))
+  (is (equal "-500 k" (format-human-size nil -500000 :flavor :si))))

units.lisp

@@ -73,3 +73,57 @@ sizes. Base 2 uses the IEC binary prefixes."
           (10 (si-prefix-rec n 10d0 #.si-prefixes))
           (1000 (si-prefix-rec n 1000d0 #.si-prefixes-base-1000))
           (1024 (si-prefix-rec n 1024d0 #.si-prefixes-base-1000))))))
+
+(defun human-size-formatter (size &key (flavor :si)
+                                       (space (eql flavor :si)))
+  "Auxiliary function for formatting quantities human-readably.
+Returns two values: a format control and a list of arguments.
+
+This can be used to integrate the human-readable printing of
+quantities into larger format control strings using the recursive
+processing format directive (~?):
+
+    (multiple-value-bind (control args)
+        (human-size-formatter size)
+      (format t \"~?\" control args))"
+  (let ((size (coerce size 'double-float))
+        ;; Avoid printing exponent markers.
+        (*read-default-float-format* 'double-float)
+        (base (ecase flavor
+                (:file 1024)
+                (:si   1000)
+                (:iec  2))))
+    (multiple-value-bind (long short factor)
+        (si-prefix size :base base)
+      (declare (ignore long))
+      (let* ((size (/ size factor))
+             (int (round size))
+             (size
+               (if (> (abs (- size int))
+                      0.05d0)
+                   size
+                   int)))
+        (values (formatter "~:[~d~;~,1f~]~:[~; ~]~a")
+                (list (floatp size) size space short))))))
+
+(defun format-human-size (stream size
+                          &key (flavor :si)
+                               (space (eql flavor :si)))
+  "Write SIZE to STREAM, in human-readable form.
+
+STREAM is interpreted as by `format'.
+
+If FLAVOR is `:si' (the default) the base is 1000 and SI prefixes are used.
+
+If FLAVOR is `:file', the base is 1024 and SI prefixes are used.
+
+If FLAVOR is `:iec', the base is 1024 bytes and IEC prefixes (Ki, Mi,
+etc.) are used.
+
+If SPACE is non-nil, include a space between the number and the
+prefix. (Defaults to T if FLAVOR is `:si'.)"
+  (if (zerop size)
+      (format stream "0")
+      (multiple-value-bind (formatter args)
+          (human-size-formatter size :flavor flavor :space space)
+        (format stream "~?" formatter args))))