Merge pull request #747 from samply/to-time

Implement CQL ToTime and rearrange ToDate and ToDateTime

modules/cql/src/blaze/elm/compiler/type_operators.clj

@@ -257,4 +257,14 @@
   (p/to-string x))
 
 
-;; TODO 22.31. ToTime
+;; 22.31. ToTime
+(defrecord ToTimeOperatorExpression [operand]
+  core/Expression
+  (-eval [_ {:keys [now] :as context} resource scope]
+    (p/to-time (core/-eval operand context resource scope) now)))
+
+
+(defmethod core/compile* :elm.compiler.type/to-time
+  [context {:keys [operand]}]
+  (when-let [operand (core/compile* context operand)]
+    (->ToTimeOperatorExpression operand)))

modules/cql/src/blaze/elm/date_time.clj

@@ -1233,14 +1233,6 @@
 
 ;; 22.22. ToDate
 (extend-protocol p/ToDate
-  nil
-  (to-date [_ _])
-
-  String
-  (to-date [s _]
-    (-> (system/parse-date s)
-        (ba/exceptionally (constantly nil))))
-
   Year
   (to-date [this _]
     this)
@@ -1277,9 +1269,6 @@
 
 ;; 22.23. ToDateTime
 (extend-protocol p/ToDateTime
-  nil
-  (to-date-time [_ _])
-
   Instant
   (to-date-time [this now]
     (-> (.atOffset this (.getOffset ^OffsetDateTime now))
@@ -1320,11 +1309,7 @@
   OffsetDateTime
   (to-date-time [this now]
     (-> (.withOffsetSameInstant this (.getOffset ^OffsetDateTime now))
-        (.toLocalDateTime)))
-
-  String
-  (to-date-time [s now]
-    (p/to-date-time (system/parse-date-time s) now)))
+        (.toLocalDateTime))))
 
 
 ;; 22.30. ToString
@@ -1360,3 +1345,23 @@
   LocalDateTime
   (to-string [x]
     (str x)))
+
+
+;; 22.31. ToTime
+(extend-protocol p/ToTime
+  LocalTime
+  (to-time [this _]
+    this)
+
+  LocalDateTime
+  (to-time [this _]
+    (.toLocalTime this))
+
+  OffsetDateTime
+  (to-time [this now]
+    (-> (.withOffsetSameInstant this (.getOffset ^OffsetDateTime now))
+        (.toLocalTime)))
+
+  PrecisionLocalTime
+  (to-time [this _]
+   (.-local_time this)))

modules/cql/src/blaze/elm/deps_infer.clj

@@ -620,6 +620,9 @@
 (derive :elm.deps.type/to-quantity :elm.deps.type/unary-expression)
 
 
+;; 22.31. ToTime
+(derive :elm.deps.type/to-time :elm.deps.type/unary-expression)
+
 
 ;; 23. Clinical Operators
 

modules/cql/src/blaze/elm/nil.clj

@@ -284,6 +284,18 @@
   (to-boolean [_]))
 
 
+;; 22.22. ToDate
+(extend-protocol p/ToDate
+  nil
+  (to-date [_ _]))
+
+
+;; 22.23. ToDateTime
+(extend-protocol p/ToDateTime
+  nil
+  (to-date-time [_ _]))
+
+
 ;; 22.24. ToDecimal
 (extend-protocol p/ToDecimal
   nil
@@ -312,3 +324,9 @@
 (extend-protocol p/ToString
   nil
   (to-string [_]))
+
+
+;; 22.31. ToTime
+(extend-protocol p/ToTime
+  nil
+  (to-time [_ _]))

modules/cql/src/blaze/elm/protocols.clj

@@ -308,3 +308,9 @@
 ;; 22.30. ToString
 (defprotocol ToString
   (to-string [x]))
+
+
+;; 22.31. ToTime
+(defprotocol ToTime
+  "Converts an object into something usable as Time relative to `now`."
+  (to-time [x now]))

modules/cql/src/blaze/elm/string.clj

@@ -1,7 +1,9 @@
 (ns blaze.elm.string
   "Implementation of the string type."
   (:require
+    [blaze.anomaly :as ba]
     [blaze.elm.protocols :as p]
+    [blaze.fhir.spec.type.system :as system]
     [clojure.string :as str]))
 
 
@@ -45,6 +47,21 @@
       nil)))
 
 
