Cleanup Codes Evaluation in Retrieve Expression

In case the codes of a Retrieve expression were obtained from a Concept,
the source-property expression that get the codes of a Concept was
preserved until the clauses had to be calculated. Now the
source-property expression will evaluate the codes path on the static
Concept during compilation as other expressions also do. After the codes
expression is compiled, it's checked for holding a list of codes. So
only static codes expressions are supported now explicitly and an
appropriate exception is thrown otherwise.

Doing so ensures that the codes argument used in external-data is
actually a list of codes and so we also can calculate the query clauses
in a simple way.

That allowed to remove the record for the source-property expression. So
the codes is simpler and safer as before.

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

@@ -39,6 +39,9 @@
   (-form [_]
     `(~'code ~system ~version ~code)))
 
+(defn code? [x]
+  (instance? Code x))
+
 (defn code
   "Returns a CQL code with isn't the same as a FHIR code from the database."
   [system version code]

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

@@ -7,17 +7,15 @@
    [blaze.anomaly :as ba :refer [if-ok]]
    [blaze.coll.core :as coll]
    [blaze.db.api :as d]
+   [blaze.elm.code :refer [code?]]
    [blaze.elm.compiler.core :as core]
    [blaze.elm.compiler.macros :refer [reify-expr]]
    [blaze.elm.compiler.structured-values]
    [blaze.elm.resource :as cr]
    [blaze.elm.spec]
    [blaze.elm.util :as elm-util]
    [blaze.fhir.spec.references :as fsr]
-   [prometheus.alpha :as prom :refer [defcounter]])
-  (:import
-   [blaze.elm.compiler.structured_values SourcePropertyExpression]
-   [java.util List]))
+   [prometheus.alpha :as prom :refer [defcounter]]))
 
 (set! *warn-on-reflection* true)
 
@@ -29,31 +27,17 @@
 (defn- code->clause-value [{:keys [system code]}]
   (str system "|" code))
 
-(defprotocol ToClauses
-  (-to-clauses [x property]))
-
-(extend-protocol ToClauses
-  List
-  (-to-clauses [codes property]
-    [(into [property] (map code->clause-value) codes)])
-
-  SourcePropertyExpression
-  (-to-clauses [codes property]
-    (-to-clauses (core/-eval codes nil nil nil) property)))
-
 (defn- code-expr
   "Returns an expression which, when evaluated, returns all resources of type
   `data-type` which have a code equivalent to `code` at `property` and are
   reachable through `context`.
 
-  Uses special index attributes like :Patient.Observation.code/system|code.
-
   Example:
   * data-type - \"Observation\"
   * property - \"code\"
-  * codes - [(code/to-code \"http://loinc.org\" nil \"39156-5\")]"
+  * codes - [(code \"http://loinc.org\" nil \"39156-5\")]"
   [node context data-type property codes]
-  (let [clauses (-to-clauses codes property)
+  (let [clauses [(into [property] (map code->clause-value) codes)]
         query (d/compile-compartment-query node context data-type clauses)]
     (reify-expr core/Expression
       (-eval [_ {:keys [db]} {:keys [id]} _]
@@ -191,11 +175,22 @@
     :else
     (expr* node eval-context data-type code-property codes)))
 
+(defn- unsupported-dynamic-codes-expr-anom [codes-expr]
+  (ba/unsupported
+   (format "Unsupported dynamic codes expression `%s` in Retrieve expression."
+           (core/-form codes-expr))))
+
 (defn- unsupported-type-namespace-anom [type-ns]
   (ba/unsupported
    (format "Unsupported type namespace `%s` in Retrieve expression." type-ns)
    :type-ns type-ns))
 
+(defn- compile-codes-expr [context codes-expr]
+  (let [codes-expr (core/compile* context codes-expr)]
+    (if (and (sequential? codes-expr) (every? code? codes-expr))
+      codes-expr
+      (ba/throw-anom (unsupported-dynamic-codes-expr-anom codes-expr)))))
+
 (defmethod core/compile* :elm.compiler.type/retrieve
   [context
    {context-expr :context
@@ -210,5 +205,5 @@
        (some->> context-expr (core/compile* context))
        data-type
        code-property
-       (some->> codes-expr (core/compile* context)))
+       (some->> codes-expr (compile-codes-expr context)))
       (ba/throw-anom (unsupported-type-namespace-anom type-ns)))))

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

@@ -87,22 +87,16 @@
           (code/code system version code))))))
 
 ;; 2.3. Property
-(defrecord SourcePropertyExpression [source key]
-  core/Expression
-  (-static [_]
-    false)
-  (-attach-cache [expr _]
-    [(fn [] [expr])])
-  (-patient-count [_]
-    nil)
-  (-resolve-refs [_ expression-defs]
-    (->SourcePropertyExpression (core/-resolve-refs source expression-defs) key))
-  (-resolve-params [_ parameters]
-    (->SourcePropertyExpression (core/-resolve-params source parameters) key))
-  (-eval [_ context resource scope]
-    (p/get (core/-eval source context resource scope) key))
-  (-form [_]
-    `(~key ~(core/-form source))))
+(defn- source-property-expr [source key]
+  (reify-expr core/Expression
+    (-resolve-refs [_ expression-defs]
+      (source-property-expr (core/-resolve-refs source expression-defs) key))
+    (-resolve-params [_ parameters]
+      (source-property-expr (core/-resolve-params source parameters) key))
+    (-eval [_ context resource scope]
+      (p/get (core/-eval source context resource scope) key))
+    (-form [_]
+      `(~key ~(core/-form source)))))
 
 (defn- source-property-value-expr [source key]
   (reify-expr core/Expression
@@ -144,7 +138,10 @@
       source
       (if value?
         (source-property-value-expr (core/compile* context source) key)
-        (->SourcePropertyExpression (core/compile* context source) key))
+        (let [source (core/compile* context source)]
+          (if (core/static? source)
+            (p/get source key)
+            (source-property-expr source key))))
 
       scope
       (if value?

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

@@ -1,13 +1,12 @@
 (ns blaze.elm.code-spec
   (:require
    [blaze.elm.code :as code]
-   [clojure.spec.alpha :as s])
-  (:import
-   [blaze.elm.code Code]))
+   [clojure.spec.alpha :as s]))
 
-(defn code? [x]
-  (instance? Code x))
+(s/fdef code/code?
+  :args (s/cat :x any?)
+  :ret boolean?)
 
 (s/fdef code/code
   :args (s/cat :system string? :version (s/nilable string?) :code string?)
-  :ret code?)
+  :ret code/code?)

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

@@ -15,6 +15,7 @@
    [blaze.elm.compiler.test-util :as ctu :refer [has-form]]
    [blaze.elm.expression :as expr]
    [blaze.elm.expression-spec]
+   [blaze.elm.literal :as elm]
    [blaze.elm.util-spec]
    [blaze.fhir.spec :as fhir-spec]
    [blaze.fhir.spec.type]
@@ -418,7 +419,12 @@
 
           (given (ba/try-anomaly (c/compile context elm))
             ::anom/category := ::anom/not-found
-            ::anom/message := "The search-param with code `foo` and type `Medication` was not found.")))))
+            ::anom/message := "The search-param with code `foo` and type `Medication` was not found."))))
+
+    (testing "dynamic codes expression"
+      (given (ba/try-anomaly (c/compile {} #elm/retrieve{:type "Medication" :codes elm/today}))
+        ::anom/category := ::anom/unsupported
+        ::anom/message := "Unsupported dynamic codes expression `today` in Retrieve expression.")))
 
   (testing "with related context"
     (testing "without code"