Merge pull request #755 from samply/cql-error-msg

Improve CQL Error Message on Subtract

modules/anomaly/src/blaze/anomaly.clj

@@ -110,8 +110,8 @@
 
 
 (defmacro try-one
-  "Applies a try-catch arround `body` catching exceptions of `type`, returning
-  an anomaly with `category` and possible message of the exception."
+  "Applies a try-catch form arround `body` catching exceptions of `type`,
+  returning an anomaly with `category` and possible message of the exception."
   [type category & body]
   `(try
      ~@body
@@ -125,7 +125,10 @@
   `(try-one Throwable ~category ~@body))
 
 
-(defmacro try-anomaly [& body]
+(defmacro try-anomaly
+  "Applies a try-catch form arround `body` catching all Throwables and returns
+  an anomaly created by the `anomaly` function."
+  [& body]
   `(try
      ~@body
      (catch Throwable e#

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

@@ -70,7 +70,11 @@
         (- months (:months other))
         (- millis (:millis other)))
       (throw (ex-info (str "Invalid RHS subtracting from Period. Expected Period but was `" (type other) "`.")
-                      {:op :subtract :this this :other other})))))
+                      {:op :subtract :this this :other other}))))
+
+  Object
+  (toString [_]
+    (format "Period[month = %d, millis = %d]" months millis)))
 
 
 (defn period [years months millis]
@@ -527,13 +531,43 @@
 
 
 ;; 16.20. Subtract
+(defn- year-out-of-range-msg [result period year]
+  (format "Year %s out of range while subtracting the period %s from the year %s."
+          result period year))
+
+
+(defn year-out-of-range-ex-info [year period result]
+  (ex-info (year-out-of-range-msg result period year)
+           {:op :subtract :year year :period period}))
+
+
+(defn- year-month-out-of-range-msg [result period year-month]
+  (format "Year-month %s out of range while subtracting the period %s from the year-month %s."
+          result period year-month))
+
+
+(defn year-month-out-of-range-ex-info [year-month period result]
+  (ex-info (year-month-out-of-range-msg result period year-month)
+           {:op :subtract :year-month year-month :period period}))
+
+
+(defn- date-out-of-range-msg [result period date]
+  (format "Date %s out of range while subtracting the period %s from the date %s."
+          result period date))
+
+
+(defn date-out-of-range-ex-info [date period result]
+  (ex-info (date-out-of-range-msg result period date)
+           {:op :subtract :date date :period period}))
+
+
 (extend-protocol p/Subtract
   Year
   (subtract [this other]
     (if (instance? Period other)
       (let [result (time/minus this (time/years (quot (:months other) 12)))]
         (if (time/before? result min-year)
-          (throw (ex-info "Out of range." {:op :subtract :this this :other other}))
+          (throw (year-out-of-range-ex-info this other result))
           result))
       (throw (ex-info (str "Invalid RHS adding to Year. Expected Period but was `" (type other) "`.")
                       {:op :subtract :this this :other other}))))
@@ -543,7 +577,7 @@
     (if (instance? Period other)
       (let [result (time/minus this (time/years (quot (:months other) 12)))]
         (if (time/before? result date-time-min-year)
-          (throw (ex-info "Out of range." {:op :subtract :this this :other other}))
+          (throw (year-out-of-range-ex-info this other result))
           result))
       (throw (ex-info (str "Invalid RHS adding to Year. Expected Period but was `" (type other) "`.")
                       {:op :subtract :this this :other other}))))
@@ -553,7 +587,7 @@
     (if (instance? Period other)
       (let [result (time/minus this (time/months (:months other)))]
         (if (time/before? result min-year-month)
-          (throw (ex-info "Out of range." {:op :subtract :this this :other other}))
+          (throw (year-month-out-of-range-ex-info this other result))
           result))
       (throw (ex-info (str "Invalid RHS adding to YearMonth. Expected Period but was `" (type other) "`.")
                       {:op :subtract :this this :other other}))))
@@ -563,7 +597,7 @@
     (if (instance? Period other)
       (let [result (time/minus this (time/months (:months other)))]
         (if (time/before? result date-time-min-year-month)
-          (throw (ex-info "Out of range." {:op :subtract :this this :other other}))
+          (throw (year-month-out-of-range-ex-info this other result))
           result))
       (throw (ex-info (str "Invalid RHS adding to YearMonth. Expected Period but was `" (type other) "`.")
                       {:op :subtract :this this :other other}))))
@@ -576,7 +610,7 @@
                      (time/months (:months other))
                      (time/days (quot (:millis other) 86400000)))]
         (if (time/before? result min-date)
-          (throw (ex-info "Out of range." {:op :subtract :this this :other other}))
+          (throw (date-out-of-range-ex-info this other result))
           result))
       (throw (ex-info (str "Invalid RHS adding to LocalDate. Expected Period but was `" (type other) "`.")
                       {:op :subtract :this this :other other}))))
@@ -589,7 +623,7 @@
                      (time/months (:months other))
                      (time/days (quot (:millis other) 86400000)))]
         (if (time/before? result date-time-min-date)
-          (throw (ex-info "Out of range." {:op :subtract :this this :other other}))
+          (throw (date-out-of-range-ex-info this other result))
           result))
       (throw (ex-info (str "Invalid RHS adding to LocalDate. Expected Period but was `" (type other) "`.")
                       {:op :subtract :this this :other other}))))

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

@@ -1080,7 +1080,32 @@
       #elm/date "2019-01-01" #elm/quantity [1 "year"] (system/date 2018 1 1)
       #elm/date "2012-02-29" #elm/quantity [1 "year"] (system/date 2011 2 28)
       #elm/date "2019-01-01" #elm/quantity [1 "month"] (system/date 2018 12 1)
-      #elm/date "2019-01-01" #elm/quantity [1 "day"] (system/date 2018 12 31)))
+      #elm/date "2019-01-01" #elm/quantity [1 "day"] (system/date 2018 12 31))
+
+    (testing "out of range"
+      (testing "year"
+        (given (ba/try-anomaly (c/compile {} (elm/subtract [#elm/date "2022" #elm/quantity [2022 "year"]])))
+          ::anom/category := ::anom/fault
+          ::anom/message := "Year 0 out of range while subtracting the period Period[month = 24264, millis = 0] from the year 2022."
+          :op := :subtract
+          :year := (system/date 2022)
+          :period (date-time/period 2022 0 0)))
+
+      (testing "year-month"
+        (given (ba/try-anomaly (c/compile {} (elm/subtract [#elm/date "2022-07" #elm/quantity [2022 "year"]])))
+          ::anom/category := ::anom/fault
+          ::anom/message := "Year-month 0000-07 out of range while subtracting the period Period[month = 24264, millis = 0] from the year-month 2022-07."
+          :op := :subtract
+          :year-month := (system/date 2022 7)
+          :period (date-time/period 2022 0 0)))
+
+      (testing "date"
+        (given (ba/try-anomaly (c/compile {} (elm/subtract [#elm/date "2022-07-01" #elm/quantity [2022 "year"]])))
+          ::anom/category := ::anom/fault
+          ::anom/message := "Date 0000-07-01 out of range while subtracting the period Period[month = 24264, millis = 0] from the date 2022-07-01."
+          :op := :subtract
+          :date := (system/date 2022 7 1)
+          :period (date-time/period 2022 0 0)))))
 
   ;; TODO: find a solution to avoid overflow
   #_(testing "Subtracting a positive amount of years from a year makes it smaller"
@@ -1150,7 +1175,15 @@
       #elm/date-time "2019-01-01T00" #elm/quantity [1 "day"] (system/date-time 2018 12 31 0 0 0)
       #elm/date-time "2019-01-01T00" #elm/quantity [1 "hour"] (system/date-time 2018 12 31 23 0 0)
       #elm/date-time "2019-01-01T00" #elm/quantity [1 "minute"] (system/date-time 2018 12 31 23 59 0)
-      #elm/date-time "2019-01-01T00" #elm/quantity [1 "second"] (system/date-time 2018 12 31 23 59 59)))
+      #elm/date-time "2019-01-01T00" #elm/quantity [1 "second"] (system/date-time 2018 12 31 23 59 59))
+
+    (testing "out of range"
+      (given (ba/try-anomaly (c/compile {} (elm/subtract [#elm/date-time "2022" #elm/quantity [2022 "year"]])))
+        ::anom/category := ::anom/fault
+        ::anom/message := "Year 0 out of range while subtracting the period Period[month = 24264, millis = 0] from the year 2022."
+        :op := :subtract
+        :year := (system/date-time 2022)
+        :period (date-time/period 2022 0 0))))
 
   (testing "Time - Quantity"
     (are [x y res] (= res (c/compile {} (elm/subtract [x y])))

modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj

@@ -31,18 +31,27 @@
   512)
 
 
+(defn- evaluate-expression-1-error-msg [expression-name e]
+  (format "Error while evaluating the expression `%s`: %s" expression-name
+          (ex-message e)))
+
+
 (defn- evaluate-expression-1
   [{:keys [library-context] :as context} subject-handle expression-name]
   (try
     (expr/eval context (get library-context expression-name) subject-handle)
     (catch Exception e
-      (log/error (format "Error while evaluating the expression `%s`:"
-                         expression-name) (ex-message (ex-cause e)))
-      (log/error e)
-      (ba/fault
-        (ex-message e)
-        :fhir/issue "exception"
-        :expression-name expression-name))))
+      (let [ex-data (ex-data e)]
+        ;; only log if the exception hasn't ex-data because exception with
+        ;; ex-data are controlled by us and so are not unexpected
+        (when-not ex-data
+          (log/error (evaluate-expression-1-error-msg expression-name e))
+          (log/error e))
+        (-> (ba/fault
+              (evaluate-expression-1-error-msg expression-name e)
+              :fhir/issue "exception"
+              :expression-name expression-name)
+            (merge ex-data))))))
 
 
 (defn- close-batch-db! [{:keys [db]}]
@@ -129,11 +138,12 @@
 
 (defn- unwrap-library-context
   {:arglists '([context])}
-  [{{:keys [compiled-expression-defs parameter-default-values]} :library
+  [{:keys [parameters]
+    {:keys [compiled-expression-defs parameter-default-values]} :library
     :as context}]
   (assoc context
     :library-context compiled-expression-defs
-    :parameters parameter-default-values))
+    :parameters (merge parameter-default-values parameters)))
 
 
 (defn evaluate-expression

modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_spec.clj

@@ -22,13 +22,17 @@
   :fhir.resource/type)
 
 
+(s/def ::parameters
+  (s/map-of string? any?))
+
+
 (s/def ::context
   (s/keys :req-un [:blaze.db/db ::now ::library ::subject-type
                    :blaze.fhir.operation.evaluate-measure/report-type]))
 
 
 (s/def ::individual-context
-  (s/keys :req-un [:blaze.db/db ::now ::library]))
+  (s/keys :req-un [:blaze.db/db ::now ::library] :opt-un [::parameters]))
 
 
 (s/fdef cql/evaluate-expression

modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_test.clj

@@ -6,9 +6,11 @@
     [blaze.db.api :as d]
     [blaze.db.api-stub :refer [mem-node-system with-system-data]]
     [blaze.elm.compiler.library :as library]
+    [blaze.elm.date-time :as date-time]
     [blaze.elm.expression :as expr]
     [blaze.fhir.operation.evaluate-measure.cql :as cql]
     [blaze.fhir.operation.evaluate-measure.cql-spec]
+    [blaze.fhir.spec.type.system :as system]
     [clojure.spec.alpha :as s]
     [clojure.spec.test.alpha :as st]
     [clojure.test :as test :refer [deftest is testing]]
@@ -37,7 +39,7 @@
   (OffsetDateTime/now ^Clock clock))
 
 
-(def cql
+(def cql-gender
   "library Retrieve
   using FHIR version '4.0.0'
   include FHIRHelpers version '4.0.0'
@@ -48,7 +50,20 @@
     Patient.gender = 'male'")
 
 
-(defn- compile-library [node]
+(def cql-error
+  "library Retrieve
+  using FHIR version '4.0.0'
+  include FHIRHelpers version '4.0.0'
+
+  parameter Year2022 Date
+
+  context Patient
+
+  define InInitialPopulation:
+    Year2022 - 2022 'years'")
+
+
+(defn- compile-library [node cql]
   (when-ok [library (cql-translator/translate cql)]
     (library/compile-library node library {})))
 
@@ -65,7 +80,7 @@
       [:put {:fhir/type :fhir/Patient :id "2" :gender #fhir/code"female"}]]]
     (let [context {:db (d/db node)
                    :now (now clock)
-                   :library (compile-library node)
+                   :library (compile-library node cql-gender)
                    :subject-type "Patient"
                    :report-type "population"}]
       (is (= 1 (cql/evaluate-expression context "InInitialPopulation")))))
@@ -76,13 +91,13 @@
       [[[:put {:fhir/type :fhir/Patient :id "0"}]]]
       (let [context {:db (d/db node)
                      :now (now clock)
-                     :library (compile-library node)
+                     :library (compile-library node cql-gender)
                      :subject-type "Patient"
                      :report-type "population"}]
         (with-redefs [expr/eval (failing-eval "msg-222453")]
           (given (cql/evaluate-expression context "InInitialPopulation")
             ::anom/category := ::anom/fault
-            ::anom/message := "msg-222453"))))))
+            ::anom/message := "Error while evaluating the expression `InInitialPopulation`: msg-222453"))))))
 
 
 (deftest evaluate-individual-expression-test
@@ -94,7 +109,7 @@
             patient (d/resource-handle db "Patient" "0")
             context {:db db
                      :now (now clock)
-                     :library (compile-library node)}]
+                     :library (compile-library node cql-gender)}]
         (is (true? (cql/evaluate-individual-expression context patient "InInitialPopulation"))))))
 
   (testing "no match"
@@ -105,8 +120,27 @@
             patient (d/resource-handle db "Patient" "0")
             context {:db db
                      :now (now clock)
-                     :library (compile-library node)}]
-        (is (false? (cql/evaluate-individual-expression context patient "InInitialPopulation")))))))
+                     :library (compile-library node cql-gender)}]
+        (is (false? (cql/evaluate-individual-expression context patient "InInitialPopulation"))))))
+
+  (testing "error"
+    (with-system-data [{:blaze.db/keys [node] :blaze.test/keys [clock]}
+                       mem-node-system]
+      [[[:put {:fhir/type :fhir/Patient :id "0"}]]]
+      (let [db (d/db node)
+            patient (d/resource-handle db "Patient" "0")
+            context {:db db
+                     :now (now clock)
+                     :library (compile-library node cql-error)
+                     :parameters {"Year2022" (system/date 2022)}}]
+        (given (cql/evaluate-individual-expression context patient "InInitialPopulation")
+          ::anom/category := ::anom/fault
+          ::anom/message := "Error while evaluating the expression `InInitialPopulation`: Year 0 out of range while subtracting the period Period[month = 24264, millis = 0] from the year 2022."
+          :fhir/issue := "exception"
+          :expression-name := "InInitialPopulation"
+          :op := :subtract
+          :year := (system/date 2022)
+          :period := (date-time/period 2022 0 0))))))
 
 
 (def two-value-eval
@@ -120,21 +154,21 @@
       [[[:put {:fhir/type :fhir/Patient :id "0"}]]]
       (let [context {:db (d/db node)
                      :now (now clock)
-                     :library (compile-library node)
+                     :library (compile-library node cql-gender)
                      :subject-type "Patient"
                      :report-type "population"}]
         (with-redefs [expr/eval (failing-eval "msg-221825")]
           (given (cql/calc-strata context "" "")
             ::anom/category := ::anom/fault
-            ::anom/message := "msg-221825")))))
+            ::anom/message := "Error while evaluating the expression ``: msg-221825")))))
 
   (testing "multiple values"
     (with-system-data [{:blaze.db/keys [node] :blaze.test/keys [clock]}
                        mem-node-system]
       [[[:put {:fhir/type :fhir/Patient :id "0"}]]]
       (let [context {:db (d/db node)
                      :now (now clock)
-                     :library (compile-library node)
+                     :library (compile-library node cql-gender)
                      :subject-type "Patient"
                      :report-type "population"}]
         (with-redefs [expr/eval two-value-eval]
@@ -157,4 +191,4 @@
     (with-redefs [expr/eval (failing-eval "msg-221154")]
       (given (cql/calc-individual-strata nil nil nil nil)
         ::anom/category := ::anom/fault
-        ::anom/message := "msg-221154"))))
+        ::anom/message := "Error while evaluating the expression `null`: msg-221154"))))