+;; 22.22. ToDate
+(extend-protocol p/ToDate
+  String
+  (to-date [s _]
+    (-> (system/parse-date s)
+        (ba/exceptionally (constantly nil)))))
+
+
+;; 22.23. ToDateTime
+(extend-protocol p/ToDateTime
+  String
+  (to-date-time [s now]
+    (p/to-date-time (system/parse-date-time s) now)))
+
+
 ;; 22.24. ToDecimal
 (extend-protocol p/ToDecimal
   String
@@ -53,8 +70,17 @@
       (p/to-decimal (BigDecimal. s))
       (catch Exception _))))
 
+
 ;; 22.30. ToString
 (extend-protocol p/ToString
   String
   (to-string [s]
     (str s)))
+
+
+;; 22.31. ToTime
+(extend-protocol p/ToTime
+  String
+  (to-time [s _]
+    (-> (system/parse-time s)
+        (ba/exceptionally (constantly nil)))))

modules/cql/test/blaze/cql_test.clj

@@ -155,10 +155,11 @@
             "Decimal18D55ToString"                          ; TODO: implement
             "Quantity5D5CMToString"                         ; TODO: implement
             "BooleanTrueToString"                           ; TODO: implement
-            "ToTime1"                                       ; TODO: implement
-            "ToTime2"                                       ; TODO: implement
-            "ToTime3"                                       ; TODO: implement
-            "ToTime4"                                       ; TODO: implement
+            "ToTime1"                                       ; shouldn't start with T
+            "ToTime2"                                       ; time zone?
+            "ToTime3"                                       ; time zone?
+            "ToTime4"                                       ; time zone?
+            "ToTimeMalformed"                               ; should return null
             "StringToDateTimeMalformed"                     ; should return null
             "ToDateTimeMalformed"                           ; should return null
             })

modules/cql/test/blaze/elm/compiler/comparison_operators_test.clj

@@ -212,7 +212,7 @@
       "12:30:15" "12:30:16" false
       "12:30:16" "12:30:15" false
 
-      "12:30.00" "12:30" nil
+      "12:30:00" "12:30" nil
 
       "12:00" "12" nil)
 

modules/cql/test/blaze/elm/compiler/date_time_operators_test.clj

@@ -849,11 +849,12 @@
 ;;
 ;; At least one component other than timezoneOffset must be specified, and no
 ;; component may be specified at a precision below an unspecified precision.
-;; For example, minute may be null, but if it is, second, and millisecond
-;; must all be null as well.
+;; For example, minute may be null, but if it is, second, and millisecond must
+;; all be null as well.
 ;;
