Add seconds-to-condensed-time-string

diff --git a/datetime.lisp b/datetime.lisp
index b3dbc1a47f895895e549064059d876202c0b5a74..b865f48a3ece1d541d2ecea8e2d3119ec5e5939e 100644 (file)
--- a/datetime.lisp
+++ b/datetime.lisp
@@ -50,6 +50,42 @@
                 year
                 hr min sec))))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant +minute-seconds+ 60)
+  (defconstant +hour-seconds+ (* 60 +minute-seconds+))
+  (defconstant +day-seconds+ (* 24 +hour-seconds+))
+  (defconstant +week-seconds+ (* +day-seconds+ 7))
+  (defconstant +month-seconds+ (* +day-seconds+ (/ 365.25 12)))
+  (defconstant +year-seconds+ (* +day-seconds+ 365.25)))
+
+(defun seconds-to-condensed-time-string (sec &key (dp-digits 0))
+  "Prints a quantity of seconds as a condensed string. DP-DIGITS controls
+how many digits after decimal point."
+  (multiple-value-bind (year yrem) (floor (coerce sec 'double-float) +year-seconds+)
+    (multiple-value-bind (month mrem) (floor yrem +month-seconds+)
+      (multiple-value-bind (week wrem) (floor mrem +week-seconds+)
+        (multiple-value-bind (day drem) (floor wrem +day-seconds+)
+          (multiple-value-bind (hour hrem) (floor drem +hour-seconds+)
+            (multiple-value-bind (minute minrem) (floor hrem +minute-seconds+)
+              (let ((secstr (if (zerop dp-digits)
+                                (format nil "~Ds" (round minrem))
+                                (format nil (format nil "~~,~DFs" dp-digits) minrem))))
+                (cond
+                  ((plusp year)
+                   (format nil "~Dy~DM~Dw~Dd~Dh~Dm~A" year month week day hour minute secstr))
+                  ((plusp month)
+                   (format nil "~DM~Dw~Dd~Dh~Dm~A" month week day hour minute secstr))
+                  ((plusp week)
+                   (format nil "~Dw~Dd~Dh~Dm~A" week day hour minute secstr))
+                  ((plusp day)
+                   (format nil "~Dd~Dh~Dm~A" day hour minute secstr))
+                  ((plusp hour)
+                   (format nil "~Dh~Dm~A" hour minute secstr))
+                  ((plusp minute)
+                   (format nil "~Dm~A" minute secstr))
+                  (t
+                   secstr))))))))))
+
 (defun print-seconds (secs)
   (print-float-units secs "sec"))
 

diff --git a/hash.lisp b/hash.lisp
index fb4c4fa9ced427a96f94e94f6ac5d827a49f47fa..e849783ef99ac775a7716de71386561a365082a6 100644 (file)
--- a/hash.lisp
+++ b/hash.lisp
@@ -23,7 +23,7 @@
                    key-transform-fn value-transform-fn
                    (prefix "") (divider " -> ") (terminator "~%"))
   (maphash #'(lambda (k v)
-               (format stream "~A~S~A~S~%"
+               (format stream "~A~S~A~S"
                        prefix
                        (if key-transform-fn
                            (funcall key-transform-fn k)
@@ -31,11 +31,8 @@
                        divider
                        (if value-transform-fn
                            (funcall value-transform-fn v)
-                           v)
-                       (when terminator (format stream terminator)))
-               h)
+                           v))
+               (when terminator (format stream terminator)))
+           h)
   h)
 
-(defun print-hash (h &optional (stream *standard-output*))
-  (maphash #'(lambda (k v) (format stream "~S -> ~S~%" k v)) h)
-  h)

diff --git a/package.lisp b/package.lisp
index 0f9bae3d0a0f8e106de9819037b403f8740ce875..6432b88f5f8000c26da7107664aff489af76e935 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -253,6 +253,7 @@
    #:print-seconds
    #:posix-time-to-utime
    #:utime-to-posix-time
+   #:seconds-to-condensed-time-string
 
    ;; From random.lisp
    #:seed-random-generator

diff --git a/tests.lisp b/tests.lisp
index 7ab59b369b08452956c9a92c4489e9026b593edb..11c7f98758850225bb2a74de7a0be4d068395f7e 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -360,6 +360,27 @@
      (encode-universal-time 0 0 0 1 11 2000)) nil)
 )
 
+(deftest :sts.1
+    (seconds-to-condensed-time-string 0) "0s")
+(deftest :sts.2
+    (seconds-to-condensed-time-string 60) "1m0s")
+(deftest :sts.3
+    (seconds-to-condensed-time-string 65) "1m5s")
+(deftest :sts.4
+    (seconds-to-condensed-time-string 3600) "1h0m0s")
+(deftest :sts.5
+    (seconds-to-condensed-time-string 36000) "10h0m0s")
+(deftest :sts.6
+    (seconds-to-condensed-time-string 86400) "1d0h0m0s")
+(deftest :sts.7
+    (seconds-to-condensed-time-string (* 7 86400)) "1w0d0h0m0s")
+(deftest :sts.8
+    (seconds-to-condensed-time-string (* 21 86400)) "3w0d0h0m0s")
+(deftest :sts.9
+    (seconds-to-condensed-time-string (+ 86400 7200 120 50 (* 21 86400))) "3w1d2h2m50s")
+(deftest :sts.10
+    (seconds-to-condensed-time-string (+ .1 86400 7200 120 50 (* 21 86400))
+                                      :dp-digits 1) "3w1d2h2m50.1s")
 
 (deftest :ekdc.1
     (ensure-keyword-default-case (read-from-string "TYPE")) :type)