Add support for encoding instants as version 8 UUID values

ginkgo-time-test.lisp

@@ -35,6 +35,10 @@
          (i (gt:instant-of-epoch-milli epoch-milli)))
     (is (eql epoch-milli (gt:instant-to-epoch-milli i)))))
 
+(test instant-v8-uuid-conversion
+  (let ((i (instant-now)))
+    (instant= i (instant-of-v8-uuid (instant-to-v8-uuid i)))))
+
 (test instant-plus-duration
   (let ((d (gt:plus (ginkgo:chrono-unit-duration :days)
                     (ginkgo:chrono-unit-duration :nanos))))

ginkgo-time.asd

@@ -8,7 +8,9 @@
   :serial t
   :depends-on (#:zoneinfo
                #:chronogram
-               #:trivial-clock)
+               #:trivial-clock
+               #:ironclad/prngs
+               #:frugal-uuid/non-frugal)
   :components ((:file "package")
                (:file "const")
                (:file "generic")

instant.lisp

@@ -74,3 +74,30 @@
 (defun instant-to-epoch-milli (instant)
   (+ (* (seconds instant) +millis-per-second+)
      (floor (nanos instant) +nanos-per-milli+)))
+
+(declaim (ftype (function (instant &optional (unsigned-byte 54))
+                          fuuid:uuid)
+                instant-to-v8-uuid))
+(defun instant-to-v8-uuid (instant &optional padding)
+  (multiple-value-bind (millis nanos) (floor (nanos instant)
+                                             +nanos-per-milli+)
+    (let ((epoch-millis (+ (* (seconds instant) +millis-per-second+) millis)))
+      (if (<= 0 epoch-millis #xFFFFFFFFFFFF)
+          (fuuid:make-minara-from-components
+           epoch-millis
+           nanos
+           (or padding
+               (crypto:strong-random fuuid:+minara-max-random+)))
+          (error "~A out of range for UUID encoding" instant)))))
+
+(declaim (ftype (function (fuuid:uuid)
+                          (values instant (unsigned-byte 54)))
+                instant-from-v8-uuid))
+(defun instant-of-v8-uuid (uuid)
+  (multiple-value-bind (millis nanos padding) (fuuid:minara-components uuid)
+    (multiple-value-bind (seconds millis) (floor millis
+                                                 +millis-per-second+)
+      (values (instant-of-epoch-second seconds
+                                       (+ (* millis +nanos-per-milli+)
+                                          nanos))
+              padding))))