Enable millisecond precision for TIMESTAMP types (only on PostgreSQL).

mito-core.asd

@@ -1,21 +1,16 @@
-(in-package :cl-user)
-(defpackage mito-core-asd
-  (:use :cl :asdf))
-(in-package :mito-core-asd)
-
-(defsystem mito-core
+(defsystem "mito-core"
   :version "0.1"
   :author "Eitaro Fukamachi"
   :license "LLGPL"
-  :depends-on (:dbi
-               :sxql
-               :cl-ppcre
-               :closer-mop
-               :dissect
-               :optima
-               :cl-reexport
-               :local-time
-               :alexandria)
+  :depends-on ("dbi"
+               "sxql"
+               "cl-ppcre"
+               "closer-mop"
+               "dissect"
+               "optima"
+               "cl-reexport"
+               "local-time"
+               "alexandria")
   :components ((:file "src/core" :depends-on ("core-components"))
                (:module "core-components"
                 :pathname "src/core"
@@ -48,3 +43,10 @@
                  (:file "logger")
                  (:file "error")
                  (:file "util")))))
+
+(when (find-system :cl-postgres nil)
+  (defmethod perform :after ((op load-op) (c (eql (find-system :cl-postgres))))
+    (symbol-call :cl-postgres :set-sql-datetime-readers
+                 :timestamp (lambda (usec)
+                              (+ #.(encode-universal-time 0 0 0 1 1 2000 0)
+                                 (/ usec 1000000.0))))))

src/core/dao/column.lisp

@@ -54,10 +54,16 @@
   (:method (col-type value)
     (declare (ignore col-type))
     (identity value))
+  (:method ((col-type cons) value)
+    (inflate-for-col-type (first col-type) value))
   (:method ((col-type (eql :datetime)) value)
     (etypecase value
       (integer
        (local-time:universal-to-timestamp value))
+      (float
+       (multiple-value-bind (sec nsec)
+           (truncate value)
+         (local-time:universal-to-timestamp sec :nsec (* (floor (* nsec 1000000)) 1000))))
       (string
        (local-time:parse-timestring value :date-time-separator #\Space))
       (null nil)))
@@ -87,6 +93,8 @@
   (:method (col-type value)
     (declare (ignore col-type))
     (identity value))
+  (:method ((col-type cons) value)
+    (deflate-for-col-type (first col-type) value))
   (:method ((col-type (eql :datetime)) value)
     (etypecase value
       (integer
@@ -96,7 +104,7 @@
       (local-time:timestamp
        (local-time:format-timestring nil value
                                      :format
-                                     '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\Space (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2))))
+                                     '((:YEAR 4) #\- (:MONTH 2) #\- (:DAY 2) #\Space (:HOUR 2) #\: (:MIN 2) #\: (:SEC 2) #\. (:NSEC))))
       (string value)
       (null nil)))
   (:method ((col-type (eql :date)) value)

t/dao.lisp

@@ -238,4 +238,21 @@
         (is-type (mito:object-created-at user) 'local-time:timestamp)))
     (disconnect-toplevel)))
 
+(subtest "timestamp with milliseconds (PostgreSQL)"
+  (setf *connection* (connect-to-testdb :postgres))
+  (defclass user ()
+    ((registered-at :col-type :timestamp))
+    (:metaclass dao-table-class)
+    (:record-timestamps nil))
+  (mito:execute-sql
+   (sxql:drop-table :user :if-exists t))
+  (mito:ensure-table-exists 'user)
+
+  (let ((now (local-time:now)))
+    (mito:create-dao 'user :registered-at now)
+    (let ((user (mito:find-dao 'user :id 1)))
+      (is-type (slot-value user 'registered-at) 'local-time:timestamp)
+      (ok (/= (local-time:nsec-of (slot-value user 'registered-at)) 0))))
+  (disconnect-toplevel))
+
 (finalize)