diff --git a/.github/scripts/search-value-set-url-version.sh b/.github/scripts/search-value-set-url-version.sh new file mode 100755 index 000000000..7ccb7b05c --- /dev/null +++ b/.github/scripts/search-value-set-url-version.sh @@ -0,0 +1,34 @@ +#!/bin/bash +set -euo pipefail + +script_dir="$(dirname "$(readlink -f "$0")")" +. "$script_dir/util.sh" + +base="http://localhost:8080/fhir" +vs_url="http://example.com/fhir/ValueSet/$(uuidgen | tr '[:upper:]' '[:lower:]')" + +valueset() { +cat < - - - - - - \ No newline at end of file diff --git a/modules/db-protocols/src/blaze/db/impl/protocols.clj b/modules/db-protocols/src/blaze/db/impl/protocols.clj index dc49e7ecd..73d841e53 100644 --- a/modules/db-protocols/src/blaze/db/impl/protocols.clj +++ b/modules/db-protocols/src/blaze/db/impl/protocols.clj @@ -145,7 +145,7 @@ (-matcher [_ batch-db modifier compiled-values]) (-single-version-id-matcher [_ batch-db tid modifier compiled-values]) (-postprocess-matches - [search-param batch-db values compiled-values] + [search-param batch-db modifier values compiled-values] "Returns a transducer that will be applied on every matching resource-handle at the end of the query execution. Can also be used to finally remove unwanted matches.") diff --git a/modules/db/src/blaze/db/impl/codec.clj b/modules/db/src/blaze/db/impl/codec.clj index 0eb5414db..28e172c69 100644 --- a/modules/db/src/blaze/db/impl/codec.clj +++ b/modules/db/src/blaze/db/impl/codec.clj @@ -282,7 +282,9 @@ "series" "status" "subject" + "system:below" "url" + "url:below" "value-quantity" "variant-start" "version"])) diff --git a/modules/db/src/blaze/db/impl/index.clj b/modules/db/src/blaze/db/impl/index.clj index 040d0ea85..1bfdeb5f8 100644 --- a/modules/db/src/blaze/db/impl/index.clj +++ b/modules/db/src/blaze/db/impl/index.clj @@ -197,8 +197,8 @@ (let [f #(ordered-index-handles* batch-db tid % start-id)] (u/intersection-index-handles (map f conjunction)))))) -(defn- postprocess-matches** [batch-db [search-param _ values compiled-values]] - (p/-postprocess-matches search-param batch-db values compiled-values)) +(defn- postprocess-matches** [batch-db [search-param modifier values compiled-values]] + (p/-postprocess-matches search-param batch-db modifier values compiled-values)) (defn- postprocess-matches* [batch-db disjunction] (transduce (keep (partial postprocess-matches** batch-db)) comp disjunction)) diff --git a/modules/db/src/blaze/db/impl/search_param/chained.clj b/modules/db/src/blaze/db/impl/search_param/chained.clj index e560cd0db..d1930d4d9 100644 --- a/modules/db/src/blaze/db/impl/search_param/chained.clj +++ b/modules/db/src/blaze/db/impl/search_param/chained.clj @@ -173,7 +173,7 @@ nil (single-version-id-targets batch-db tid single-version-id ref-c-hash ref-tid))))) - (-postprocess-matches [_ _ _ _])) + (-postprocess-matches [_ _ _ _ _])) (defn- compile-ref-search-param-value "Compiles the value of the reference of `resource-handle` via diff --git a/modules/db/src/blaze/db/impl/search_param/composite/token_quantity.clj b/modules/db/src/blaze/db/impl/search_param/composite/token_quantity.clj index c09c90b45..7b8407dc3 100644 --- a/modules/db/src/blaze/db/impl/search_param/composite/token_quantity.clj +++ b/modules/db/src/blaze/db/impl/search_param/composite/token_quantity.clj @@ -84,7 +84,7 @@ (spq/single-version-id-matcher batch-db tid c-hash prefix-length compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [_ resolver resource] (when-ok [values (fhir-path/eval resolver main-expression resource)] diff --git a/modules/db/src/blaze/db/impl/search_param/composite/token_token.clj b/modules/db/src/blaze/db/impl/search_param/composite/token_token.clj index 245ff6278..029310340 100644 --- a/modules/db/src/blaze/db/impl/search_param/composite/token_token.clj +++ b/modules/db/src/blaze/db/impl/search_param/composite/token_token.clj @@ -68,7 +68,7 @@ (r-sp-v/single-version-id-value-prefix-filter (:snapshot batch-db) tid c-hash compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [_ resolver resource] (when-ok [values (fhir-path/eval resolver main-expression resource)] diff --git a/modules/db/src/blaze/db/impl/search_param/core.clj b/modules/db/src/blaze/db/impl/search_param/core.clj index c01737f84..a4b1d17f7 100644 --- a/modules/db/src/blaze/db/impl/search_param/core.clj +++ b/modules/db/src/blaze/db/impl/search_param/core.clj @@ -9,8 +9,8 @@ This multi-method is used to convert search parameters before storing them in the registry. Other namespaces can provide their own implementations here. - The `context` contains a :code-expression? function, a :canonical-expression? - function, a :terminology-service and an :index. + The `context` contains an :expression-type function, a :terminology-service + and an :index. The conversion can return an anomaly." {:arglists '([context definition])} diff --git a/modules/db/src/blaze/db/impl/search_param/date.clj b/modules/db/src/blaze/db/impl/search_param/date.clj index 13a4319c3..18979e977 100644 --- a/modules/db/src/blaze/db/impl/search_param/date.clj +++ b/modules/db/src/blaze/db/impl/search_param/date.clj @@ -445,7 +445,7 @@ (-single-version-id-matcher [_ batch-db tid _ compiled-values] (single-version-id-matcher batch-db tid c-hash compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [search-param resolver resource] (when-ok [values (fhir-path/eval resolver expression resource)] @@ -676,7 +676,7 @@ (-single-version-id-matcher [search-param batch-db tid modifier compiled-values] (u/single-version-id-matcher search-param batch-db tid modifier compiled-values)) - (-postprocess-matches [_ batch-db _ compiled-values] + (-postprocess-matches [_ batch-db _ _ compiled-values] (last-updated-matcher batch-db compiled-values)) ;; The _lastUpdated search parameter is queried over the TypeAsOf index, so diff --git a/modules/db/src/blaze/db/impl/search_param/has.clj b/modules/db/src/blaze/db/impl/search_param/has.clj index 6b2bbb4ed..082afbfe9 100644 --- a/modules/db/src/blaze/db/impl/search_param/has.clj +++ b/modules/db/src/blaze/db/impl/search_param/has.clj @@ -148,7 +148,7 @@ (-single-version-id-matcher [search-param batch-db tid modifier compiled-values] (u/single-version-id-matcher search-param batch-db tid modifier compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [_ _ _] [])) diff --git a/modules/db/src/blaze/db/impl/search_param/list.clj b/modules/db/src/blaze/db/impl/search_param/list.clj index 413cfff98..74d86f6c2 100644 --- a/modules/db/src/blaze/db/impl/search_param/list.clj +++ b/modules/db/src/blaze/db/impl/search_param/list.clj @@ -90,7 +90,7 @@ (-ordered-compartment-index-handles [_ _ _ _ _ _ _] (ba/unsupported)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [_ _ _] [])) diff --git a/modules/db/src/blaze/db/impl/search_param/near.clj b/modules/db/src/blaze/db/impl/search_param/near.clj index 1f1b21ac3..6e7d73581 100644 --- a/modules/db/src/blaze/db/impl/search_param/near.clj +++ b/modules/db/src/blaze/db/impl/search_param/near.clj @@ -182,7 +182,7 @@ (-single-version-id-matcher [search-param batch-db tid modifier compiled-values] (u/single-version-id-matcher search-param batch-db tid modifier compiled-values)) - (-postprocess-matches [_ batch-db _ compiled-values] + (-postprocess-matches [_ batch-db _ _ compiled-values] (postprocess-matches-xf batch-db compiled-values)) (-index-values [_ _ _] diff --git a/modules/db/src/blaze/db/impl/search_param/number.clj b/modules/db/src/blaze/db/impl/search_param/number.clj index b2690bc5a..6996ce2cb 100644 --- a/modules/db/src/blaze/db/impl/search_param/number.clj +++ b/modules/db/src/blaze/db/impl/search_param/number.clj @@ -99,7 +99,7 @@ (-single-version-id-matcher [_ batch-db tid _ compiled-values] (spq/single-version-id-matcher batch-db tid c-hash 0 compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [search-param resolver resource] (when-ok [values (fhir-path/eval resolver expression resource)] diff --git a/modules/db/src/blaze/db/impl/search_param/quantity.clj b/modules/db/src/blaze/db/impl/search_param/quantity.clj index 01d0d9532..15fe097d7 100644 --- a/modules/db/src/blaze/db/impl/search_param/quantity.clj +++ b/modules/db/src/blaze/db/impl/search_param/quantity.clj @@ -298,7 +298,7 @@ (single-version-id-matcher batch-db tid c-hash codec/v-hash-size compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [search-param resolver resource] (when-ok [values (fhir-path/eval resolver expression resource)] diff --git a/modules/db/src/blaze/db/impl/search_param/string.clj b/modules/db/src/blaze/db/impl/search_param/string.clj index 93e0b9ded..80597e0ba 100644 --- a/modules/db/src/blaze/db/impl/search_param/string.clj +++ b/modules/db/src/blaze/db/impl/search_param/string.clj @@ -116,7 +116,7 @@ (r-sp-v/single-version-id-value-prefix-filter (:snapshot batch-db) tid c-hash compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [search-param resolver resource] (when-ok [values (fhir-path/eval resolver expression resource)] diff --git a/modules/db/src/blaze/db/impl/search_param/token.clj b/modules/db/src/blaze/db/impl/search_param/token.clj index b0c71157c..99cd5aa73 100644 --- a/modules/db/src/blaze/db/impl/search_param/token.clj +++ b/modules/db/src/blaze/db/impl/search_param/token.clj @@ -153,6 +153,18 @@ (codec/c-hash (str code ":" modifier)) c-hash)) +(defn- canonical-url-modifier + "Maps the `below` modifier to `nil` for `:canonical-url` search params + (e.g. `ValueSet.url`), since those below-queries probe the plain unversioned + index and never had dedicated below index entries. Leaves the modifier + unchanged for any other `expression-type`, in particular `:canonical` + (combined `url|version` string params like `depends-on`), whose below index + entries do exist and still use the `below` c-hash." + [expression-type modifier] + (if (and (= :canonical-url expression-type) (= "below" modifier)) + nil + modifier)) + (defn index-handles "Returns a reducible collection of index handles that have `value` starting at `start-id` (optional)." @@ -206,13 +218,66 @@ (defn- expand-value-set-msg [url cause-msg] (format "Error while expanding the ValueSet `%s`. Cause: %s" url cause-msg)) +(defn- version-prefix-match? + "Returns true if the `wanted` version matches the `stored` version either + exactly or as a dotted version prefix. + + Implements the FHIR R4 `:below` version-prefix rule (§3.1.1.4.13): a search + version like `1` or `1.2` matches stored versions `1.0.0`, `1.2.3` etc., while + `1.2.3` matches only `1.2.3`. The trailing `.` guard prevents `1` from + matching `10.0`." + [wanted stored] + (or (= wanted stored) (str/starts-with? stored (str wanted ".")))) + +(def ^:private noop-resolver + (reify fhir-path/Resolver (-resolve [_ _]))) + +(defn- parse-canonical-value + "Splits a raw canonical search `value` into an `[url version]` pair, with + `version` nil when `value` carries no `|version` suffix." + [value] + (if-let [idx (str/index-of value "|")] + [(subs value 0 idx) (subs value (inc idx))] + [value nil])) + +(defn- version-matches? + "Tests a `stored` version against a `wanted` version, using exact equality + for the `nil` (default) modifier and dotted version-prefix matching (FHIR + R4 §3.1.1.4.13) for the `below` modifier." + [modifier wanted stored] + (if (= "below" modifier) + (version-prefix-match? wanted stored) + (= wanted stored))) + +(defn- matches-canonical-value? + "Returns true if the resource behind `resource-handle` has a stored + `.url`/`.version` pair (per `expression`/`version-expression`) matching one + of the `wanted` `[url version]` pairs, honoring `modifier`. + + A `nil` version in a wanted pair matches any stored version. A non-nil + wanted version only matches if the resource has a stored version, tested + via `version-matches?`. + + Pulls the resource via `batch-db`. Used to post-filter the candidates of a + versioned canonical url search, since versions are not held in the index." + [batch-db expression version-expression modifier wanted resource-handle] + (let [resource @(d/pull batch-db resource-handle) + urls (keep :value (fhir-path/eval noop-resolver expression resource)) + stored-versions (delay (keep :value (fhir-path/eval noop-resolver version-expression resource)))] + (some + (fn [[wanted-url wanted-version]] + (and (some #(= wanted-url %) urls) + (or (nil? wanted-version) + (some #(version-matches? modifier wanted-version %) @stored-versions)))) + wanted))) + (defrecord SearchParamToken [compile-value-set-cache name url type base code - target c-hash expression code-expression? canonical-expression?] + target c-hash expression expression-type version-expression] p/SearchParam (-validate-modifier [_ modifier] (condp = type "uri" - (when-not (and canonical-expression? (#{"below"} modifier)) + (when-not (and (#{:canonical :canonical-url} expression-type) (#{"below"} modifier)) (some->> modifier (u/modifier-anom fhir-uri-modifier code))) "token" (when-not (#{"in"} modifier) @@ -235,11 +300,14 @@ (ac/exceptionally (fn [anom] (ba/fault (expand-value-set-msg value (::anom/message anom)))))) + (= :canonical-url expression-type) + (ac/completed-future + (codec/v-hash (if-let [idx (str/index-of value "|")] (subs value 0 idx) value))) :else (ac/completed-future (codec/v-hash value)))) (-estimated-scan-size [_ batch-db tid modifier compiled-value] - (let [c-hash (c-hash-w-modifier c-hash code modifier)] + (let [c-hash (c-hash-w-modifier c-hash code (canonical-url-modifier expression-type modifier))] (sp-vr/estimated-scan-size (:kv-store batch-db) c-hash tid compiled-value))) (-supports-ordered-index-handles [_ _ _ _ _] @@ -267,18 +335,18 @@ (u/union-index-handles (map index-handles compiled-values)))))) (-index-handles [_ batch-db tid modifier compiled-value] - (index-handles batch-db (c-hash-w-modifier c-hash code modifier) tid + (index-handles batch-db (c-hash-w-modifier c-hash code (canonical-url-modifier expression-type modifier)) tid compiled-value)) (-index-handles [_ batch-db tid modifier compiled-value start-id] - (index-handles batch-db (c-hash-w-modifier c-hash code modifier) tid + (index-handles batch-db (c-hash-w-modifier c-hash code (canonical-url-modifier expression-type modifier)) tid compiled-value start-id)) (-supports-ordered-compartment-index-handles [_ modifier values] ;; the CompartmentSearchParamValueResource index only contains values with ;; or values of type :fhir/code ;; with in-modifier, a ValueSet expansion contains always systems - (or code-expression? (every? has-system? values) (= "in" modifier))) + (or (= :code expression-type) (every? has-system? values) (= "in" modifier))) (-ordered-compartment-index-handles [search-param batch-db compartment tid modifier compiled-values] (if (= "in" modifier) @@ -301,15 +369,19 @@ (-matcher [_ batch-db modifier compiled-values] (r-sp-v/value-prefix-filter - (:snapshot batch-db) (c-hash-w-modifier c-hash code modifier) + (:snapshot batch-db) (c-hash-w-modifier c-hash code (canonical-url-modifier expression-type modifier)) compiled-values)) (-single-version-id-matcher [_ batch-db tid modifier compiled-values] (r-sp-v/single-version-id-value-prefix-filter - (:snapshot batch-db) tid (c-hash-w-modifier c-hash code modifier) + (:snapshot batch-db) tid (c-hash-w-modifier c-hash code (canonical-url-modifier expression-type modifier)) compiled-values)) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ batch-db modifier values _] + (when (and (= :canonical-url expression-type) (some #(str/includes? % "|") values)) + (let [wanted (into #{} (map parse-canonical-value) values)] + (filter (partial matches-canonical-value? batch-db expression + version-expression modifier wanted))))) (-compartment-ids [_ resolver resource] (when-ok [values (fhir-path/eval resolver expression resource)] @@ -324,15 +396,12 @@ values))) (-index-values [search-param resolver resource] - (when-ok [values (fhir-path/eval resolver expression resource)] - (coll/eduction (p/-index-value-compiler search-param) values))) + (when-ok [url-values (fhir-path/eval resolver expression resource)] + (coll/eduction (p/-index-value-compiler search-param) url-values))) (-index-value-compiler [_] (mapcat (partial index-entries url)))) -(def ^:private noop-resolver - (reify fhir-path/Resolver (-resolve [_ _]))) - (defn- identifier-values [{{:keys [value]} :value {system :value} :system}] (cond-> [] value @@ -405,7 +474,7 @@ (:snapshot batch-db) tid (c-hash-w-modifier c-hash code modifier) compiled-values)) - (-postprocess-matches [_ batch-db values _] + (-postprocess-matches [_ batch-db _ values _] (filter (partial matches-identifier-values? batch-db expression (set values)))) (-compartment-ids [_ _ _]) @@ -483,7 +552,7 @@ pred (comp ids :id)] (filter pred))) - (-postprocess-matches [_ _ _ _]) + (-postprocess-matches [_ _ _ _ _]) (-index-values [_ _ _])) @@ -498,19 +567,19 @@ expression)) (defmethod sc/search-param "token" - [{:keys [terminology-service code-expression?]} + [{:keys [terminology-service expression-type]} {:keys [name url type base code target expression]}] (if (= "_id" code) (->SearchParamId "_id" "id" "_id") (if expression - (let [code-expression? (code-expression? expression)] + (let [expr-type (expression-type expression)] (when-ok [expression (fhir-path/compile (fix-expr url expression))] (if (= "identifier" code) (->SearchParamTokenIdentifier name url type base code target (codec/c-hash code) expression) (->SearchParamToken (compile-value-set-cache terminology-service) name url type base code target - (codec/c-hash code) expression code-expression? false)))) + (codec/c-hash code) expression expr-type nil)))) (ba/unsupported (u/missing-expression-msg url))))) (defmethod sc/search-param "reference" @@ -519,16 +588,38 @@ (when-ok [expression (fhir-path/compile expression)] (->SearchParamToken (compile-value-set-cache terminology-service) name url type base code target - (codec/c-hash code) expression false false)) + (codec/c-hash code) expression nil nil)) (ba/unsupported (u/missing-expression-msg url)))) +(defn- url->version-expression + "Derives a FHIRPath version expression from a canonical-URL expression by + replacing the trailing `.url` of each union branch with `.version`. + + Uses the FHIRPath parser to split the expression at the top-level `|` union + operator, so a `|` inside a string literal is left alone. The replacement + is anchored to the `.url` suffix of each branch so that a `.url` substring + elsewhere in a path is never touched. + + Example: \"CapabilityStatement.url | ValueSet.url\" + -> \"CapabilityStatement.version | ValueSet.version\"" + [expression] + (when-ok [branches (fhir-path/union-paths expression)] + (->> branches + (map #(str/replace % #"\.url$" ".version")) + (str/join " | ")))) + (defmethod sc/search-param "uri" - [{:keys [terminology-service canonical-expression?]} + [{:keys [terminology-service expression-type]} {:keys [name url type base code target expression]}] (if expression - (let [canonical-expression? (canonical-expression? expression)] - (when-ok [expression (fhir-path/compile expression)] + (let [expr-type (expression-type expression)] + (when-ok [compiled-expression (fhir-path/compile expression) + version-expression (when (= :canonical-url expr-type) + (url->version-expression expression)) + compiled-version-expression (when (some? version-expression) + (fhir-path/compile version-expression))] (->SearchParamToken (compile-value-set-cache terminology-service) name url type base code target - (codec/c-hash code) expression false canonical-expression?))) + (codec/c-hash code) compiled-expression expr-type + compiled-version-expression))) (ba/unsupported (u/missing-expression-msg url)))) diff --git a/modules/db/src/blaze/db/search_param_registry.clj b/modules/db/src/blaze/db/search_param_registry.clj index be9374d3a..80c656671 100644 --- a/modules/db/src/blaze/db/search_param_registry.clj +++ b/modules/db/src/blaze/db/search_param_registry.clj @@ -8,6 +8,7 @@ [blaze.db.impl.search-param.chained :as spc] [blaze.db.impl.search-param.core :as sc] [blaze.db.search-param-registry.spec] + [blaze.fhir-path :as fhir-path] [blaze.fhir.structure-definition-repo :as sdr] [blaze.module :as m] [blaze.util :refer [conj-vec str]] @@ -345,6 +346,22 @@ (nil? (get-in index [type "patient"])) #{"subject"} :else #{"subject" "patient"}))) +(defn expression-type + "Categorizes `expr` by looking up each union-branch path in + `expression-types` (the result of `sdr/expression-types`). All branches + must categorize the same way; returns nil when they differ or when the + expression does not parse. + + An expression may be a `|`-separated union of paths (e.g. the `depends-on` + or `conformance-url` search parameters). All branches must categorize the + same way for the union to inherit the category." + [expression-types expr] + (let [paths (fhir-path/union-paths expr)] + (when-not (ba/anomaly? paths) + (let [kinds (into #{} (map expression-types) paths)] + (when (= 1 (count kinds)) + (first kinds)))))) + (defmethod m/pre-init-spec :blaze.db/search-param-registry [_] (s/keys :req-un [:blaze.fhir/structure-definition-repo :blaze/terminology-service] :opt-un [::extra-bundle-file])) @@ -357,8 +374,8 @@ (str " including extra search parameters from file: " extra-bundle-file))) (let [entries (read-bundle-entries extra-bundle-file) patient-compartment (read-classpath-json-resource "blaze/db/compartment/patient.json") - context {:code-expression? (sdr/code-expressions structure-definition-repo) - :canonical-expression? (sdr/canonical-expressions structure-definition-repo) + expression-types (sdr/expression-types structure-definition-repo) + context {:expression-type (partial expression-type expression-types) :terminology-service terminology-service}] (if-ok [{url-index :index} (build-url-index context entries)] (let [index (build-index url-index entries) diff --git a/modules/db/src/blaze/db/search_param_registry_spec.clj b/modules/db/src/blaze/db/search_param_registry_spec.clj index efcc13ed4..637f84d8a 100644 --- a/modules/db/src/blaze/db/search_param_registry_spec.clj +++ b/modules/db/src/blaze/db/search_param_registry_spec.clj @@ -44,6 +44,11 @@ :ret (s/or :compartments (s/coll-of (s/tuple string? :blaze.resource/id)) :anomaly ::anom/anomaly)) +(s/fdef sr/expression-type + :args (s/cat :expression-types (s/map-of string? keyword?) + :expr string?) + :ret (s/nilable keyword?)) + (s/fdef sr/compartment-resources :args (s/cat :search-param-registry :blaze.db/search-param-registry :compartment-type :fhir.resource/type diff --git a/modules/db/test/blaze/db/api_test.clj b/modules/db/test/blaze/db/api_test.clj index a433b2315..65b69e757 100644 --- a/modules/db/test/blaze/db/api_test.clj +++ b/modules/db/test/blaze/db/api_test.clj @@ -419,7 +419,7 @@ [meta :blaze.db/op] := :put [:birthDate :extension 0 :url] := "foo" [:birthDate :extension 0 :value] := #fhir/code "bar" - [:birthDate :value] := #system/date"2022")))) + [:birthDate :value] := #system/date "2022")))) (testing "one Patient with one Observation" (with-system-data [{:blaze.db/keys [node]} config] @@ -4737,6 +4737,99 @@ [0 :id] := "id-0" [1 :id] := "id-1")))) +(deftest type-query-value-set-url-test + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/ValueSet :id "id-0" + :url #fhir/uri "http://example.com/vs-091902" + :version #fhir/string "1.0.0" + :status #fhir/code "active"}] + [:put {:fhir/type :fhir/ValueSet :id "id-1" + :url #fhir/uri "http://example.com/vs-091902" + :version #fhir/string "2.4.1" + :status #fhir/code "active"}] + [:put {:fhir/type :fhir/ValueSet :id "id-2" + :url #fhir/uri "http://example.com/vs-091902" + :version #fhir/string "2.7.3" + :status #fhir/code "active"}] + [:put {:fhir/type :fhir/ValueSet :id "id-3" + :url #fhir/uri "http://example.com/vs-other" + :version #fhir/string "1.0.0" + :status #fhir/code "active"}] + [:put {:fhir/type :fhir/ValueSet :id "id-4" + :url #fhir/uri "http://example.com/vs-091902" + :status #fhir/code "active"}]]] + + (testing "url" + (testing "exact match without version finds all versions" + (given-type-query node "ValueSet" [["url" "http://example.com/vs-091902"]] + count := 4 + [0 :id] := "id-0" + [1 :id] := "id-1" + [2 :id] := "id-2" + [3 :id] := "id-4")) + + (testing "exact match with version finds only matching version" + (given-type-query node "ValueSet" [["url" "http://example.com/vs-091902|1.0.0"]] + count := 1 + [0 :id] := "id-0")) + + (testing "exact match with wrong version finds nothing" + (given-type-query node "ValueSet" [["url" "http://example.com/vs-091902|9.9.9"]] + count := 0)) + + (testing "below with URL only matches all versions" + (given-type-query node "ValueSet" [["url:below" "http://example.com/vs-091902"]] + count := 4 + [0 :id] := "id-0" + [1 :id] := "id-1" + [2 :id] := "id-2" + [3 :id] := "id-4")) + + (testing "below with URL and major version 1" + (given-type-query node "ValueSet" [["url:below" "http://example.com/vs-091902|1"]] + count := 1 + [0 :id] := "id-0")) + + (testing "below with URL and major version 2" + (given-type-query node "ValueSet" [["url:below" "http://example.com/vs-091902|2"]] + count := 2 + [0 :id] := "id-1" + [1 :id] := "id-2")) + + (testing "below with URL and minor version 2.4" + (given-type-query node "ValueSet" [["url:below" "http://example.com/vs-091902|2.4"]] + count := 1 + [0 :id] := "id-1")) + + (testing "below with URL and patch version 2.4.1" + (given-type-query node "ValueSet" [["url:below" "http://example.com/vs-091902|2.4.1"]] + count := 1 + [0 :id] := "id-1")) + + (testing "below with URL and non-matching major version 3" + (given-type-query node "ValueSet" [["url:below" "http://example.com/vs-091902|3"]] + count := 0)) + + (testing "resource without version is NOT found by versioned exact url" + (given-type-query node "ValueSet" [["url" "http://example.com/vs-091902|1.0.0"]] + count := 1 + [0 :id] := "id-0")) + + (testing "mixed values: one unversioned, one exact versioned" + (given-type-query node "ValueSet" + [["url" "http://example.com/vs-other" "http://example.com/vs-091902|2.4.1"]] + count := 2 + [0 :id] := "id-1" + [1 :id] := "id-3")) + + (testing "mixed values: one unversioned, one below with major version" + (given-type-query node "ValueSet" + [["url:below" "http://example.com/vs-other" "http://example.com/vs-091902|2"]] + count := 3 + [0 :id] := "id-1" + [1 :id] := "id-2" + [2 :id] := "id-3"))))) + (deftest type-query-observation-code-value-quantity-test (with-system-data [{:blaze.db/keys [node]} config] [[[:put {:fhir/type :fhir/Observation :id "id-0" diff --git a/modules/db/test/blaze/db/impl/search_param/token_test.clj b/modules/db/test/blaze/db/impl/search_param/token_test.clj index add7a1903..b3a39716f 100644 --- a/modules/db/test/blaze/db/impl/search_param/token_test.clj +++ b/modules/db/test/blaze/db/impl/search_param/token_test.clj @@ -162,6 +162,65 @@ :code := "_profile:below" :v-hash := (codec/v-hash "uri-091902|2.3"))))) + (testing "ValueSet url without version" + (let [value-set + {:fhir/type :fhir/ValueSet :id "id-094531" + :url #fhir/uri "http://example.com/vs-105914"} + hash (hash/generate value-set) + entries (into [] (index-entries (sr/get search-param-registry "url" "ValueSet") + [] hash value-set)) + [_ k0] (nth entries 0) + [_ k1] (nth entries 1)] + + (testing "produces a single exact unversioned url index entry (no below entry)" + (is (= 2 (count entries)))) + + (testing "SearchParamValueResource key is exact unversioned url" + (given (sp-vr-tu/decode-key-human (bb/wrap k0)) + :code := "url" + :type := "ValueSet" + :v-hash := (codec/v-hash "http://example.com/vs-105914") + :id := "id-094531" + :hash-prefix := (hash/prefix hash))) + + (testing "ResourceSearchParamValue key is exact unversioned url" + (given (r-sp-v-tu/decode-key-human (bb/wrap k1)) + :type := "ValueSet" + :id := "id-094531" + :hash-prefix := (hash/prefix hash) + :code := "url" + :v-hash := (codec/v-hash "http://example.com/vs-105914"))))) + + (testing "ValueSet url with version" + (let [value-set + {:fhir/type :fhir/ValueSet :id "id-104832" + :url #fhir/uri "http://example.com/vs-105914" + :version #fhir/string "1.2.3"} + hash (hash/generate value-set) + entries (into [] (index-entries (sr/get search-param-registry "url" "ValueSet") + [] hash value-set)) + [_ k0] (nth entries 0) + [_ k1] (nth entries 1)] + + (testing "produces a single exact unversioned url index entry, identical to the unversioned case (version handling moved to postprocess)" + (is (= 2 (count entries)))) + + (testing "SearchParamValueResource key is exact unversioned url" + (given (sp-vr-tu/decode-key-human (bb/wrap k0)) + :code := "url" + :type := "ValueSet" + :v-hash := (codec/v-hash "http://example.com/vs-105914") + :id := "id-104832" + :hash-prefix := (hash/prefix hash))) + + (testing "ResourceSearchParamValue key is exact unversioned url" + (given (r-sp-v-tu/decode-key-human (bb/wrap k1)) + :type := "ValueSet" + :id := "id-104832" + :hash-prefix := (hash/prefix hash) + :code := "url" + :v-hash := (codec/v-hash "http://example.com/vs-105914"))))) + (testing "Observation code" (let [observation {:fhir/type :fhir/Observation @@ -799,10 +858,10 @@ (defn profile-param [search-param-registry] (sr/get search-param-registry "_profile" "Observation")) -(defn- uri-url-param [search-param-registry] +(defn- canonical-url-param [search-param-registry] (sr/get search-param-registry "url" "CapabilityStatement")) -(defn- url-param [search-param-registry] +(defn- non-canonical-url-param [search-param-registry] (sr/get search-param-registry "url" "Subscription")) (deftest validate-modifier-test @@ -843,13 +902,11 @@ (testing "implemented modifier" (is (nil? (search-param/validate-modifier (profile-param search-param-registry) "below")))) - (testing "modifier below not implemented on uri type" - (given (search-param/validate-modifier (uri-url-param search-param-registry) "below") - ::anom/category := ::anom/unsupported - ::anom/message := "Unsupported modifier `below` on search parameter `url`.")) + (testing "below implemented for canonical-url params" + (is (nil? (search-param/validate-modifier (canonical-url-param search-param-registry) "below")))) - (testing "modifier below not implemented on url type" - (given (search-param/validate-modifier (url-param search-param-registry) "below") + (testing "below not implemented for non-canonical url params" + (given (search-param/validate-modifier (non-canonical-url-param search-param-registry) "below") ::anom/category := ::anom/unsupported ::anom/message := "Unsupported modifier `below` on search parameter `url`."))) diff --git a/modules/db/test/blaze/db/impl/search_param_test.clj b/modules/db/test/blaze/db/impl/search_param_test.clj index 7df248baa..8138bf751 100644 --- a/modules/db/test/blaze/db/impl/search_param_test.clj +++ b/modules/db/test/blaze/db/impl/search_param_test.clj @@ -1,5 +1,6 @@ (ns blaze.db.impl.search-param-test (:require + [blaze.anomaly :as ba] [blaze.async.comp :as ac] [blaze.byte-buffer :as bb] [blaze.db.impl.codec :as codec] @@ -11,6 +12,8 @@ [blaze.db.impl.search-param-spec] [blaze.db.impl.search-param.core :as sc] [blaze.db.search-param-registry :as sr] + [blaze.db.search-param-registry-spec] + [blaze.fhir-path :as fhir-path] [blaze.fhir.hash :as hash] [blaze.fhir.hash-spec] [blaze.fhir.test-util :refer [structure-definition-repo]] @@ -18,7 +21,7 @@ [blaze.terminology-service :as-alias ts] [blaze.terminology-service-spec] [blaze.terminology-service.not-available] - [blaze.test-util :as tu] + [blaze.test-util :as tu :refer [given-thrown]] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [deftest is testing]] [cognitect.anomalies :as anom] @@ -39,11 +42,50 @@ (testing "invalid expression" (doseq [type ["date" "number" "quantity" "reference" "string" "token" "uri"]] - (given (sc/search-param {:code-expression? (constantly false) - :canonical-expression? (constantly false)} + (given (sc/search-param {:expression-type (constantly nil)} {:type type :expression ""}) ::anom/category := ::anom/fault - ::anom/message := "Error while parsing token `` in expression ``")))) + ::anom/message := "Error while parsing token `` in expression ``"))) + + (testing "expression-type returns nil when union-paths returns anomaly" + (is (nil? (sr/expression-type {} "Patient.")))) + + (testing "expression-type returns kind for valid expression" + (is (= :canonical-url (sr/expression-type {"ValueSet.url" :canonical-url} "ValueSet.url")))) + + (testing "expression-type args spec rejects a non-keyword value in the expression-types map" + (given-thrown (sr/expression-type {"ValueSet.url" "not-a-keyword"} "ValueSet.url") + :clojure.spec.alpha/failure := :instrument)) + + (testing "uri canonical-url expression-type with bad expression returns compile anomaly" + (given (sc/search-param {:expression-type (constantly :canonical-url) + :terminology-service nil} + {:type "uri" :name "url" :base ["ValueSet"] :code "url" + :expression "Patient."}) + ::anom/category := ::anom/fault)) + + (testing "uri canonical-url expression-type with union-paths anomaly in derived version-expression" + (with-redefs [fhir-path/union-paths (fn [_] (ba/fault "union-paths-boom-165230"))] + (given (sc/search-param {:expression-type (constantly :canonical-url) + :terminology-service nil} + {:type "uri" :name "url" :base ["ValueSet"] :code "url" + :expression "ValueSet.url"}) + ::anom/category := ::anom/fault + ::anom/message := "union-paths-boom-165230"))) + + (testing "uri canonical-url expression-type with version-expression compile failure" + (let [real-compile fhir-path/compile] + (with-redefs [fhir-path/compile + (fn [expr] + (if (= expr "ValueSet.version") + (ba/fault "version-expression-compile-boom-165402") + (real-compile expr)))] + (given (sc/search-param {:expression-type (constantly :canonical-url) + :terminology-service nil} + {:type "uri" :name "url" :base ["ValueSet"] :code "url" + :expression "ValueSet.url"}) + ::anom/category := ::anom/fault + ::anom/message := "version-expression-compile-boom-165402"))))) (defn birthdate [search-param-registry] (sr/get search-param-registry "birthdate" "Patient")) diff --git a/modules/fhir-path/.clj-kondo/config.edn b/modules/fhir-path/.clj-kondo/config.edn index 5c91fa420..f36151cb1 100644 --- a/modules/fhir-path/.clj-kondo/config.edn +++ b/modules/fhir-path/.clj-kondo/config.edn @@ -1,5 +1,6 @@ {:config-paths - ["../../../.clj-kondo/root"] + ["../../../.clj-kondo/root" + "../../anomaly/resources/clj-kondo.exports/blaze/anomaly"] :linters {:a diff --git a/modules/fhir-path/src/blaze/fhir_path.clj b/modules/fhir-path/src/blaze/fhir_path.clj index 46de9ae5a..59b06dbc0 100644 --- a/modules/fhir-path/src/blaze/fhir_path.clj +++ b/modules/fhir-path/src/blaze/fhir_path.clj @@ -1,7 +1,7 @@ (ns blaze.fhir-path (:refer-clojure :exclude [compile eval resolve str]) (:require - [blaze.anomaly :as ba :refer [throw-anom]] + [blaze.anomaly :as ba :refer [throw-anom when-ok]] [blaze.coll.core :as coll] [blaze.fhir.spec :as fhir-spec] [blaze.fhir.spec.type.system :as system] @@ -572,20 +572,48 @@ (when-let [^TerminalNode node (.getChild ctx 0)] (.getText (.getSymbol node))))) -(defn compile - "Compiles the FHIRPath `expr`. - - Returns either a compiled FHIRPath expression or an anomaly in case of errors." - [expr] +(defn- parser + "Creates an ANTLR FHIRPath parser for `expr` with error listeners removed." + ^fhirpathParser [^String expr] (let [r (StringReader. expr) s (CharStreams/fromReader r) l (fhirpathLexer. s) t (CommonTokenStream. l) p (fhirpathParser. t)] - ;; if not removed, it will print errors on console (.removeErrorListeners l) (.removeErrorListeners p) - (-> (ba/try-anomaly (-compile (.expression p))) - (ba/exceptionally - #(-> (update % ::anom/message str (format " in expression `%s`" expr)) - (assoc :expression expr)))))) + p)) + +(defn compile + "Compiles the FHIRPath `expr`. + + Returns either a compiled FHIRPath expression or an anomaly in case of errors." + [expr] + (-> (ba/try-anomaly (-compile (.expression (parser expr)))) + (ba/exceptionally + #(-> (update % ::anom/message str (format " in expression `%s`" expr)) + (assoc :expression expr))))) + +(defn- parse + "Parses the FHIRPath `expr` and returns its root expression context. + + Callers have to detect parse errors themselves, e.g. by compiling `expr` + first." + [expr] + (.expression (parser expr))) + +(defn union-paths + "Splits `expr` at the top-level FHIRPath union operator `|` and returns the + textual source of each branch with surrounding whitespace trimmed. + + A non-union expression is returned as a single-element vector. Returns an + anomaly if `expr` does not parse as FHIRPath." + [expr] + (when-ok [_ (compile expr)] + (let [root (parse expr)] + (letfn [(path [^fhirpathParser$ExpressionContext ctx] + (if (instance? fhirpathParser$UnionExpressionContext ctx) + (let [[e1 e2] (.expression ^fhirpathParser$UnionExpressionContext ctx)] + (into (path e1) (path e2))) + [(str/trim (.getText ctx))]))] + (path root))))) diff --git a/modules/fhir-path/src/blaze/fhir_path_spec.clj b/modules/fhir-path/src/blaze/fhir_path_spec.clj index 4c619796c..cc29aeb65 100644 --- a/modules/fhir-path/src/blaze/fhir_path_spec.clj +++ b/modules/fhir-path/src/blaze/fhir_path_spec.clj @@ -23,3 +23,7 @@ (s/fdef fhir-path/compile :args (s/cat :expr string?) :ret (s/or :expr :blaze.fhir-path/expression :anomaly ::anom/anomaly)) + +(s/fdef fhir-path/union-paths + :args (s/cat :expr string?) + :ret (s/or :paths (s/coll-of string? :kind vector?) :anomaly ::anom/anomaly)) diff --git a/modules/fhir-path/test/blaze/fhir_path_test.clj b/modules/fhir-path/test/blaze/fhir_path_test.clj index ecffb7acb..4e9c84c1e 100644 --- a/modules/fhir-path/test/blaze/fhir_path_test.clj +++ b/modules/fhir-path/test/blaze/fhir_path_test.clj @@ -7,6 +7,7 @@ [blaze.fhir-path-spec] [blaze.fhir.test-util] [blaze.test-util :as tu :refer [satisfies-prop]] + [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [are deftest is testing]] [clojure.test.check.generators :as gen] @@ -602,3 +603,30 @@ "'1' + Patient.id" ["10"] "Patient.id + {}" [] "{} + Patient.id" []))) + +;; union-paths + +(deftest union-paths-test + (testing "single path is returned as a one-element vector" + (is (= ["Patient.gender"] (fhir-path/union-paths "Patient.gender")))) + + (testing "two-way union is split" + (is (= ["CapabilityStatement.url" "ValueSet.url"] + (fhir-path/union-paths "CapabilityStatement.url | ValueSet.url")))) + + (testing "three-way union is split" + (is (= ["CapabilityStatement.url" "ValueSet.url" "StructureDefinition.url"] + (fhir-path/union-paths + "CapabilityStatement.url | ValueSet.url | StructureDefinition.url")))) + + (testing "whitespace around branches is trimmed" + (is (= ["A.url" "B.url"] + (fhir-path/union-paths " A.url | B.url ")))) + + (testing "parse error is returned as anomaly" + (given (fhir-path/union-paths "Patient.") + ::anom/category := ::anom/fault + :expression := "Patient.")) + + (testing "non-union expression is not split on inner dots" + (is (= ["Patient.name.given"] (fhir-path/union-paths "Patient.name.given"))))) diff --git a/modules/fhir-structure/src/blaze/fhir/structure_definition_repo.clj b/modules/fhir-structure/src/blaze/fhir/structure_definition_repo.clj index 9cf556143..7930723e9 100644 --- a/modules/fhir-structure/src/blaze/fhir/structure_definition_repo.clj +++ b/modules/fhir-structure/src/blaze/fhir/structure_definition_repo.clj @@ -4,10 +4,18 @@ [blaze.fhir.structure-definition-repo.protocols :as p] [blaze.fhir.structure-definition-repo.spec] [clojure.java.io :as io] + [clojure.string :as str] [integrant.core :as ig] [jsonista.core :as j] [taoensso.timbre :as log])) +(defn- read-bundle + "Reads a bundle from classpath named `resource-name`." + [resource-name] + (log/trace (format "Read FHIR bundle `%s`." resource-name)) + (with-open [rdr (io/reader (io/resource resource-name))] + (j/read-value rdr j/keyword-keys-object-mapper))) + (defn primitive-types "Returns a list of all StructureDefinition resources of FHIR R4 primitive types. @@ -39,13 +47,38 @@ path)) elements)) -(defn code-expressions - "Returns a set of FHIRPath expressions that evaluate to a primitive code type - on R4 resources." +(defn- single-type-code [element] + (let [types (:type element)] + (when (= 1 (count types)) + (:code (first types))))) + +(defn- publication-status-binding? [element] + (str/includes? (get-in element [:binding :valueSet] "") "publication-status")) + +(defn- canonical-url-paths + "Returns a set of element paths whose single type is `uri`, whose resource has + both a `.version` element and a `.status` element bound to the + `publication-status` value set (the FHIR canonical/metadata-resource pattern). + + These are the `.url` paths of conformance and knowledge resources, e.g. + `CapabilityStatement.url`, `ValueSet.url`." [repo] (into #{} - (mapcat (comp (partial single-type-paths "code") :element :snapshot)) + (keep + (fn [{:keys [id snapshot]}] + (let [by-path (into {} (map (juxt :path identity)) (:element snapshot)) + url-path (str id ".url") + url-el (get by-path url-path) + ;; every? boolean guards against nil from missing elements + ;; or unexpected types: all four conditions must be truthy + ;; for the url-path to be a canonical-url. + canonical? (every? boolean + [url-el + (= "uri" (single-type-code url-el)) + (get by-path (str id ".version")) + (publication-status-binding? (get by-path (str id ".status")))])] + (when canonical? url-path)))) (resources repo))) (defn- complex-type-canonical-sub-paths @@ -59,10 +92,67 @@ [id (mapv (fn [p] (subs p (inc (count id)))) canonical-paths)])))) (complex-types repo))) +(defn- abstract-base-resources + [] + (filter (comp #{"Resource" "DomainResource"} :id) + (map :resource + (:entry (read-bundle "blaze/fhir/4.0.1/profiles-resources.json"))))) + +(defn- element-kind + "Returns the kind keyword (:code, :canonical, or :canonical-url) for an + element based on its path and type in the canonical-url set." + [canonical-url-set {:keys [path] :as element}] + (or (when (contains? canonical-url-set path) :canonical-url) + (case (single-type-code element) + "code" :code + "canonical" :canonical + nil))) + +(defn- element-canonical-sub-paths + "Returns canonical sub-path entries for an element if its type is a complex + type with canonical sub-paths." + [complex-canonical {:keys [path type]}] + (when-let [sub-paths (get complex-canonical (:code (first type)))] + (map (fn [sub] [(str path "." sub) :canonical]) + sub-paths))) + +(defn- resource-element-entries + "Returns all categorized [path kind] entries for a resource." + [canonical-url-set complex-canonical resource include-direct?] + (mapcat + (fn [el] + (concat + (when include-direct? + (when-let [kind (element-kind canonical-url-set el)] + [[(:path el) kind]])) + (element-canonical-sub-paths complex-canonical el))) + (:element (:snapshot resource)))) + +(defn expression-types + "Returns a map from FHIRPath expression to a keyword categorizing the + expression's static result type on R4 resources. + + Categories are + :code - primitive `code` type (e.g. `Observation.status`) + :canonical - primitive `canonical` type (e.g. `Resource.meta.profile`) + :canonical-url - `.url` of a conformance/knowledge resource + (e.g. `ValueSet.url`), companion to `.version` indexing + + Paths not in any of the categories above are absent from the map." + [repo] + (let [canonical-url-set (canonical-url-paths repo) + complex-canonical (complex-type-canonical-sub-paths repo)] + (into {} + (concat + (mapcat #(resource-element-entries canonical-url-set complex-canonical % true) + (resources repo)) + (mapcat #(resource-element-entries canonical-url-set complex-canonical % false) + (abstract-base-resources)))))) + (defn- register-all! "Register specs for all FHIR data types and resources. - That specs are used to conform and unform resources from JSON/XML to the + These specs are used to conform and unform resources from JSON/XML to the internal format." [repo] (log/trace "Register primitive types") @@ -74,39 +164,6 @@ (log/trace "Register resources") (si/register (mapcat si/struct-def->spec-def (resources repo)))) -(defn- read-bundle - "Reads a bundle from classpath named `resource-name`." - [resource-name] - (log/trace (format "Read FHIR bundle `%s`." resource-name)) - (with-open [rdr (io/reader (io/resource resource-name))] - (j/read-value rdr j/keyword-keys-object-mapper))) - -(defn- abstract-base-resources - [] - (filter (comp #{"Resource" "DomainResource"} :id) - (map :resource - (:entry (read-bundle "blaze/fhir/4.0.1/profiles-resources.json"))))) - -(defn canonical-expressions - "Returns a set of FHIRPath expressions that evaluate to a primitive canonical type - on R4 resources, including nested paths through complex types." - [repo] - (let [complex-canonical (complex-type-canonical-sub-paths repo) - all-resources (concat (resources repo) (abstract-base-resources))] - (into - #{} - (mapcat - (fn [{:keys [snapshot]}] - (mapcat - (fn [{:keys [path type]}] - (if (and (= 1 (count type)) - (= "canonical" (:code (first type)))) - [path] - (when-let [sub-paths (get complex-canonical (:code (first type)))] - (map #(str path "." %) sub-paths)))) - (:element snapshot)))) - all-resources))) - (def ^:private repo (reify p/StructureDefinitionRepo (-primitive-types [_] diff --git a/modules/fhir-structure/src/blaze/fhir/structure_definition_repo_spec.clj b/modules/fhir-structure/src/blaze/fhir/structure_definition_repo_spec.clj index 0943b104e..d624bff67 100644 --- a/modules/fhir-structure/src/blaze/fhir/structure_definition_repo_spec.clj +++ b/modules/fhir-structure/src/blaze/fhir/structure_definition_repo_spec.clj @@ -14,3 +14,7 @@ (s/fdef sdr/resources :args (s/cat :repo :blaze.fhir/structure-definition-repo)) + +(s/fdef sdr/expression-types + :args (s/cat :repo :blaze.fhir/structure-definition-repo) + :ret (s/map-of string? #{:code :canonical :canonical-url})) diff --git a/modules/fhir-structure/test/blaze/fhir/structure_definition_repo_test.clj b/modules/fhir-structure/test/blaze/fhir/structure_definition_repo_test.clj index 2159c561e..153976356 100644 --- a/modules/fhir-structure/test/blaze/fhir/structure_definition_repo_test.clj +++ b/modules/fhir-structure/test/blaze/fhir/structure_definition_repo_test.clj @@ -1,7 +1,9 @@ (ns blaze.fhir.structure-definition-repo-test (:require [blaze.fhir.structure-definition-repo :as sdr] + [blaze.fhir.structure-definition-repo-spec] [blaze.test-util :as tu] + [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [deftest is testing]] [integrant.core :as ig])) @@ -13,25 +15,37 @@ (defonce structure-definition-repo (ig/init-key :blaze.fhir/structure-definition-repo {})) -(deftest code-expressions-test - (let [exprs (sdr/code-expressions structure-definition-repo)] - (is (set? exprs)) - (is (contains? exprs "Observation.status")) - (is (contains? exprs "Patient.language")) - (is (contains? exprs "ActivityDefinition.kind")) - (testing "does not include complex-type nested code paths" - (is (not (contains? exprs "Patient.address.use"))) - (is (not (contains? exprs "Coding.code"))) - (is (not (contains? exprs "Quantity.code"))) - (is (not (contains? exprs "Address.use"))) - (is (not (contains? exprs "Observation.component.code")))) +(deftest expression-types-test + (let [types (sdr/expression-types structure-definition-repo)] + (is (map? types)) + (testing "code paths are categorized as :code" + (is (= :code (types "Observation.status"))) + (is (= :code (types "Patient.language"))) + (is (= :code (types "ActivityDefinition.kind")))) + (testing "direct canonical paths are categorized as :canonical" + (is (= :canonical (types "ActivityDefinition.library")))) + (testing "canonical paths nested through complex types are categorized as :canonical" + (is (= :canonical (types "Resource.meta.profile")))) + (testing "canonical-URL paths are categorized as :canonical-url" + (is (= :canonical-url (types "CapabilityStatement.url"))) + (is (= :canonical-url (types "ValueSet.url"))) + (is (= :canonical-url (types "StructureDefinition.url"))) + (is (= :canonical-url (types "MessageDefinition.url")))) + (testing "non-canonical .url paths are not categorized" + (is (nil? (types "Device.url"))) + (is (nil? (types "DeviceDefinition.url"))) + (is (nil? (types "Contract.url")))) + (testing "non-canonical uri paths are not categorized" + (is (nil? (types "AuditEvent.agent.policy")))) + (testing "complex-type nested code paths are not categorized" + (is (nil? (types "Patient.address.use"))) + (is (nil? (types "Coding.code"))) + (is (nil? (types "Quantity.code"))) + (is (nil? (types "Address.use"))) + (is (nil? (types "Observation.component.code")))) (testing "does not include abstract base resource paths" - (is (not (contains? exprs "Resource.language")))))) - -(deftest canonical-expressions-test - (let [exprs (sdr/canonical-expressions structure-definition-repo)] - (is (set? exprs)) - (is (contains? exprs "Resource.meta.profile")) - (testing "does not include non-canonical paths" - (is (not (contains? exprs "CapabilityStatement.url"))) - (is (not (contains? exprs "Subscription.channel.endpoint")))))) + (is (nil? (types "Resource.language")))) + (testing ":ret spec" + (let [ret-spec (:ret (s/get-spec `sdr/expression-types))] + (is (s/valid? ret-spec types)) + (is (not (s/valid? ret-spec {"Patient.status" :not-a-valid-kind})))))))