From f2d2f950bfc1645a591883b215b896109c79ee13 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Sun, 26 Jun 2011 23:53:03 -0600
Subject: [PATCH] Add seconds-to-condensed-time-string

---
 datetime.lisp | 36 ++++++++++++++++++++++++++++++++++++
 hash.lisp     | 11 ++++-------
 package.lisp  |  1 +
 tests.lisp    | 21 +++++++++++++++++++++
 4 files changed, 62 insertions(+), 7 deletions(-)

diff --git a/datetime.lisp b/datetime.lisp
index b3dbc1a..b865f48 100644
--- 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 fb4c4fa..e849783 100644
--- 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 0f9bae3..6432b88 100644
--- 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 7ab59b3..11c7f98 100644
--- 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)
-- 
2.34.1