-;; If timezoneOffset is not specified, it is defaulted to the timezone offset
-;; of the evaluation request.
+;; Although the milliseconds are specified with a separate component, seconds
+;; and milliseconds are combined and represented as a Decimal for the purposes
+;; of comparison.
 (deftest compile-time-test
   (testing "Static hour"
     (are [elm res] (= res (c/compile {} elm))

modules/cql/test/blaze/elm/compiler/test_util.clj

@@ -5,6 +5,7 @@
     [blaze.elm.literal :as elm]
     [blaze.elm.literal-spec]
     [blaze.elm.spec]
+    [blaze.fhir.spec.type.system :as system]
     [clojure.spec.alpha :as s]
     [clojure.spec.test.alpha :as st]
     [clojure.test :refer [is testing]])
@@ -60,13 +61,18 @@
       {:name "ab"}
       {:name "b"}
       {:name "ba"}
-      {:name "A"}]}}})
+      {:name "A"}
+      {:name "12:54:00"}
+      {:name "2020-01-02T03:04:05.006Z"}]}}})
 
 
 (def dynamic-eval-ctx
   {:parameters
    {"true" true "false" false "nil" nil "1" 1 "2" 2 "3" 3 "4" 4
-    "empty-string" "" "a" "a" "ab" "ab" "b" "b" "ba" "ba" "A" "A"}})
+    "empty-string" "" "a" "a" "ab" "ab" "b" "b" "ba" "ba" "A" "A"
+    "12:54:00" (system/time 12 54 00)
+    "2020-01-02T03:04:05.006Z" (system/date-time 2020 1 2 3 4 5 6 ZoneOffset/UTC)}
+   :now now})
 
 
 (defn dynamic-compile-eval [elm]

modules/cql/test/blaze/elm/compiler/type_operators_test.clj

@@ -1441,7 +1441,7 @@
       (is (= '(to-string (param-ref "x")) (core/-form expr))))))
 
 
-;; TODO 22.31. ToTime
+;; 22.31. ToTime
 ;;
 ;; The ToTime operator converts the value of its argument to a Time value.
 ;;
@@ -1464,4 +1464,34 @@
 ;; For DateTime values, the result is the same as extracting the Time component
 ;; from the DateTime value.
 ;;
-;; If the argument is null, the result is null.
+;; If the argument is null, the result is null.
+(deftest compile-to-time-test
+  (let [eval #(core/-eval % {:now tu/now} nil nil)]
+    (testing "String"
+      (are [x res] (= res (eval (tu/compile-unop elm/to-time elm/string x)))
+        "12:54:30" (system/time 12 54 30)
+        "12:54:30.010" (system/time 12 54 30 10)
+
+        "aaaa" nil
+        "12:54" nil
+        "24:54:00" nil
+        "23:60:00" nil
+        "14-30-00.0" nil))
+
+    (testing "Time"
+      (are [x res] (= res (eval (tu/compile-unop elm/to-time elm/time x)))
+        "12:54" (system/time 12 54)
+        "12:54:00" (system/time 12 54 00)
+        "12:54:30.010" (system/time 12 54 30 10)))
+
+    (testing "DateTime"
+      (are [x res] (= res (eval (tu/compile-unop elm/to-time elm/date-time x)))
+        "2020-03-08T12:54:00" (system/time 12 54 00)
+        "2020-03-08T12:54:30.010" (system/time 12 54 30 10)))
+
+    (testing "dynamic"
+      (are [x res] (= res (tu/dynamic-compile-eval (elm/to-time x)))
+        #elm/parameter-ref "12:54:00" (system/time 12 54 00)
+        #elm/parameter-ref "2020-01-02T03:04:05.006Z" (system/time 3 4 5 6))))
+
+  (tu/testing-unary-null elm/to-time))

modules/cql/test/blaze/elm/literal.clj

@@ -8,6 +8,9 @@
     [clojure.string :as str]))
 
 
+(set! *warn-on-reflection* true)
+
+
 ;; 1. Simple Values
 
 ;; 1.1. Literal
@@ -461,9 +464,12 @@
         timezone-offset (assoc :timezoneOffset timezone-offset)))))
 
 
+;; 18.18. Time
 (defn time [arg]
   (if (string? arg)
-    (time (map integer (str/split arg #"[:.]")))
+    (time (map integer (str/split (if (.contains ^String arg ".")
+                                    (subs (str arg "000") 0 12)
+                                    arg) #"[:.]")))
     (let [[hour minute second millisecond] arg]
       (cond->
         {:type "Time"
@@ -882,7 +888,9 @@
 (defn to-string [operand]
   {:type "ToString" :operand operand})
 
-
+;; 22.31. ToTime
+(defn to-time [operand]
+  {:type "ToTime" :operand operand})
 
 ;; 23. Clinical Operators
 

modules/cql/test/blaze/elm/literal_spec.clj

@@ -493,6 +493,11 @@
   :ret :elm/expression)
 
 
+;; 22.31. ToTime
+(s/fdef elm/to-time
+  :args (s/cat :operand :elm/expression)
+  :ret :elm/expression)
+
 
 ;; 23. Clinical Operators
 

modules/fhir-structure/src/blaze/fhir/spec/type/system.clj

@@ -9,7 +9,7 @@
    * DateTime
    * Time
    * Quantity"
-  (:refer-clojure :exclude [boolean? decimal? integer? string? type])
+  (:refer-clojure :exclude [boolean? decimal? integer? string? time type])
   (:require
     [blaze.anomaly :as ba]
     [cognitect.anomalies :as anom]
@@ -538,6 +538,34 @@
     (some->> x (.equals time))))
 
 
+(defn time
+  "Returns a System.Time"
+  ([hour minute]
+   (LocalTime/of (int hour) (int minute)))
+  ([hour minute second]
+   (LocalTime/of (int hour) (int minute) (int second)))
+  ([hour minute second millis]
+   (LocalTime/of (int hour) (int minute) (int second)
+                 (unchecked-multiply-int (int millis) 1000000))))
+
+
+(defn parse-time* [s]
+  (LocalTime/parse s))
+
+
+(defn- time-string? [s]
+  (.matches (re-matcher #"([01][0-9]|2[0-3]):[0-5][0-9]:([0-5][0-9]|60)(\.[0-9]+)?" s)))
+
+
+(defn parse-time
+  "Parses `s` into a System.Time.
+
+  Returns an anomaly if `s` isn't a valid System.Time."
+  [s]
+  (if (time-string? s)
+    (ba/try-one DateTimeParseException ::anom/incorrect (parse-time* s))
+    (ba/incorrect (format "Invalid date-time value `%s`." s))))
+
 
 ;; ---- Other -----------------------------------------------------------------