timeliner/src/utils.lisp

(in-package :cl-user)

(defpackage #:timeliner.utils
  (:use :cl :cl-mongo)
  (:export
   #:ts->ms
   #:ms->ts
   #:$between
   #:make-keyword
   #:starts-with
   #:aget
   #:doc->plist))
(in-package :timeliner.utils)

(defun ts->ms (ts)
  (+ (* 1000 (local-time:timestamp-to-unix ts))
     (floor (local-time:nsec-of ts) 1000000)))

(defun ms->ts (ms)
  (multiple-value-bind (unix msec) (floor ms 1000)
    (local-time:unix-to-timestamp unix :nsec (* msec 1000000))))

(defgeneric $between (a from to)
  (:documentation "cl-mongo between query"))

(defmethod $between (a from to)
  (kv ($>= a from) ($< a to)))

(defmethod $between (a (from local-time:timestamp) (to local-time:timestamp))
  ($between a
            (cl-mongo::make-bson-time (ts->ms from))
            (cl-mongo::make-bson-time (ts->ms to))))

(defun make-keyword (name) (values (intern (string-upcase name) "KEYWORD")))

(defun starts-with (str with)
  (string= (subseq str 0 (min (length str)
                              (length with)))
           with))

(defmacro aget (key alist)
  `(cdr (assoc ,key ,alist :test #'string=)))

(defvar *decode-doc-to* :plist "Document object type")
(defgeneric decode-element (element)
  (:documentation "Convert cl-mongo element to preferred type"))

(defmethod decode-element (element)
  element)

(defmethod decode-element ((element document))
  (case *decode-doc-to*
    (:plist (doc->plist element))))

(defmethod decode-element ((element cl-mongo::bson-time))
  (ms->ts (cl-mongo::raw element)))

(defun doc->plist (doc)
  (let ((*decode-doc-to* :plist)
        result)
    (loop for key in (get-keys doc)
       do (setf (getf result (make-keyword key))
                (decode-element (get-element key doc))))
    result))

(defmethod yason:encode ((object document) &optional (stream *standard-output*))
  (yason:encode (cl-mongo::elements object) stream))

(defmethod yason:encode ((object cl-mongo::bson-time) &optional (stream *standard-output*))
  (yason:encode (cl-mongo::raw object) stream))