diff --git a/.github/scripts/check-patient-as-of-index-missing.sh b/.github/scripts/check-patient-as-of-index-missing.sh new file mode 100755 index 000000000..fdb175dfb --- /dev/null +++ b/.github/scripts/check-patient-as-of-index-missing.sh @@ -0,0 +1,9 @@ +#!/bin/bash + +SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" +. "$SCRIPT_DIR/util.sh" + +BASE="http://localhost:8080/fhir" +curl -s "$BASE/__admin/rocksdb/index/column-families" | jq -r '."column-families"[]' | grep -q "patient-as-of-index" + +test "exit code" "$?" "1" diff --git a/.github/scripts/check-patient-as-of-index-state.sh b/.github/scripts/check-patient-as-of-index-state.sh new file mode 100755 index 000000000..77968e9c7 --- /dev/null +++ b/.github/scripts/check-patient-as-of-index-state.sh @@ -0,0 +1,9 @@ +#!/bin/bash -e + +SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" +. "$SCRIPT_DIR/util.sh" + +BASE="http://localhost:8080/fhir" +STATE="$(curl -s "$BASE/__admin/db/index/column-families/patient-as-of-index/state" | jq -r .type)" + +test "state" "$STATE" "$1" diff --git a/.github/scripts/test-metrics.sh b/.github/scripts/test-metrics.sh index a739a5c2e..0edb7f1f2 100755 --- a/.github/scripts/test-metrics.sh +++ b/.github/scripts/test-metrics.sh @@ -14,7 +14,3 @@ num-metrics() { test "blaze_rocksdb_block_cache_data_miss index" "$(num-metrics "blaze_rocksdb_block_cache_data_miss" "name=\"index\"")" "1" test "blaze_rocksdb_block_cache_data_miss transaction" "$(num-metrics "blaze_rocksdb_block_cache_data_miss" "name=\"transaction\"")" "1" test "blaze_rocksdb_block_cache_data_miss resource" "$(num-metrics "blaze_rocksdb_block_cache_data_miss" "name=\"resource\"")" "1" - -test "blaze_rocksdb_table_reader_usage_bytes index" "$(num-metrics "blaze_rocksdb_table_reader_usage_bytes" "name=\"index\"")" "14" -test "blaze_rocksdb_table_reader_usage_bytes transaction" "$(num-metrics "blaze_rocksdb_table_reader_usage_bytes" "name=\"transaction\"")" "1" -test "blaze_rocksdb_table_reader_usage_bytes resource" "$(num-metrics "blaze_rocksdb_table_reader_usage_bytes" "name=\"resource\"")" "1" diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index a828e73a6..56092e952 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -39,6 +39,7 @@ jobs: - anomaly - async - byte-buffer + - cache-collector - cassandra - coll - cql @@ -1137,6 +1138,47 @@ jobs: - name: Fetch Patient Expecting an Error run: .github/scripts/fetch-resource-0-with-missing-resource-content.sh + build-patient-as-of-index-test: + needs: build + runs-on: ubuntu-22.04 + + steps: + - name: Check out Git repository + uses: actions/checkout@v3 + + - name: Download Blaze Image + uses: actions/download-artifact@v3 + with: + name: blaze-image + path: /tmp + + - name: Load Blaze Image + run: docker load --input /tmp/blaze.tar + + - name: Run Blaze v0.22 + run: docker run --name blaze -d -e JAVA_TOOL_OPTIONS=-Xmx2g -e ENABLE_FRONTEND=true -p 8080:8080 -v blaze-data:/app/data samply/blaze:0.22 + + - name: Wait for Blaze + run: .github/scripts/wait-for-url.sh http://localhost:8080/health + + - name: Load Data + run: blazectl --no-progress --server http://localhost:8080/fhir upload .github/test-data/synthea + + - name: Ensure that the PatientAsOf Index does not exist + run: .github/scripts/check-patient-as-of-index-missing.sh + + - name: Shut down Blaze + run: docker stop blaze && docker rm blaze + + - name: Run Latest Blaze + run: docker run --name blaze -d -e JAVA_TOOL_OPTIONS=-Xmx2g -e ENABLE_FRONTEND=true -e LOG_LEVEL=debug -p 8080:8080 -v blaze-data:/app/data blaze:latest + + - name: Wait for Blaze + run: .github/scripts/wait-for-url.sh http://localhost:8080/health + + - name: Ensure that the State of PatientAsOf Index is Current + run: .github/scripts/check-patient-as-of-index-state.sh current + distributed-test: needs: build runs-on: ubuntu-22.04 @@ -1623,13 +1665,14 @@ jobs: - bundle-with-references-test - jepsen-test - openid-auth-test + - custom-search-parameters-test - doc-copy-data-test - big-binary-test - frontend-test - missing-resource-content-test + - build-patient-as-of-index-test - distributed-test - jepsen-distributed-test - - custom-search-parameters-test runs-on: ubuntu-22.04 permissions: packages: write diff --git a/Dockerfile b/Dockerfile index 28407aaf2..0fbdd92c7 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,4 +1,4 @@ -FROM eclipse-temurin:17.0.7_7-jre-jammy +FROM eclipse-temurin:17.0.8_7-jre-jammy RUN apt-get update && apt-get upgrade -y && \ apt-get install libjemalloc2 -y && \ diff --git a/dev/blaze/dev.clj b/dev/blaze/dev.clj index 98f3aa7e6..3e1e2b96a 100644 --- a/dev/blaze/dev.clj +++ b/dev/blaze/dev.clj @@ -1,9 +1,9 @@ (ns blaze.dev (:require [blaze.byte-string :as bs] + [blaze.cache-collector.protocols :as ccp] [blaze.db.api :as d] [blaze.db.api-spec] - [blaze.db.cache-collector.protocols :as ccp] [blaze.db.resource-cache :as resource-cache] [blaze.db.resource-store :as rs] [blaze.db.tx-log :as tx-log] @@ -66,6 +66,11 @@ (resource-cache/invalidate-all! (:blaze.db/resource-cache system)) ) +;; CQL Expression Cache +(comment + (str (ccp/-stats (:blaze.fhir.operation.evaluate-measure/expr-cache system))) + ) + ;; RocksDB Stats (comment (.reset (system [:blaze.db.kv.rocksdb/stats :blaze.db.index-kv-store/stats])) diff --git a/docs/implementation/database.md b/docs/implementation/database.md index 6da5c8b8d..966bc65ca 100644 --- a/docs/implementation/database.md +++ b/docs/implementation/database.md @@ -38,16 +38,17 @@ There are two different sets of indices, ones which depend on the database value ### Indices depending on t -| Name | Key Parts | Value | -|--------------|-----------|-------------------------------| -| ResourceAsOf | type id t | content-hash, num-changes, op | -| TypeAsOf | type t id | content-hash, num-changes, op | -| SystemAsOf | t type id | content-hash, num-changes, op | -| TxSuccess | t | instant | -| TxError | t | anomaly | -| TByInstant | instant | t | -| TypeStats | type t | total, num-changes | -| SystemStats | t | total, num-changes | +| Name | Key Parts | Value | +|--------------|------------------|-------------------------------| +| ResourceAsOf | type id t | content-hash, num-changes, op | +| TypeAsOf | type t id | content-hash, num-changes, op | +| SystemAsOf | t type id | content-hash, num-changes, op | +| PatientAsOf | pat-id t type id | content-hash, num-changes, op | +| TxSuccess | t | instant | +| TxError | t | anomaly | +| TByInstant | instant | t | +| TypeStats | type t | total, num-changes | +| SystemStats | t | total, num-changes | #### ResourceAsOf @@ -83,12 +84,16 @@ In addition to direct resource lookup, the `ResourceAsOf` index is used for list #### TypeAsOf -The `TypeAsOf` index contains the same information as the `ResourceAsOf` index with the difference that the components of the key are ordered `type`, `t` and `id` instead of `type`, `id` and `t`. The index is used for listing all versions of all resources of a particular type. Such history listings start with the `t` of the database value going into the past. This is done by not only choosing the resource version with the latest `t` less or equal the database values `t` but instead using all older versions. Such versions even include deleted versions because in FHIR it is allowed to bring back a resource to a new life after it was already deleted. The listing is done by simply scanning through the index in reverse. Because the key is ordered by `type`, `t` and `id`, the entries will be first ordered by time, newest first, and second by resource identifier. +The `TypeAsOf` index contains the same information as the `ResourceAsOf` index with the difference that the components of the key are ordered `type`, `t` and `id` instead of `type`, `id` and `t`. The index is used for listing all versions of all resources of a particular type. Such history listings start with the `t` of the database value going into the past. This is done by not only choosing the resource version with the latest `t` less or equal the database values `t` but instead using all older versions. Such versions even include deleted versions because in FHIR it is allowed to bring back a resource to a new life after it was already deleted. The listing is done by simply scanning through the index in reverse. Because the key is ordered by `type`, `t` and `id`, the entries will be first ordered by time, newest first, and second by resource identifier. #### SystemAsOf In the same way the `TypeAsOf` index uses a different key ordering in comparison to the `ResourceAsOf` index, the `SystemAsOf` index will use the key order `t`, `type` and `id` in order to provide a global time axis order by resource type and by identifier secondarily. +#### PatientAsOf + +The `PatientAsOf` index works like the `SystemAsOf` index but for each Patient individually. It contains all changes to resources in the compartment of a particular Patient on reverse chronological order. Using the `PatientAsOf` index it's possible to create a history of all changes in the Patient compartment or detect the `t` of the last change. The CQL cache uses this index to invalidate cached results of expressions in the Patient context. + #### TxSuccess The `TxSuccess` index contains the real point in time, as `java.time.Instant`, successful transactions happened. In other words, this index maps each `t` which is just a monotonically increasing number to a real point in time. @@ -115,23 +120,24 @@ The `SystemStats` index keeps track of the total number of resources, and the nu The indices not depending on `t` directly point to the resource versions by their content hash. -| Name | Key Parts | Value | -|-------------------------------------|------------------------------------------------------------------|-------| -| SearchParamValueResource | search-param, type, value, id, content-hash | - | -| ResourceSearchParamValue | type, id, content-hash, search-param, value | - | -| CompartmentSearchParamValueResource | co-c-hash, co-res-id, search-param, type, value, id, hash-prefix | - | -| CompartmentResource | co-c-hash, co-res-id, tid, id | - | -| SearchParam | code, tid | id | -| ActiveSearchParams | id | - | +| Name | Key Parts | Value | +|-------------------------------------|----------------------------------------------------------------|-------| +| SearchParamValueResource | search-param, type, value, id, hash-prefix | - | +| ResourceSearchParamValue | type, id, content-hash, search-param, value | - | +| CompartmentSearchParamValueResource | comp-code, comp-id, search-param, type, value, id, hash-prefix | - | +| CompartmentResource | comp-code, comp-id, type, id | - | +| SearchParam | code, type | id | +| ActiveSearchParams | id | - | #### SearchParamValueResource The `SearchParamValueResource` index contains all values from resources that are reachable from search parameters. The components of its key are: -* `search-param` - a 4-byte hash of the search parameters code used to identify the search parameter -* `type` - a 4-byte hash of the resource type -* `value` - the encoded value of the resource reachable by the search parameters FHIRPath expression. The encoding depends on the search parameters type. -* `id` - the logical id of the resource -* `content-hash` - a 4-byte prefix of the content-hash of the resource version + + * `search-param` - a 4-byte hash of the search parameters code used to identify the search parameter + * `type` - a 4-byte hash of the resource type + * `value` - the encoded value of the resource reachable by the search parameters FHIRPath expression. The encoding depends on the search parameters type. + * `id` - the logical id of the resource + * `content-hash` - a 4-byte prefix of the content-hash of the resource version The way the `SearchParamValueResource` index is used, depends on the type of the search parameter. The following sections will explain this in detail for each type: @@ -207,11 +213,20 @@ That tuples are further processed against the `ResourceAsOf` index in order to c **TODO: continue...** +#### CompartmentResource + +The `CompartmentResource` index contains all resources that belong to a certain compartment. The components of its key are: + + * `comp-code` - a 4-byte hash of the compartment code, ex. `Patient` + * `comp-id` - the logical id of the compartment, ex. the logical id of the Patient + * `type` - a 4-byte hash of the resource type of the resource that belongs to the compartment, ex. `Observation` + * `id` - the logical id of the resource that belongs to the compartment, ex. the logical id of the Observation + ## Transaction Handling -* a transaction bundle is POST'ed to one arbitrary node -* this node submits the transaction commands to the central transaction log -* all nodes (inkl. the transaction submitter) receive the transaction commands from the central transaction log + * a transaction bundle is POST'ed to one arbitrary node + * this node submits the transaction commands to the central transaction log + * all nodes (inkl. the transaction submitter) receive the transaction commands from the central transaction log ### Transaction Commands diff --git a/docs/monitoring/blaze.json b/docs/monitoring/blaze.json index 33d5b5886..cbec219d8 100644 --- a/docs/monitoring/blaze.json +++ b/docs/monitoring/blaze.json @@ -447,7 +447,7 @@ "uid": "${DS_PROMETHEUS}" }, "editorMode": "code", - "expr": "blaze_db_cache_estimated_size{job=\"$job\",instance=\"$instance\",name=\"resource-cache\"}", + "expr": "blaze_cache_estimated_size{job=\"$job\",instance=\"$instance\",name=\"resource-cache\"}", "hide": false, "interval": "", "legendFormat": "", @@ -546,7 +546,7 @@ "uid": "${DS_PROMETHEUS}" }, "editorMode": "code", - "expr": "rate(blaze_db_cache_hits_total{job=\"$job\",instance=\"$instance\", name=\"resource-cache\"}[1m]) / (rate(blaze_db_cache_hits_total[1m]) + rate(blaze_db_cache_misses_total[1m]))", + "expr": "rate(blaze_cache_hits_total{job=\"$job\",instance=\"$instance\", name=\"resource-cache\"}[1m]) / (rate(blaze_cache_hits_total[1m]) + rate(blaze_cache_misses_total[1m]))", "hide": false, "interval": "", "legendFormat": "", @@ -644,7 +644,7 @@ "uid": "${DS_PROMETHEUS}" }, "editorMode": "code", - "expr": "rate(blaze_db_cache_load_successes_total{job=\"$job\",instance=\"$instance\",name=\"resource-cache\"}[1m])", + "expr": "rate(blaze_cache_load_successes_total{job=\"$job\",instance=\"$instance\",name=\"resource-cache\"}[1m])", "hide": false, "interval": "", "legendFormat": "", @@ -742,7 +742,7 @@ "uid": "${DS_PROMETHEUS}" }, "editorMode": "code", - "expr": "rate(blaze_db_cache_evictions_total{job=\"$job\",instance=\"$instance\",name=\"resource-cache\"}[1m])", + "expr": "rate(blaze_cache_evictions_total{job=\"$job\",instance=\"$instance\",name=\"resource-cache\"}[1m])", "hide": false, "interval": "", "legendFormat": "", @@ -7985,7 +7985,7 @@ "type": "prometheus", "uid": "${DS_PROMETHEUS}" }, - "definition": "label_values(blaze_db_cache_hits_total, job)", + "definition": "label_values(blaze_cache_hits_total, job)", "hide": 0, "includeAll": false, "label": "Job", @@ -7993,7 +7993,7 @@ "name": "job", "options": [], "query": { - "query": "label_values(blaze_db_cache_hits_total, job)", + "query": "label_values(blaze_cache_hits_total, job)", "refId": "StandardVariableQuery" }, "refresh": 1, @@ -8012,14 +8012,14 @@ "type": "prometheus", "uid": "${DS_PROMETHEUS}" }, - "definition": "label_values(blaze_db_cache_estimated_size{job=\"$job\"}, instance)", + "definition": "label_values(blaze_cache_estimated_size{job=\"$job\"}, instance)", "hide": 0, "includeAll": false, "multi": false, "name": "instance", "options": [], "query": { - "query": "label_values(blaze_db_cache_estimated_size{job=\"$job\"}, instance)", + "query": "label_values(blaze_cache_estimated_size{job=\"$job\"}, instance)", "refId": "StandardVariableQuery" }, "refresh": 1, diff --git a/docs/performance/cql.md b/docs/performance/cql.md index b2926fb8a..f72b49729 100644 --- a/docs/performance/cql.md +++ b/docs/performance/cql.md @@ -42,17 +42,19 @@ define InInitialPopulation: The CQL query is executed with the following `blazectl` command: ```sh -blazectl evaluate-measure "cql/observation-$CODE.yml" --server http://localhost:8080/fhir | jq -rf cql/result.jq +cql/search.sh observation-17861-6 +cql/search.sh observation-8310-5 +cql/search.sh observation-72514-3 ``` | System | Dataset | Code | # Hits | Time (s) | StdDev | Pat./s | |--------|---------|---------|-------:|---------:|-------:|--------:| -| LEA47 | 100k | 17861-6 | 2 k | 0.26 | 0.158 | 384.5 k | -| LEA47 | 100k | 8310-5 | 60 k | 0.28 | 0.142 | 351.4 k | -| LEA47 | 100k | 72514-3 | 100 k | 0.27 | 0.128 | 367.0 k | -| LEA47 | 1M | 17861-6 | 25 k | 2.61 | 0.208 | 383.1 k | -| LEA47 | 1M | 8310-5 | 603 k | 2.68 | 0.201 | 372.8 k | -| LEA47 | 1M | 72514-3 | 998 k | 2.82 | 0.192 | 354.9 k | +| LEA47 | 100k | 17861-6 | 2 k | 0.09 | 0.001 | 1.1 M | +| LEA47 | 100k | 8310-5 | 60 k | 0.10 | 0.001 | 1.0 M | +| LEA47 | 100k | 72514-3 | 100 k | 0.10 | 0.002 | 1.0 M | +| LEA47 | 1M | 17861-6 | 25 k | 0.96 | 0.006 | 1.0 M | +| LEA47 | 1M | 8310-5 | 603 k | 0.99 | 0.008 | 1.0 M | +| LEA47 | 1M | 72514-3 | 998 k | 1.02 | 0.005 | 980.5 k | | LEA58 | 1M | 17861-6 | 25 k | 2.87 | 0.291 | 348.5 k | | LEA58 | 1M | 8310-5 | 603 k | 3.02 | 0.257 | 330.8 k | | LEA58 | 1M | 72514-3 | 998 k | 3.06 | 0.426 | 326.7 k | @@ -80,22 +82,24 @@ define InInitialPopulation: The CQL query is executed with the following `blazectl` command: ```sh -blazectl evaluate-measure "cql/observation-$CODE-$VALUE.yml" --server http://localhost:8080/fhir | jq -rf cql/result.jq +cql/search.sh observation-body-weight-10 +cql/search.sh observation-body-weight-50 +cql/search.sh observation-body-weight-100 ``` | System | Dataset | Code | Value | # Hits | Time (s) | StdDev | Pat./s | |--------|---------|---------|--------:|-------:|---------:|-------:|--------:| -| LEA47 | 100k | 29463-7 | 13.6 kg | 10 k | 0.68 | 0.031 | 146.9 k | -| LEA47 | 100k | 29463-7 | 75.3 kg | 50 k | 0.51 | 0.033 | 197.1 k | -| LEA47 | 100k | 29463-7 | 185 kg | 100 k | 0.30 | 0.106 | 331.6 k | -| LEA47 | 1M | 29463-7 | 13.6 kg | 99 k | 151.05 | 4.674 | 6.6 k | -| LEA47 | 1M | 29463-7 | 75.3 kg | 500 k | 104.68 | 2.022 | 9.6 k | -| LEA47 | 1M | 29463-7 | 185 kg | 998 k | 3.19 | 0.176 | 313.8 k | +| LEA47 | 100k | 29463-7 | 13.6 kg | 10 k | 0.09 | 0.001 | 1.1 M | +| LEA47 | 100k | 29463-7 | 75.3 kg | 50 k | 0.10 | 0.001 | 1.0 M | +| LEA47 | 100k | 29463-7 | 185 kg | 100 k | 0.10 | 0.001 | 1.0 M | +| LEA47 | 1M | 29463-7 | 13.6 kg | 99 k | 0.98 | 0.013 | 1.0 M | +| LEA47 | 1M | 29463-7 | 75.3 kg | 500 k | 1.03 | 0.014 | 966.4 k | +| LEA47 | 1M | 29463-7 | 185 kg | 998 k | 1.03 | 0.007 | 970.5 k | | LEA58 | 1M | 29463-7 | 13.6 kg | 99 k | 8.24 | 0.072 | 121.4 k | | LEA58 | 1M | 29463-7 | 75.3 kg | 500 k | 6.59 | 0.140 | 151.8 k | | LEA58 | 1M | 29463-7 | 185 kg | 998 k | 3.04 | 0.209 | 329.0 k | -## Code and Value Search +## Code, Date and Age Search In this section, CQL Queries for selecting Patients which have Observation resources with code 718-7 (Hemoglobin), date between 2015 and 2019 and age of patient at observation date below 18. @@ -110,21 +114,117 @@ context Patient define InInitialPopulation: exists [Observation: Code '718-7' from loinc] O - where year from O.effective between 2015 and 2019 - and AgeInYearsAt(O.effective) < 18 + where year from (O.effective as dateTime) between 2015 and 2019 + and AgeInYearsAt(O.effective as dateTime) < 18 ``` The CQL query is executed with the following `blazectl` command: ```sh -blazectl evaluate-measure "cql/hemoglobin-date-age.yml" --server http://localhost:8080/fhir | jq -rf cql/result.jq +cql/search.sh hemoglobin-date-age +cql/search.sh calcium-date-age ``` | System | Dataset | Code | # Hits | Time (s) | StdDev | Pat./s | |--------|---------|------------|-------:|---------:|-------:|--------:| -| LEA47 | 100k | hemoglobin | 20 k | 0.35 | 0.034 | 286.5 k | -| LEA47 | 100k | calcium | 20 k | 1.50 | 0.035 | 66.6 k | -| LEA47 | 1M | hemoglobin | 200 k | 4.79 | 0.119 | 208.8 k | -| LEA47 | 1M | calcium | 199 k | 182.90 | 3.900 | 5.5 k | +| LEA47 | 100k | hemoglobin | 20 k | 0.09 | 0.001 | 1.1 M | +| LEA47 | 100k | calcium | 20 k | 0.09 | 0.001 | 1.1 M | +| LEA47 | 1M | hemoglobin | 200 k | 1.01 | 0.018 | 989.7 k | +| LEA47 | 1M | calcium | 199 k | 0.99 | 0.015 | 1.0 M | | LEA58 | 1M | hemoglobin | 200 k | 3.55 | 0.038 | 281.8 k | | LEA58 | 1M | calcium | 199 k | 10.10 | 0.033 | 99.0 k | + +## Double Code Search + +In this section, CQL Queries for selecting Patients which have Condition resources with one of two codes used. + +```text +library "condition-two" +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem sct: 'http://snomed.info/sct' +code fever: '386661006' from sct +code cough: '49727002' from sct + +context Patient + +define InInitialPopulation: + exists [Condition: fever] or + exists [Condition: cough] +``` + +```sh +cql/search.sh condition-two +``` + +| System | Dataset | # Hits | Time (s) | StdDev | Pat./s | +|--------|---------|-------:|---------:|-------:|--------:| +| LEA47 | 100k | 9 k | 0.10 | 0.002 | 988.5 k | +| LEA47 | 1M | 87 k | 1.01 | 0.010 | 988.8 k | + +## Ten Frequent Code Search + +```text +library "condition-ten-frequent" +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem sct: 'http://snomed.info/sct' + +context Patient + +define InInitialPopulation: + exists [Condition: Code '444814009' from sct] or + exists [Condition: Code '840544004' from sct] or + exists [Condition: Code '840539006' from sct] or + exists [Condition: Code '386661006' from sct] or + exists [Condition: Code '195662009' from sct] or + exists [Condition: Code '49727002' from sct] or + exists [Condition: Code '10509002' from sct] or + exists [Condition: Code '72892002' from sct] or + exists [Condition: Code '36955009' from sct] or + exists [Condition: Code '162864005' from sct] +``` + +```sh +cql/search.sh condition-ten-frequent +``` + +| System | Dataset | # Hits | Time (s) | StdDev | Pat./s | +|--------|---------|-------:|---------:|-------:|--------:| +| LEA47 | 100k | 95 k | 0.11 | 0.003 | 899.0 k | +| LEA47 | 1M | 954 k | 1.14 | 0.014 | 880.7 k | + +## Ten Rare Code Search + +```text +library "condition-ten-rare" +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem sct: 'http://snomed.info/sct' + +context Patient + +define InInitialPopulation: + exists [Condition: Code '62718007' from sct] or + exists [Condition: Code '234466008' from sct] or + exists [Condition: Code '288959006' from sct] or + exists [Condition: Code '47505003' from sct] or + exists [Condition: Code '698754002' from sct] or + exists [Condition: Code '157265008' from sct] or + exists [Condition: Code '15802004' from sct] or + exists [Condition: Code '14760008' from sct] or + exists [Condition: Code '36923009' from sct] or + exists [Condition: Code '45816000' from sct] +``` + +```sh +cql/search.sh condition-ten-rare +``` + +| System | Dataset | # Hits | Time (s) | StdDev | Pat./s | +|--------|---------|-------:|---------:|-------:|--------:| +| LEA47 | 100k | 0 k | 0.14 | 0.002 | 726.0 k | +| LEA47 | 1M | 4 k | 1.59 | 0.016 | 627.1 k | diff --git a/docs/performance/cql/calcium-date-age.cql b/docs/performance/cql/calcium-date-age.cql index 30fb87733..4dcc668a7 100644 --- a/docs/performance/cql/calcium-date-age.cql +++ b/docs/performance/cql/calcium-date-age.cql @@ -8,5 +8,5 @@ context Patient define InInitialPopulation: exists [Observation: Code '49765-1' from loinc] O - where year from O.effective between 2015 and 2019 - and AgeInYearsAt(O.effective) < 59 + where year from (O.effective as dateTime as dateTime) between 2015 and 2019 + and AgeInYearsAt(O.effective as dateTime) < 59 diff --git a/docs/performance/cql/code-date-age-search.sh b/docs/performance/cql/code-date-age-search.sh deleted file mode 100755 index 0470f1017..000000000 --- a/docs/performance/cql/code-date-age-search.sh +++ /dev/null @@ -1,22 +0,0 @@ -#!/bin/bash -e - -SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" -. "$SCRIPT_DIR/util.sh" - -BASE="http://localhost:8080/fhir" -START_EPOCH="$(date +"%s")" -PATIENT_TOTAL="$(curl -sH 'Accept: application/fhir+json' "$BASE/Patient?_summary=count" | jq -r .total)" -CODE="$1" - -echo "Counting Patients with Observations with code $CODE, date between 2015 and 2019 and age of patient at observation date below 18..." - -MEASURE_FILE="$SCRIPT_DIR/$CODE-date-age.yml" -TIMES_FILE="$START_EPOCH-$CODE-date-age.times" -COUNT="$(blazectl --server "$BASE" evaluate-measure "$MEASURE_FILE" 2> /dev/null | jq -r '.group[0].population[0].count')" - -for i in {0..6} -do - blazectl --server "$BASE" evaluate-measure "$MEASURE_FILE" 2> /dev/null |\ - jq -rf "$SCRIPT_DIR/duration.jq" >> "$TIMES_FILE" -done -calc-cql-print-stats "$TIMES_FILE" "$PATIENT_TOTAL" "$COUNT" diff --git a/docs/performance/cql/code-value-search.sh b/docs/performance/cql/code-value-search.sh deleted file mode 100755 index 2126191c3..000000000 --- a/docs/performance/cql/code-value-search.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/bash -e - -SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" -. "$SCRIPT_DIR/util.sh" - -BASE="http://localhost:8080/fhir" -START_EPOCH="$(date +"%s")" -PATIENT_TOTAL="$(curl -sH 'Accept: application/fhir+json' "$BASE/Patient?_summary=count" | jq -r .total)" -CODE="$1" -VALUE="$2" - -echo "Counting Patients with Observations with code $CODE and value $VALUE..." -COUNT="$(blazectl --server "$BASE" evaluate-measure "$SCRIPT_DIR/observation-$CODE-$VALUE.yml" 2> /dev/null | jq -r '.group[0].population[0].count')" -for i in {0..6} -do - blazectl evaluate-measure "cql/observation-$CODE-$VALUE.yml" --server "$BASE" 2> /dev/null |\ - jq -rf cql/duration.jq >> "$START_EPOCH-$CODE-$VALUE.times" -done -calc-cql-print-stats "$START_EPOCH-$CODE-$VALUE.times" "$PATIENT_TOTAL" "$COUNT" diff --git a/docs/performance/cql/condition-ten-frequent.cql b/docs/performance/cql/condition-ten-frequent.cql new file mode 100644 index 000000000..21f54cc03 --- /dev/null +++ b/docs/performance/cql/condition-ten-frequent.cql @@ -0,0 +1,19 @@ +library "condition-ten-frequent" +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem sct: 'http://snomed.info/sct' + +context Patient + +define InInitialPopulation: + exists [Condition: Code '444814009' from sct] or + exists [Condition: Code '840544004' from sct] or + exists [Condition: Code '840539006' from sct] or + exists [Condition: Code '386661006' from sct] or + exists [Condition: Code '195662009' from sct] or + exists [Condition: Code '49727002' from sct] or + exists [Condition: Code '10509002' from sct] or + exists [Condition: Code '72892002' from sct] or + exists [Condition: Code '36955009' from sct] or + exists [Condition: Code '162864005' from sct] diff --git a/docs/performance/cql/condition-ten-frequent.yml b/docs/performance/cql/condition-ten-frequent.yml new file mode 100644 index 000000000..c98e4b241 --- /dev/null +++ b/docs/performance/cql/condition-ten-frequent.yml @@ -0,0 +1,5 @@ +library: cql/condition-ten-frequent.cql +group: +- type: Patient + population: + - expression: InInitialPopulation diff --git a/docs/performance/cql/condition-ten-rare.cql b/docs/performance/cql/condition-ten-rare.cql new file mode 100644 index 000000000..4c94ed068 --- /dev/null +++ b/docs/performance/cql/condition-ten-rare.cql @@ -0,0 +1,19 @@ +library "condition-ten-rare" +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem sct: 'http://snomed.info/sct' + +context Patient + +define InInitialPopulation: + exists [Condition: Code '62718007' from sct] or + exists [Condition: Code '234466008' from sct] or + exists [Condition: Code '288959006' from sct] or + exists [Condition: Code '47505003' from sct] or + exists [Condition: Code '698754002' from sct] or + exists [Condition: Code '157265008' from sct] or + exists [Condition: Code '15802004' from sct] or + exists [Condition: Code '14760008' from sct] or + exists [Condition: Code '36923009' from sct] or + exists [Condition: Code '45816000' from sct] diff --git a/docs/performance/cql/condition-ten-rare.yml b/docs/performance/cql/condition-ten-rare.yml new file mode 100644 index 000000000..09ce1c85d --- /dev/null +++ b/docs/performance/cql/condition-ten-rare.yml @@ -0,0 +1,5 @@ +library: cql/condition-ten-rare.cql +group: +- type: Patient + population: + - expression: InInitialPopulation diff --git a/docs/performance/cql/condition-two.cql b/docs/performance/cql/condition-two.cql new file mode 100644 index 000000000..36630e504 --- /dev/null +++ b/docs/performance/cql/condition-two.cql @@ -0,0 +1,13 @@ +library "condition-two" +using FHIR version '4.0.0' +include FHIRHelpers version '4.0.0' + +codesystem sct: 'http://snomed.info/sct' +code fever: '386661006' from sct +code cough: '49727002' from sct + +context Patient + +define InInitialPopulation: + exists [Condition: fever] or + exists [Condition: cough] diff --git a/docs/performance/cql/condition-two.yml b/docs/performance/cql/condition-two.yml new file mode 100644 index 000000000..46c786903 --- /dev/null +++ b/docs/performance/cql/condition-two.yml @@ -0,0 +1,5 @@ +library: cql/condition-two.cql +group: +- type: Patient + population: + - expression: InInitialPopulation diff --git a/docs/performance/cql/hemoglobin-date-age.cql b/docs/performance/cql/hemoglobin-date-age.cql index 81c25492a..554add059 100644 --- a/docs/performance/cql/hemoglobin-date-age.cql +++ b/docs/performance/cql/hemoglobin-date-age.cql @@ -8,5 +8,5 @@ context Patient define InInitialPopulation: exists [Observation: Code '718-7' from loinc] O - where year from O.effective between 2015 and 2019 - and AgeInYearsAt(O.effective) < 18 + where year from (O.effective as dateTime as dateTime) between 2015 and 2019 + and AgeInYearsAt(O.effective as dateTime) < 18 diff --git a/docs/performance/cql/search.sh b/docs/performance/cql/search.sh new file mode 100755 index 000000000..4648a95e8 --- /dev/null +++ b/docs/performance/cql/search.sh @@ -0,0 +1,19 @@ +#!/bin/bash -e + +SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" +. "$SCRIPT_DIR/util.sh" + +BASE="http://localhost:8080/fhir" +START_EPOCH="$(date +"%s")" +PATIENT_TOTAL="$(curl -sH 'Accept: application/fhir+json' "$BASE/Patient?_summary=count" | jq -r .total)" +FILE="$1" + +echo "Counting Patients with criteria from $FILE..." +COUNT="$(blazectl --server "$BASE" evaluate-measure "$SCRIPT_DIR/$FILE.yml" 2> /dev/null | jq -r '.group[0].population[0].count')" +for i in {0..6} +do + blazectl --server "$BASE" evaluate-measure "$SCRIPT_DIR/$FILE.yml" 2> /dev/null |\ + jq -rf "$SCRIPT_DIR/duration.jq" >> "$START_EPOCH-$FILE.times" +done + +calc-cql-print-stats "$START_EPOCH-$FILE.times" "$PATIENT_TOTAL" "$COUNT" diff --git a/docs/performance/cql/simple-code-search.sh b/docs/performance/cql/simple-code-search.sh deleted file mode 100755 index e59cea0e6..000000000 --- a/docs/performance/cql/simple-code-search.sh +++ /dev/null @@ -1,19 +0,0 @@ -#!/bin/bash -e - -SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" -. "$SCRIPT_DIR/util.sh" - -BASE="http://localhost:8080/fhir" -START_EPOCH="$(date +"%s")" -PATIENT_TOTAL="$(curl -sH 'Accept: application/fhir+json' "$BASE/Patient?_summary=count" | jq -r .total)" -CODE="$1" - -echo "Counting Patients with Observations with code $CODE..." -COUNT="$(blazectl --server "$BASE" evaluate-measure "$SCRIPT_DIR/observation-$CODE.yml" 2> /dev/null | jq -r '.group[0].population[0].count')" -for i in {0..6} -do - blazectl --server "$BASE" evaluate-measure "$SCRIPT_DIR/observation-$CODE.yml" 2> /dev/null |\ - jq -rf "$SCRIPT_DIR/duration.jq" >> "$START_EPOCH-$CODE.times" -done - -calc-cql-print-stats "$START_EPOCH-$CODE.times" "$PATIENT_TOTAL" "$COUNT" diff --git a/docs/performance/cql/util.sh b/docs/performance/cql/util.sh index 6f84918b9..3a9f2825e 100644 --- a/docs/performance/cql/util.sh +++ b/docs/performance/cql/util.sh @@ -24,7 +24,10 @@ calc-cql-print-stats() { fi # shorten the patients per second - if (( $(echo "$PATIENTS_PER_SEC > 1000" | bc) )); then + if (( $(echo "$PATIENTS_PER_SEC > 1000000" | bc) )); then + PATIENTS_PER_SEC=$(echo "scale=2; $PATIENTS_PER_SEC / 1000000" | bc) + PATIENTS_PER_SEC_FORMAT="%4.1f M" + elif (( $(echo "$PATIENTS_PER_SEC > 1000" | bc) )); then PATIENTS_PER_SEC=$(echo "scale=2; $PATIENTS_PER_SEC / 1000" | bc) PATIENTS_PER_SEC_FORMAT="%4.1f k" else diff --git a/modules/admin-api/.clj-kondo/config.edn b/modules/admin-api/.clj-kondo/config.edn index a9c7992de..b25e046ab 100644 --- a/modules/admin-api/.clj-kondo/config.edn +++ b/modules/admin-api/.clj-kondo/config.edn @@ -1,5 +1,6 @@ {:lint-as - {blaze.admin-api-test/with-handler clojure.core/fn} + {blaze.admin-api-test/with-handler clojure.core/fn + blaze.anomaly/if-ok clojure.core/let} :linters {:unsorted-required-namespaces @@ -22,6 +23,7 @@ {blaze.async.comp ac blaze.db.kv.rocksdb rocksdb clojure.spec.alpha s + cognitect.anomalies anom integrant.core ig ring.util.response ring taoensso.timbre log}}} diff --git a/modules/admin-api/Makefile b/modules/admin-api/Makefile index 8eb60f27a..7510b665c 100644 --- a/modules/admin-api/Makefile +++ b/modules/admin-api/Makefile @@ -10,7 +10,13 @@ test: prep test-coverage: prep clojure -M:test:coverage +deps-tree: + clojure -X:deps tree + +deps-list: + clojure -X:deps list + clean: rm -rf .clj-kondo/.cache .cpcache target -.PHONY: lint prep test test-coverage clean +.PHONY: lint prep test test-coverage deps-tree deps-list clean diff --git a/modules/admin-api/deps.edn b/modules/admin-api/deps.edn index e20aadb66..8c780c24b 100644 --- a/modules/admin-api/deps.edn +++ b/modules/admin-api/deps.edn @@ -12,7 +12,10 @@ {:local/root "../rocksdb"} blaze/spec - {:local/root "../spec"}} + {:local/root "../spec"} + + fi.metosin/reitit-openapi + {:mvn/version "0.7.0-alpha5"}} :aliases {:test diff --git a/modules/admin-api/src/blaze/admin_api.clj b/modules/admin-api/src/blaze/admin_api.clj index f99e365c3..d82519491 100644 --- a/modules/admin-api/src/blaze/admin_api.clj +++ b/modules/admin-api/src/blaze/admin_api.clj @@ -1,10 +1,13 @@ (ns blaze.admin-api (:require + [blaze.anomaly :refer [if-ok]] [blaze.async.comp :as ac] + [blaze.db.impl.index.patient-as-of :as pao] [blaze.db.kv.rocksdb :as rocksdb] [blaze.spec] [clojure.spec.alpha :as s] [integrant.core :as ig] + [reitit.openapi :as openapi] [reitit.ring] [reitit.ring.spec] [ring.util.response :as ring] @@ -18,26 +21,86 @@ (ac/completed-future)))) -(defn- rocksdb-table-handler [index-kv-store] +(defn- cf-state-handler [index-kv-store] (fn [{{:keys [column-family]} :path-params}] - (-> (ring/response {:tables (rocksdb/table-properties index-kv-store (keyword column-family))}) + (-> (if (= "patient-as-of-index" column-family) + (ring/response (pao/state index-kv-store)) + (ring/not-found {:msg (format "The column family `%s` has no state." column-family)})) (ac/completed-future)))) +(defn- cf-rocksdb-table-handler [index-kv-store] + (fn [{{:keys [column-family]} :path-params}] + (-> (if-ok [tables (rocksdb/table-properties index-kv-store (keyword column-family))] + (ring/response {:tables tables}) + (fn [_] (ring/not-found {:msg (format "The column family `%s` was not found." column-family)}))) + (ac/completed-future)))) + + +(def ^:private openapi-handler + (let [handler (openapi/create-openapi-handler)] + (fn [request] + (ac/completed-future (handler request))))) + + (defn- router [{:keys [context-path index-kv-store] :or {context-path ""}}] (reitit.ring/router - ["/rocksdb" - {} - ["/index" + ["" + {:openapi {:id :admin-api} + :middleware [openapi/openapi-feature]} + ["/openapi.json" + {:get {:handler openapi-handler + :openapi {:info {:title "Blaze Admin API" :version "0.22"}} + :no-doc true}}] + ["/db" {} - ["/column-families" + ["/index" {} - ["" - {:get (rocksdb-column-families-handler index-kv-store)}] - ["/{column-family}" + ["/column-families" {} - ["/tables" - {:get (rocksdb-table-handler index-kv-store)}]]]]] + ["" + {:get + {:handler (rocksdb-column-families-handler index-kv-store) + :summary "Fetch a list of all column families." + :openapi + {:responses + {200 + {:content + {"application/json" + {:schema + {:type "object" + :properties + [:column-families + {:type "array" + :items {:type "string"}}]}}}}}}}}] + ["/{column-family}" + {} + ["/state" + {:get + {:handler (cf-state-handler index-kv-store)}}] + ["/rocksdb-tables" + {:get + {:handler (cf-rocksdb-table-handler index-kv-store) + :summary "Fetch a list of all tables of a column family." + :openapi + {:parameters + [{:name "column-family" + :in "path" + :required true}] + :responses + {200 + {:content + {"application/json" + {:schema + {:type "object" + :properties + [:tables + {:type "array" + :items + {:type "object" + :properties + [:data-size {:type "integer"} + :total-raw-key-size {:type "integer"}]}}]}}}}}}}}]]]]]] {:path (str context-path "/__admin") :syntax :bracket})) diff --git a/modules/admin-api/test/blaze/admin_api_test.clj b/modules/admin-api/test/blaze/admin_api_test.clj index f538d8207..383770d65 100644 --- a/modules/admin-api/test/blaze/admin_api_test.clj +++ b/modules/admin-api/test/blaze/admin_api_test.clj @@ -1,6 +1,8 @@ (ns blaze.admin-api-test (:require [blaze.admin-api] + [blaze.anomaly :as ba] + [blaze.db.impl.index.patient-as-of :as pao] [blaze.db.kv.rocksdb.protocols :as p] [blaze.module.test-util :refer [with-system]] [blaze.test-util :as tu :refer [given-thrown]] @@ -47,9 +49,10 @@ (keys column-families)) (-table-properties [_ column-family] - (when (column-families column-family) + (if (column-families column-family) [{:name (str (name column-family) "/table-1") - :data-size 193338}])))) + :data-size 193338}] + (ba/not-found ""))))) (def config @@ -69,28 +72,55 @@ ~@body))) -(deftest rocksdb-column-families-test +(deftest handler-not-found-test + (with-handler [handler] + (given @(handler + {:request-method :get + :uri "/fhir/__admin/foo"}) + :status := 404))) + + +(deftest column-families-test (with-handler [handler] (testing "success" (given @(handler {:request-method :get - :uri "/fhir/__admin/rocksdb/index/column-families"}) + :uri "/fhir/__admin/db/index/column-families"}) :status := 200 [:body :column-families] := ["column-family-1" "column-family-2"])))) -(deftest rocksdb-tables-test +(deftest column-family-state-test (with-handler [handler] - (testing "not found" + (testing "patient-as-of-index" + (with-redefs [pao/state (fn [_] ::state)] + (given @(handler + {:request-method :get + :uri "/fhir/__admin/db/index/column-families/patient-as-of-index/state"}) + :status := 200 + :body := ::state))) + + (testing "other column-family" (given @(handler {:request-method :get - :uri "/fhir/__admin/foo"}) - :status := 404)) + :uri "/fhir/__admin/db/index/column-families/column-family-1/state"}) + :status := 404 + [:body :msg] := "The column family `column-family-1` has no state.")))) + +(deftest rocksdb-tables-test + (with-handler [handler] (testing "success" (given @(handler {:request-method :get - :uri "/fhir/__admin/rocksdb/index/column-families/column-family-1/tables"}) + :uri "/fhir/__admin/db/index/column-families/column-family-1/rocksdb-tables"}) :status := 200 [:body :tables 0 :name] := "column-family-1/table-1" - [:body :tables 0 :data-size] := 193338)))) + [:body :tables 0 :data-size] := 193338)) + + (testing "not-found" + (given @(handler + {:request-method :get + :uri "/fhir/__admin/db/index/column-families/column-family-3/rocksdb-tables"}) + :status := 404 + [:body :msg] := "The column family `column-family-3` was not found.")))) diff --git a/modules/async/.clj-kondo/config.edn b/modules/async/.clj-kondo/config.edn index 07ef93f1d..354f88a6c 100644 --- a/modules/async/.clj-kondo/config.edn +++ b/modules/async/.clj-kondo/config.edn @@ -15,6 +15,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/byte-buffer/src/blaze/byte_buffer.clj b/modules/byte-buffer/src/blaze/byte_buffer.clj index b4e6b2348..de8f18577 100644 --- a/modules/byte-buffer/src/blaze/byte_buffer.clj +++ b/modules/byte-buffer/src/blaze/byte_buffer.clj @@ -225,10 +225,15 @@ (defn get-long! {:inline - (fn [byte-buffer] - `(.getLong ~(vary-meta byte-buffer assoc :tag `ByteBuffer)))} - [byte-buffer] - (.getLong ^ByteBuffer byte-buffer)) + (fn + ([byte-buffer] + `(.getLong ~(vary-meta byte-buffer assoc :tag `ByteBuffer))) + ([byte-buffer index] + `(.getLong ~(vary-meta byte-buffer assoc :tag `ByteBuffer) (int ~index))))} + ([byte-buffer] + (.getLong ^ByteBuffer byte-buffer)) + ([byte-buffer index] + (.getLong ^ByteBuffer byte-buffer (int index)))) (defn copy-into-byte-array! diff --git a/modules/cache-collector/.clj-kondo/config.edn b/modules/cache-collector/.clj-kondo/config.edn new file mode 100644 index 000000000..a25d19101 --- /dev/null +++ b/modules/cache-collector/.clj-kondo/config.edn @@ -0,0 +1,20 @@ +{:lint-as + {blaze.module.test-util/with-system clojure.core/with-open} + + :linters + {:unsorted-required-namespaces + {:level :error} + + :single-key-in + {:level :warning} + + :keyword-binding + {:level :error} + + :reduce-without-init + {:level :warning} + + :warn-on-reflection + {:level :warning :warn-only-on-interop true}} + + :skip-comments true} diff --git a/modules/cache-collector/Makefile b/modules/cache-collector/Makefile new file mode 100644 index 000000000..7510b665c --- /dev/null +++ b/modules/cache-collector/Makefile @@ -0,0 +1,22 @@ +lint: + clj-kondo --lint src test deps.edn + +prep: + clojure -X:deps prep + +test: prep + clojure -M:test:kaocha --profile :ci + +test-coverage: prep + clojure -M:test:coverage + +deps-tree: + clojure -X:deps tree + +deps-list: + clojure -X:deps list + +clean: + rm -rf .clj-kondo/.cache .cpcache target + +.PHONY: lint prep test test-coverage deps-tree deps-list clean diff --git a/modules/cache-collector/deps.edn b/modules/cache-collector/deps.edn new file mode 100644 index 000000000..3a959a79d --- /dev/null +++ b/modules/cache-collector/deps.edn @@ -0,0 +1,45 @@ +{:deps + {blaze/metrics + {:local/root "../metrics"} + + blaze/module-base + {:local/root "../module-base"} + + com.github.ben-manes.caffeine/caffeine + {:mvn/version "3.1.7"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {blaze/module-test-util + {:local/root "../module-test-util"}}} + + :kaocha + {:extra-deps + {lambdaisland/kaocha + {:mvn/version "1.85.1342"}} + + :main-opts ["-m" "kaocha.runner"]} + + :test-perf + {:extra-paths ["test-perf"] + + :extra-deps + {blaze/fhir-test-util + {:local/root "../fhir-test-util"} + + criterium/criterium + {:mvn/version "0.4.6"} + + org.openjdk.jol/jol-core + {:mvn/version "0.17"}}} + + :coverage + {:extra-deps + {cloverage/cloverage + {:mvn/version "1.2.4"}} + + :main-opts ["-m" "cloverage.coverage" "--codecov" "-p" "src" "-s" "test" + "-e" ".+spec"]}}} diff --git a/modules/db/src/blaze/db/cache_collector.clj b/modules/cache-collector/src/blaze/cache_collector.clj similarity index 80% rename from modules/db/src/blaze/db/cache_collector.clj rename to modules/cache-collector/src/blaze/cache_collector.clj index 599684c94..04d5ed003 100644 --- a/modules/db/src/blaze/db/cache_collector.clj +++ b/modules/cache-collector/src/blaze/cache_collector.clj @@ -1,7 +1,7 @@ -(ns blaze.db.cache-collector +(ns blaze.cache-collector (:require - [blaze.db.cache-collector.protocols :as p] - [blaze.db.cache-collector.spec] + [blaze.cache-collector.protocols :as p] + [blaze.cache-collector.spec] [blaze.metrics.core :as metrics] [clojure.spec.alpha :as s] [integrant.core :as ig]) @@ -42,49 +42,49 @@ [name (p/-stats cache) (p/-estimated-size cache)])))) -(defmethod ig/pre-init-spec :blaze.db/cache-collector [_] +(defmethod ig/pre-init-spec :blaze/cache-collector [_] (s/keys :req-un [::caches])) -(defmethod ig/init-key :blaze.db/cache-collector +(defmethod ig/init-key :blaze/cache-collector [_ {:keys [caches]}] (metrics/collector (let [stats (into [] mapper caches)] [(counter-metric - "blaze_db_cache_hits_total" + "blaze_cache_hits_total" "Returns the number of times Cache lookup methods have returned a cached value." (fn [stats _] (.hitCount ^CacheStats stats)) stats) (counter-metric - "blaze_db_cache_misses_total" + "blaze_cache_misses_total" "Returns the number of times Cache lookup methods have returned an uncached (newly loaded) value, or null." (fn [stats _] (.missCount ^CacheStats stats)) stats) (counter-metric - "blaze_db_cache_load_successes_total" + "blaze_cache_load_successes_total" "Returns the number of times Cache lookup methods have successfully loaded a new value." (fn [stats _] (.loadSuccessCount ^CacheStats stats)) stats) (counter-metric - "blaze_db_cache_load_failures_total" + "blaze_cache_load_failures_total" "Returns the number of times Cache lookup methods failed to load a new value, either because no value was found or an exception was thrown while loading." (fn [stats _] (.loadFailureCount ^CacheStats stats)) stats) (counter-metric - "blaze_db_cache_load_seconds_total" + "blaze_cache_load_seconds_total" "Returns the total number of seconds the cache has spent loading new values." (fn [stats _] (/ (double (.totalLoadTime ^CacheStats stats)) 1e9)) stats) (counter-metric - "blaze_db_cache_evictions_total" + "blaze_cache_evictions_total" "Returns the number of times an entry has been evicted." (fn [stats _] (.evictionCount ^CacheStats stats)) stats) (gauge-metric - "blaze_db_cache_estimated_size" + "blaze_cache_estimated_size" "Returns the approximate number of entries in this cache." (fn [_ estimated-size] estimated-size) stats)]))) -(derive :blaze.db/cache-collector :blaze.metrics/collector) +(derive :blaze/cache-collector :blaze.metrics/collector) diff --git a/modules/db/src/blaze/db/cache_collector/protocols.clj b/modules/cache-collector/src/blaze/cache_collector/protocols.clj similarity index 62% rename from modules/db/src/blaze/db/cache_collector/protocols.clj rename to modules/cache-collector/src/blaze/cache_collector/protocols.clj index b8224f17f..6b211f0ae 100644 --- a/modules/db/src/blaze/db/cache_collector/protocols.clj +++ b/modules/cache-collector/src/blaze/cache_collector/protocols.clj @@ -1,4 +1,4 @@ -(ns blaze.db.cache-collector.protocols) +(ns blaze.cache-collector.protocols) (defprotocol StatsCache diff --git a/modules/cache-collector/src/blaze/cache_collector/spec.clj b/modules/cache-collector/src/blaze/cache_collector/spec.clj new file mode 100644 index 000000000..7e4378a17 --- /dev/null +++ b/modules/cache-collector/src/blaze/cache_collector/spec.clj @@ -0,0 +1,8 @@ +(ns blaze.cache-collector.spec + (:require + [blaze.cache-collector.protocols :as p] + [clojure.spec.alpha :as s])) + + +(s/def :blaze.cache-collector/caches + (s/map-of string? (s/nilable #(satisfies? p/StatsCache %)))) diff --git a/modules/db/test/blaze/db/cache_collector_test.clj b/modules/cache-collector/test/blaze/cache_collector_test.clj similarity index 63% rename from modules/db/test/blaze/db/cache_collector_test.clj rename to modules/cache-collector/test/blaze/cache_collector_test.clj index 8b0f7d826..7ea7be27b 100644 --- a/modules/db/test/blaze/db/cache_collector_test.clj +++ b/modules/cache-collector/test/blaze/cache_collector_test.clj @@ -1,6 +1,6 @@ -(ns blaze.db.cache-collector-test +(ns blaze.cache-collector-test (:require - [blaze.db.cache-collector] + [blaze.cache-collector] [blaze.metrics.core :as metrics] [blaze.module.test-util :refer [with-system]] [blaze.test-util :as tu :refer [given-thrown]] @@ -25,55 +25,55 @@ (def config - {:blaze.db/cache-collector + {:blaze/cache-collector {:caches {"name-135224" cache "name-093214" nil}}}) (deftest init-test (testing "nil config" - (given-thrown (ig/init {:blaze.db/cache-collector nil}) - :key := :blaze.db/cache-collector + (given-thrown (ig/init {:blaze/cache-collector nil}) + :key := :blaze/cache-collector :reason := ::ig/build-failed-spec [:explain ::s/problems 0 :pred] := `map?)) (testing "missing config" - (given-thrown (ig/init {:blaze.db/cache-collector {}}) - :key := :blaze.db/cache-collector + (given-thrown (ig/init {:blaze/cache-collector {}}) + :key := :blaze/cache-collector :reason := ::ig/build-failed-spec [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :caches)))) (testing "invalid caches" - (given-thrown (ig/init {:blaze.db/cache-collector {:caches ::invalid}}) - :key := :blaze.db/cache-collector + (given-thrown (ig/init {:blaze/cache-collector {:caches ::invalid}}) + :key := :blaze/cache-collector :reason := ::ig/build-failed-spec [:explain ::s/problems 0 :pred] := `map? [:explain ::s/problems 0 :val] := ::invalid))) (deftest cache-collector-test - (with-system [{collector :blaze.db/cache-collector} config] + (with-system [{collector :blaze/cache-collector} config] (testing "all zero on fresh cache" (given (metrics/collect collector) - [0 :name] := "blaze_db_cache_hits" + [0 :name] := "blaze_cache_hits" [0 :type] := :counter [0 :samples 0 :value] := 0.0 - [1 :name] := "blaze_db_cache_misses" + [1 :name] := "blaze_cache_misses" [1 :type] := :counter [1 :samples 0 :value] := 0.0 - [2 :name] := "blaze_db_cache_load_successes" + [2 :name] := "blaze_cache_load_successes" [2 :type] := :counter [2 :samples 0 :value] := 0.0 - [3 :name] := "blaze_db_cache_load_failures" + [3 :name] := "blaze_cache_load_failures" [3 :type] := :counter [3 :samples 0 :value] := 0.0 - [4 :name] := "blaze_db_cache_load_seconds" + [4 :name] := "blaze_cache_load_seconds" [4 :type] := :counter [4 :samples 0 :value] := 0.0 - [5 :name] := "blaze_db_cache_evictions" + [5 :name] := "blaze_cache_evictions" [5 :type] := :counter [5 :samples 0 :value] := 0.0 - [6 :name] := "blaze_db_cache_estimated_size" + [6 :name] := "blaze_cache_estimated_size" [6 :type] := :gauge [6 :samples 0 :value] := 0.0)) @@ -82,17 +82,17 @@ (Thread/sleep 100) (given (metrics/collect collector) - [0 :name] := "blaze_db_cache_hits" + [0 :name] := "blaze_cache_hits" [0 :samples 0 :value] := 0.0 - [1 :name] := "blaze_db_cache_misses" + [1 :name] := "blaze_cache_misses" [1 :samples 0 :value] := 1.0 - [2 :name] := "blaze_db_cache_load_successes" + [2 :name] := "blaze_cache_load_successes" [2 :samples 0 :value] := 1.0 - [3 :name] := "blaze_db_cache_load_failures" + [3 :name] := "blaze_cache_load_failures" [3 :samples 0 :value] := 0.0 - [5 :name] := "blaze_db_cache_evictions" + [5 :name] := "blaze_cache_evictions" [5 :samples 0 :value] := 0.0 - [6 :name] := "blaze_db_cache_estimated_size" + [6 :name] := "blaze_cache_estimated_size" [6 :samples 0 :value] := 1.0)) (testing "one loads and one hit" @@ -100,15 +100,15 @@ (Thread/sleep 100) (given (metrics/collect collector) - [0 :name] := "blaze_db_cache_hits" + [0 :name] := "blaze_cache_hits" [0 :samples 0 :value] := 1.0 - [1 :name] := "blaze_db_cache_misses" + [1 :name] := "blaze_cache_misses" [1 :samples 0 :value] := 1.0 - [2 :name] := "blaze_db_cache_load_successes" + [2 :name] := "blaze_cache_load_successes" [2 :samples 0 :value] := 1.0 - [3 :name] := "blaze_db_cache_load_failures" + [3 :name] := "blaze_cache_load_failures" [3 :samples 0 :value] := 0.0 - [5 :name] := "blaze_db_cache_evictions" + [5 :name] := "blaze_cache_evictions" [5 :samples 0 :value] := 0.0 - [6 :name] := "blaze_db_cache_estimated_size" + [6 :name] := "blaze_cache_estimated_size" [6 :samples 0 :value] := 1.0)))) diff --git a/modules/cache-collector/tests.edn b/modules/cache-collector/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/cache-collector/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/cassandra/.clj-kondo/config.edn b/modules/cassandra/.clj-kondo/config.edn index e3b746ad7..97e80c930 100644 --- a/modules/cassandra/.clj-kondo/config.edn +++ b/modules/cassandra/.clj-kondo/config.edn @@ -12,6 +12,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/cql/src/blaze/elm/code.clj b/modules/cql/src/blaze/elm/code.clj index 15ac0b9e0..bce654696 100644 --- a/modules/cql/src/blaze/elm/code.clj +++ b/modules/cql/src/blaze/elm/code.clj @@ -1,6 +1,7 @@ (ns blaze.elm.code "Implementation of the code type." (:require + [blaze.elm.compiler.core :as core] [blaze.elm.concept :as concept] [blaze.elm.protocols :as p])) @@ -21,7 +22,15 @@ p/Descendents (descendents [_] - [code nil system version])) + [code nil system version]) + + core/Expression + (-static [_] + true) + (-eval [this _ _ _] + this) + (-form [_] + `(~'code ~system ~version ~code))) (defn to-code diff --git a/modules/cql/src/blaze/elm/compiler/arithmetic_operators.clj b/modules/cql/src/blaze/elm/compiler/arithmetic_operators.clj index ee9dc7197..7fd8a573e 100644 --- a/modules/cql/src/blaze/elm/compiler/arithmetic_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/arithmetic_operators.clj @@ -43,11 +43,17 @@ (p/floor x)) +;; TODO: 16.7. HighBoundary + + ;; 16.8. Log (defbinop log [x base] (p/log x base)) +;; TODO: 16.9. LowBoundary + + ;; 16.10. Ln (defunop ln [x] (p/ln x)) @@ -123,6 +129,9 @@ (p/power x exp)) +;; TODO: 16.17. Precision + + ;; 16.18. Predecessor (defunop predecessor [x] (p/predecessor x)) @@ -136,6 +145,8 @@ (if (and (core/static? operand) (core/static? precision)) (p/round operand precision) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (p/round (core/-eval operand context resource scope) (core/-eval precision context resource scope))) diff --git a/modules/cql/src/blaze/elm/compiler/clinical_operators.clj b/modules/cql/src/blaze/elm/compiler/clinical_operators.clj index b1c77f43c..49f5f031a 100644 --- a/modules/cql/src/blaze/elm/compiler/clinical_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/clinical_operators.clj @@ -20,6 +20,8 @@ (when-let [date (core/compile* context date)] (let [chrono-precision (some-> precision core/to-chrono-unit)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (p/duration-between (core/-eval birth-date context resource scope) diff --git a/modules/cql/src/blaze/elm/compiler/conditional_operators.clj b/modules/cql/src/blaze/elm/compiler/conditional_operators.clj index 89d53e456..7b2ccc72b 100644 --- a/modules/cql/src/blaze/elm/compiler/conditional_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/conditional_operators.clj @@ -9,47 +9,49 @@ ;; 15.1. Case -(defrecord ComparandCaseExpression [comparand items else] - core/Expression - (-eval [_ context resource scope] - (let [comparand (core/-eval comparand context resource scope)] - (loop [[{:keys [when then]} & next-items] items] - (if (p/equal comparand (core/-eval when context resource scope)) - (core/-eval then context resource scope) - (if (empty? next-items) - (core/-eval else context resource scope) - (recur next-items))))))) - - -(defrecord MultiConditionalCaseExpression [items else] - core/Expression - (-eval [_ context resource scope] - (loop [[{:keys [when then]} & next-items] items] - (if (core/-eval when context resource scope) - (core/-eval then context resource scope) - (if (empty? next-items) - (core/-eval else context resource scope) - (recur next-items)))))) - - (defmethod core/compile* :elm.compiler.type/case [context {:keys [comparand else] items :caseItem}] (let [comparand (some->> comparand (core/compile* context)) items - (mapv + (map (fn [{:keys [when then]}] - {:when (core/compile* context when) - :then (core/compile* context then)}) + [(core/compile* context when) + (core/compile* context then)]) items) else (core/compile* context else)] (if comparand - (->ComparandCaseExpression comparand items else) - (->MultiConditionalCaseExpression items else)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (let [comparand (core/-eval comparand context resource scope)] + (loop [[[when then] & next-items] items] + (if (p/equal comparand (core/-eval when context resource scope)) + (core/-eval then context resource scope) + (if (empty? next-items) + (core/-eval else context resource scope) + (recur next-items)))))) + (-form [_] + `(~'case ~(core/-form comparand) ~@(map core/-form (flatten items)) ~else))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (loop [[[when then] & next-items] items] + (if (core/-eval when context resource scope) + (core/-eval then context resource scope) + (if (empty? next-items) + (core/-eval else context resource scope) + (recur next-items))))) + (-form [_] + `(~'case ~@(map core/-form (flatten items)) ~else)))))) ;; 15.2. If (defrecord IfExpression [condition then else] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (if (core/-eval condition context resource scope) (core/-eval then context resource scope) diff --git a/modules/cql/src/blaze/elm/compiler/core.clj b/modules/cql/src/blaze/elm/compiler/core.clj index db21cf4b9..813200722 100644 --- a/modules/cql/src/blaze/elm/compiler/core.clj +++ b/modules/cql/src/blaze/elm/compiler/core.clj @@ -12,6 +12,7 @@ (defprotocol Expression + (-static [expression]) (-eval [expression context resource scope] "Evaluates `expression` on `resource` using `context` and optional `scope` for scoped expressions inside queries.") @@ -24,12 +25,16 @@ (extend-protocol Expression nil + (-static [_] + true) (-eval [expr _ _ _] expr) (-form [_] 'nil) Object + (-static [_] + true) (-eval [expr _ _ _] expr) (-form [expr] @@ -37,7 +42,7 @@ (defn static? [x] - (not (instance? blaze.elm.compiler.core.Expression x))) + (-static x)) (defmulti compile* diff --git a/modules/cql/src/blaze/elm/compiler/date_time_operators.clj b/modules/cql/src/blaze/elm/compiler/date_time_operators.clj index 04dc5fc61..be0c08f03 100644 --- a/modules/cql/src/blaze/elm/compiler/date_time_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/date_time_operators.clj @@ -28,64 +28,6 @@ (.toLocalDateTime))) -(defrecord YearExpression [year] - system/SystemType - (-type [_] :system/date) - core/Expression - (-eval [_ context resource scope] - (some-> (core/-eval year context resource scope) system/date))) - - -(defrecord DateTimeYearExpression [year] - core/Expression - (-eval [_ context resource scope] - (some-> (core/-eval year context resource scope) system/date-time))) - - -(defrecord YearMonthExpression [year month] - system/SystemType - (-type [_] :system/date) - core/Expression - (-eval [_ context resource scope] - (when-let [year (core/-eval year context resource scope)] - (if-let [month (core/-eval month context resource scope)] - (system/date year month) - (system/date year))))) - - -(defrecord DateTimeYearMonthExpression [year month] - core/Expression - (-eval [_ context resource scope] - (when-let [year (core/-eval year context resource scope)] - (if-let [month (core/-eval month context resource scope)] - (system/date-time year month) - (system/date-time year))))) - - -(defrecord LocalDateExpression [year month day] - system/SystemType - (-type [_] :system/date) - core/Expression - (-eval [_ context resource scope] - (when-let [year (core/-eval year context resource scope)] - (if-let [month (core/-eval month context resource scope)] - (if-let [day (core/-eval day context resource scope)] - (system/date year month day) - (system/date year month)) - (system/date year))))) - - -(defrecord DateTimeYearMonthDayExpression [year month day] - core/Expression - (-eval [_ context resource scope] - (when-let [year (core/-eval year context resource scope)] - (if-let [month (core/-eval month context resource scope)] - (if-let [day (core/-eval day context resource scope)] - (system/date-time year month day) - (system/date-time year month)) - (system/date-time year))))) - - ;; 18.6. Date (defmethod core/compile* :elm.compiler.type/date [context {:keys [year month day]}] @@ -97,19 +39,55 @@ (system/date year month day) (some? day) - (->LocalDateExpression year month day) + (reify + system/SystemType + (-type [_] :system/date) + core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (when-let [year (core/-eval year context resource scope)] + (if-let [month (core/-eval month context resource scope)] + (if-let [day (core/-eval day context resource scope)] + (system/date year month day) + (system/date year month)) + (system/date year)))) + (-form [_] + (list 'date (core/-form year) (core/-form month) (core/-form day)))) (and (int? month) (int? year)) (system/date year month) (some? month) - (->YearMonthExpression year month) + (reify + system/SystemType + (-type [_] :system/date) + core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (when-let [year (core/-eval year context resource scope)] + (if-let [month (core/-eval month context resource scope)] + (system/date year month) + (system/date year)))) + (-form [_] + (list 'date (core/-form year) (core/-form month)))) (int? year) (system/date year) :else - (some-> year ->YearExpression)))) + (when year + (reify + system/SystemType + (-type [_] :system/date) + core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (some-> (core/-eval year context resource scope) system/date)) + (-form [_] + (list 'date (core/-form year)))))))) ;; 18.7. DateFrom @@ -136,12 +114,21 @@ (and (int? millisecond) (int? second) (int? minute) (int? hour) (int? day) (int? month) (int? year)) (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [now]} _ _] (to-local-date-time-with-offset - now year month day hour minute second millisecond timezone-offset))) + now year month day hour minute second millisecond timezone-offset)) + (-form [_] + (list 'date-time (core/-form year) (core/-form month) + (core/-form day) (core/-form hour) (core/-form minute) + (core/-form second) (core/-form millisecond) + (core/-form timezone-offset)))) (some? hour) (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [now] :as context} resource scope] (to-local-date-time-with-offset now @@ -152,7 +139,12 @@ (or (core/-eval minute context resource scope) 0) (or (core/-eval second context resource scope) 0) (or (core/-eval millisecond context resource scope) 0) - timezone-offset))) + timezone-offset)) + (-form [_] + (list 'date-time (core/-form year) (core/-form month) + (core/-form day) (core/-form hour) (core/-form minute) + (core/-form second) (core/-form millisecond) + (core/-form timezone-offset)))) :else (throw (ex-info "Need at least an hour if timezone offset is given." @@ -161,6 +153,8 @@ (some? timezone-offset) (if (some? hour) (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [now] :as context} resource scope] (to-local-date-time-with-offset now @@ -171,7 +165,12 @@ (or (core/-eval minute context resource scope) 0) (or (core/-eval second context resource scope) 0) (or (core/-eval millisecond context resource scope) 0) - (core/-eval timezone-offset context resource scope)))) + (core/-eval timezone-offset context resource scope))) + (-form [_] + (list 'date-time (core/-form year) (core/-form month) + (core/-form day) (core/-form hour) (core/-form minute) + (core/-form second) (core/-form millisecond) + (core/-form timezone-offset)))) (throw (ex-info "Need at least an hour if timezone offset is given." {:expression expression}))) @@ -183,6 +182,8 @@ (some? hour) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (system/date-time (core/-eval year context resource scope) @@ -191,25 +192,57 @@ (core/-eval hour context resource scope) (or (core/-eval minute context resource scope) 0) (or (core/-eval second context resource scope) 0) - (or (core/-eval millisecond context resource scope) 0)))) + (or (core/-eval millisecond context resource scope) 0))) + (-form [_] + (list 'date-time (core/-form year) (core/-form month) + (core/-form day) (core/-form hour) (core/-form minute) + (core/-form second) (core/-form millisecond)))) (and (int? day) (int? month) (int? year)) (system/date-time year month day) (some? day) - (->DateTimeYearMonthDayExpression year month day) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (when-let [year (core/-eval year context resource scope)] + (if-let [month (core/-eval month context resource scope)] + (if-let [day (core/-eval day context resource scope)] + (system/date-time year month day) + (system/date-time year month)) + (system/date-time year)))) + (-form [_] + (list 'date-time (core/-form year) (core/-form month) + (core/-form day)))) (and (int? month) (int? year)) (system/date-time year month) (some? month) - (->DateTimeYearMonthExpression year month) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (when-let [year (core/-eval year context resource scope)] + (if-let [month (core/-eval month context resource scope)] + (system/date-time year month) + (system/date-time year)))) + (-form [_] + (list 'date-time (core/-form year) (core/-form month)))) (int? year) (system/date-time year) :else - (some-> year ->DateTimeYearExpression))))) + (when year + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (some-> (core/-eval year context resource scope) system/date-time)) + (-form [_] + (list 'date-time (core/-form year))))))))) ;; 18.9. DateTimeComponentFrom @@ -230,6 +263,8 @@ ;; 18.13. Now (defrecord NowExpression [] core/Expression + (-static [_] + false) (-eval [_ {:keys [now]} _ _] now)) @@ -269,48 +304,66 @@ (some? millisecond) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (date-time/local-time (core/-eval hour context resource scope) (core/-eval minute context resource scope) (core/-eval second context resource scope) - (core/-eval millisecond context resource scope)))) + (core/-eval millisecond context resource scope))) + (-form [_] + (list 'time (core/-form hour) (core/-form minute) (core/-form second) + (core/-form millisecond)))) (and (int? second) (int? minute) (int? hour)) (date-time/local-time hour minute second) (some? second) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (date-time/local-time (core/-eval hour context resource scope) (core/-eval minute context resource scope) - (core/-eval second context resource scope)))) + (core/-eval second context resource scope))) + (-form [_] + (list 'time (core/-form hour) (core/-form minute) (core/-form second)))) (and (int? minute) (int? hour)) (date-time/local-time hour minute) (some? minute) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (date-time/local-time (core/-eval hour context resource scope) - (core/-eval minute context resource scope)))) + (core/-eval minute context resource scope))) + (-form [_] + (list 'time (core/-form hour) (core/-form minute)))) (int? hour) (date-time/local-time hour) :else (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] - (date-time/local-time (core/-eval hour context resource scope))))))) - - -(defrecord TimeOfDayExpression [] - core/Expression - (-eval [_ {:keys [now]} _ _] - (.toLocalTime ^OffsetDateTime now))) + (date-time/local-time (core/-eval hour context resource scope))) + (-form [_] + (list 'time (core/-form hour))))))) (def ^:private time-of-day-expr - (->TimeOfDayExpression)) + (reify + core/Expression + (-static [_] + false) + (-eval [_ {:keys [now]} _ _] + (.toLocalTime ^OffsetDateTime now)) + (-form [_] + 'time-of-day))) ;; 18.21. TimeOfDay @@ -321,6 +374,8 @@ (def ^:private today-expr (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [now]} _ _] (DateDate/fromLocalDate (.toLocalDate ^OffsetDateTime now))) (-form [_] diff --git a/modules/cql/src/blaze/elm/compiler/external_data.clj b/modules/cql/src/blaze/elm/compiler/external_data.clj index 358f98329..65cc358f4 100644 --- a/modules/cql/src/blaze/elm/compiler/external_data.clj +++ b/modules/cql/src/blaze/elm/compiler/external_data.clj @@ -17,15 +17,29 @@ (:import [blaze.elm.compiler.structured_values SourcePropertyExpression] [clojure.lang ILookup] + [java.nio.charset StandardCharsets] [java.util List])) (set! *warn-on-reflection* true) +(definterface Resource + (^void hashInto [^com.google.common.hash.Hasher hasher])) + + +(defn hash-into! [resource hasher] + (.hashInto ^Resource resource hasher)) + + ;; A resource that is a wrapper of a resource-handle that will lazily pull the ;; resource content if some property other than :id is accessed. -(deftype Resource [db handle content] +(deftype ResourceImpl [db ^String id handle ^long last-change-t content] + Resource + (hashInto [_ hasher] + (.putString hasher id StandardCharsets/US_ASCII) + (.putLong hasher last-change-t)) + p/FhirType (-type [_] (p/-type handle)) @@ -35,7 +49,7 @@ (.valAt r key nil)) (valAt [_ key not-found] (case key - :id (rh/id handle) + :id id (-> (or @content (vreset! content @(d/pull-content db handle))) (get key not-found))))) @@ -44,30 +58,25 @@ (instance? Resource x)) -(defn mk-resource [db handle] - (Resource. db handle (volatile! nil))) +(defn- patient-last-change-t [db handle] + (max (or (d/patient-compartment-last-change-t db (rh/id handle)) (d/t db)) + (rh/t handle))) -(defn resource-mapper [db] - (map (partial mk-resource db))) +(defn- last-change-t [db handle] + (case (p/-type handle) + :fhir/Patient + (patient-last-change-t db handle) + (d/t db))) -(defrecord CompartmentListRetrieveExpression [context data-type] - core/Expression - (-eval [_ {:keys [db]} {:keys [id]} _] - (coll/eduction - (resource-mapper db) - (d/list-compartment-resource-handles db context id data-type))) - (-form [_] - `(~'compartment-list-retrieve ~data-type))) +(defn mk-resource [db handle] + (ResourceImpl. db (rh/id handle) handle (last-change-t db handle) + (volatile! nil))) -(defrecord CompartmentQueryRetrieveExpression [query data-type clauses] - core/Expression - (-eval [_ {:keys [db]} {:keys [id]} _] - (coll/eduction (resource-mapper db) (d/execute-query db query id))) - (-form [_] - `(~'compartment-query-retrieve ~data-type ~clauses))) +(defn resource-mapper [db] + (map (partial mk-resource db))) (defn- code->clause-value [{:keys [system code]}] @@ -102,7 +111,13 @@ [node context data-type property codes] (let [clauses (-to-clauses codes property) query (d/compile-compartment-query node context data-type clauses)] - (->CompartmentQueryRetrieveExpression query data-type clauses))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [db]} {:keys [id]} _] + (coll/eduction (resource-mapper db) (d/execute-query db query id))) + (-form [_] + `(~'retrieve ~data-type ~(d/query-clauses query)))))) (defn- split-reference [s] @@ -113,6 +128,8 @@ ;; TODO: find a better solution than hard coding this case (defrecord SpecimenPatientExpression [] core/Expression + (-static [_] + false) (-eval [_ {:keys [db]} resource _] (let [{{:keys [reference]} :subject} resource] (when reference @@ -120,7 +137,9 @@ (when (and (= "Patient" type) (string? id)) (let [{:keys [op] :as handle} (d/resource-handle db "Patient" id)] (when-not (identical? :delete op) - [(mk-resource db handle)])))))))) + [(mk-resource db handle)]))))))) + (-form [_] + '(retrieve (Specimen) "Patient"))) (def ^:private specimen-patient-expr @@ -136,56 +155,33 @@ (case data-type "Patient" specimen-patient-expr) - (->CompartmentListRetrieveExpression context data-type))) - - -(defrecord ResourceRetrieveExpression [] - core/Expression - (-eval [_ _ resource _] - [resource]) - (-form [_] - (list 'retrieve-resource))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [db]} {:keys [id]} _] + (coll/eduction + (resource-mapper db) + (d/list-compartment-resource-handles db context id data-type))) + (-form [_] + `(~'retrieve ~data-type))))) (def ^:private resource-expr - (->ResourceRetrieveExpression)) - - -(defrecord WithRelatedContextRetrieveExpression - [related-context-expr data-type] - core/Expression - (-eval [_ context resource scope] - (when-let [context-resource (core/-eval related-context-expr context resource scope)] - (core/-eval - (context-expr (-> context-resource :fhir/type name) data-type) - context - context-resource - scope)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ _ resource _] + [resource]) + (-form [_] + '(retrieve-resource)))) -(defrecord WithRelatedContextQueryRetrieveExpression - [context-expr query] - core/Expression - (-eval [_ {:keys [db] :as context} resource scope] - (when-let [{:keys [id]} (core/-eval context-expr context resource scope)] - (when (string? id) - (coll/eduction - (resource-mapper db) - (d/execute-query db query id)))))) +(defn- unsupported-type-ns-anom [value-type-ns] + (ba/unsupported (format "Unsupported related context retrieve expression with result type namespace of `%s`." value-type-ns))) -(defrecord WithRelatedContextCodeRetrieveExpression - [context-expr data-type clauses] - core/Expression - (-eval [_ {:keys [db] :as context} resource scope] - (when-let [{:fhir/keys [type] :keys [id]} - (core/-eval context-expr context resource scope)] - (when-let [type (some-> type name)] - (when id - (ba/throw-when - (coll/eduction - (resource-mapper db) - (d/compartment-query db type id data-type clauses)))))))) +(def ^:private unsupported-related-context-expr-without-type-anom + (ba/unsupported "Unsupported related context retrieve expression without result type.")) (defn related-context-expr @@ -196,21 +192,39 @@ (if (= "http://hl7.org/fhir" value-type-ns) (let [clauses [(into [code-property] (map code->clause-value) codes)]] (if-ok [query (d/compile-compartment-query node context-type data-type clauses)] - (->WithRelatedContextQueryRetrieveExpression context-expr query) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [db] :as context} resource scope] + (when-let [{:keys [id]} (core/-eval context-expr context resource scope)] + (when (string? id) + (coll/eduction + (resource-mapper db) + (d/execute-query db query id))))) + (-form [_] + (list 'retrieve (core/-form context-expr) data-type (d/query-clauses query)))) ba/throw-anom)) - - (->WithRelatedContextCodeRetrieveExpression - context-expr data-type - [(cons code-property (map code->clause-value codes))]))) - (->WithRelatedContextCodeRetrieveExpression - context-expr data-type - [(cons code-property (map code->clause-value codes))])) - (->WithRelatedContextRetrieveExpression context-expr data-type))) + (ba/throw-anom (unsupported-type-ns-anom value-type-ns)))) + (ba/throw-anom unsupported-related-context-expr-without-type-anom)) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (when-let [context-resource (core/-eval related-context-expr context resource scope)] + (core/-eval + (context-expr (-> context-resource :fhir/type name) data-type) + context + context-resource + scope))) + (-form [_] + (list 'retrieve (core/-form context-expr) data-type))))) (defn- unfiltered-context-expr [node data-type code-property codes] (if (empty? codes) (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [db]} _ _] (coll/eduction (resource-mapper db) (d/type-list db data-type))) (-form [_] @@ -218,8 +232,12 @@ (let [clauses [(into [code-property] (map code->clause-value) codes)]] (if-ok [query (d/compile-type-query node data-type clauses)] (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [db]} _ _] - (coll/eduction (resource-mapper db) (d/execute-query db query)))) + (coll/eduction (resource-mapper db) (d/execute-query db query))) + (-form [_] + `(~'retrieve ~data-type ~(d/query-clauses query)))) ba/throw-anom)))) diff --git a/modules/cql/src/blaze/elm/compiler/function.clj b/modules/cql/src/blaze/elm/compiler/function.clj index ece770ad5..e9cefd97c 100644 --- a/modules/cql/src/blaze/elm/compiler/function.clj +++ b/modules/cql/src/blaze/elm/compiler/function.clj @@ -5,6 +5,8 @@ (defn arity-n [name fn-expr operand-names operands] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (let [values (map #(core/-eval % context resource scope) operands)] (core/-eval fn-expr context resource (merge scope (zipmap operand-names values))))) diff --git a/modules/cql/src/blaze/elm/compiler/interval_operators.clj b/modules/cql/src/blaze/elm/compiler/interval_operators.clj index c680697cc..2aa313a7f 100644 --- a/modules/cql/src/blaze/elm/compiler/interval_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/interval_operators.clj @@ -22,6 +22,8 @@ [type low high low-closed-expression high-closed-expression low-closed high-closed] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (let [low (core/-eval low context resource scope) high (core/-eval high context resource scope) diff --git a/modules/cql/src/blaze/elm/compiler/list_operators.clj b/modules/cql/src/blaze/elm/compiler/list_operators.clj index 6a633d36e..40e8233f0 100644 --- a/modules/cql/src/blaze/elm/compiler/list_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/list_operators.clj @@ -15,19 +15,22 @@ [clojure.lang ExceptionInfo])) -;; 20.1. List -(defrecord ListOperatorExpression [elements] - core/Expression - (-eval [_ context resource scope] - (mapv #(core/-eval % context resource scope) elements))) +(set! *warn-on-reflection* true) +;; 20.1. List (defmethod core/compile* :elm.compiler.type/list [context {elements :element}] (let [elements (mapv #(core/compile* context %) elements)] (if (every? core/static? elements) elements - (->ListOperatorExpression elements)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (mapv #(core/-eval % context resource scope) elements)) + (-form [_] + `(~'list ~@(map core/-form elements))))))) ;; 20.3. Current @@ -35,11 +38,19 @@ [_ {:keys [scope]}] (if scope (reify core/Expression + (-static [_] + false) (-eval [_ _ _ scopes] - (get scopes scope))) + (get scopes scope)) + (-form [_] + (list 'current scope))) (reify core/Expression + (-static [_] + false) (-eval [_ _ _ scope] - scope)))) + scope) + (-form [_] + 'current)))) ;; 20.4. Distinct @@ -58,7 +69,8 @@ ;; 20.8. Exists (defunop exists - {:optimizations #{:first :non-distinct}} + {:optimizations #{:first :non-distinct} + :cache true} [list] (not (coll/empty? list))) @@ -70,36 +82,41 @@ condition (core/compile* context condition)] (if scope (reify core/Expression + (-static [_] + false) (-eval [_ context resource scopes] (when-let [source (core/-eval source context resource scopes)] (filterv (fn [x] (core/-eval condition context resource (assoc scopes scope x))) - source)))) + source))) + (-form [_] + (list 'filter (core/-form source) (core/-form condition) scope))) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scopes] (when-let [source (core/-eval source context resource scopes)] - (filterv - (fn [_] - (core/-eval condition context resource scopes)) - source))))))) + (filterv (partial core/-eval condition context resource) source))) + (-form [_] + (list 'filter (core/-form source) (core/-form condition))))))) ;; 20.10. First ;; ;; TODO: orderBy -(defrecord FirstExpression [source] - core/Expression - (-eval [_ context resource scopes] - (coll/first (core/-eval source context resource scopes)))) - - (defmethod core/compile* :elm.compiler.type/first [context {:keys [source]}] (let [source (core/compile* (assoc context :optimizations #{:first :non-distinct}) source)] (if (core/static? source) (first source) - (->FirstExpression source)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scopes] + (coll/first (core/-eval source context resource scopes))) + (-form [_] + (list 'first (core/-form source))))))) ;; 20.11. Flatten @@ -123,19 +140,24 @@ element (core/compile* context element)] (if scope (reify core/Expression + (-static [_] + false) (-eval [_ context resource scopes] (when-let [source (core/-eval source context resource scopes)] (mapv (fn [x] (core/-eval element context resource (assoc scopes scope x))) - source)))) + source))) + (-form [_] + (list 'for-each (core/-form source) (core/-form element) scope))) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scopes] (when-let [source (core/-eval source context resource scopes)] - (mapv - (fn [_] - (core/-eval element context resource scopes)) - source))))))) + (mapv (partial core/-eval element context resource) source))) + (-form [_] + (list 'for-each (core/-form source) (core/-form element))))))) ;; 20.16. IndexOf @@ -144,6 +166,8 @@ (let [source (core/compile* context source) element (core/compile* context element)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scopes] (when-let [source (core/-eval source context resource scopes)] (when-let [element (core/-eval element context resource scopes)] @@ -155,7 +179,9 @@ (p/equal element x) idx)) source)) - -1))))))) + -1)))) + (-form [_] + (list 'index-of (core/-form source) (core/-form element)))))) ;; 20.18. Last @@ -164,9 +190,15 @@ (defmethod core/compile* :elm.compiler.type/last [context {:keys [source]}] (let [source (core/compile* context source)] - (reify core/Expression - (-eval [_ context resource scopes] - (peek (core/-eval source context resource scopes)))))) + (if (core/static? source) + (peek source) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scopes] + (peek (core/-eval source context resource scopes))) + (-form [_] + (list 'last (core/-form source))))))) ;; 20.24. Repeat @@ -188,23 +220,20 @@ (defmethod core/compile* :elm.compiler.type/slice [context {:keys [source] start-index :startIndex end-index :endIndex}] (let [source (core/compile* context source) - start-index (some->> start-index (core/compile* context)) - end-index (some->> end-index (core/compile* context))] + start-index (core/compile* context start-index) + end-index (core/compile* context end-index)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scopes] (when-let [source (core/-eval source context resource scopes)] (let [start-index (or (core/-eval start-index context resource scopes) 0) end-index (or (core/-eval end-index context resource scopes) (count source))] (if (or (neg? start-index) (< end-index start-index)) [] - (subvec source start-index end-index)))))))) - - -(defrecord SortByDirectionExpression [source comp] - core/Expression - (-eval [_ context resource scopes] - (when-let [source (core/-eval source context resource scopes)] - (sort-by identity comp source)))) + (subvec source start-index end-index))))) + (-form [_] + (list 'slice (core/-form source) (core/-form start-index) (core/-form end-index)))))) ;; 20.27. Sort @@ -217,7 +246,15 @@ (fn [source {:keys [type direction]}] (case type "ByDirection" - (->SortByDirectionExpression source (queries/comparator direction)))) + (let [comp (queries/comparator direction)] + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scopes] + (when-let [source (core/-eval source context resource scopes)] + (sort-by identity comp source))) + (-form [_] + (list 'sort (core/-form source) (keyword direction))))))) source sort-by-items))) diff --git a/modules/cql/src/blaze/elm/compiler/logical_operators.clj b/modules/cql/src/blaze/elm/compiler/logical_operators.clj index b19361ee6..1d0829ba4 100644 --- a/modules/cql/src/blaze/elm/compiler/logical_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/logical_operators.clj @@ -11,6 +11,8 @@ ;; 13.1. And (defn- nil-and-expr [x] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when (false? (core/-eval x context resource scope)) false)) @@ -37,6 +39,8 @@ false false nil (nil-and-expr a) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (let [a (core/-eval a context resource scope)] (if (false? a) @@ -74,6 +78,8 @@ ;; 13.4. Or (defn- nil-or-expr [x] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when (true? (core/-eval x context resource scope)) true)) @@ -100,6 +106,8 @@ false a nil (nil-or-expr a) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (let [a (core/-eval a context resource scope)] (if (true? a) @@ -130,6 +138,8 @@ (condp identical? b true (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (let [a (core/-eval a context resource scope)] (when (some? a) @@ -139,6 +149,8 @@ false a nil nil (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-some [a (core/-eval a context resource scope)] (when-some [b (core/-eval b context resource scope)] diff --git a/modules/cql/src/blaze/elm/compiler/macros.clj b/modules/cql/src/blaze/elm/compiler/macros.clj index 9bbfa40d6..3cbc7c017 100644 --- a/modules/cql/src/blaze/elm/compiler/macros.clj +++ b/modules/cql/src/blaze/elm/compiler/macros.clj @@ -1,45 +1,74 @@ (ns blaze.elm.compiler.macros (:require - [blaze.elm.compiler.core :as core])) + [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.external-data :as ed] + [blaze.elm.expression :as-alias expr]) + (:import + [com.github.benmanes.caffeine.cache Cache] + [com.google.common.hash Hasher Hashing] + [java.util.function Function])) +(set! *warn-on-reflection* true) + (defn- compile-kw [name] (keyword "elm.compiler.type" (clojure.core/name name))) +(defn cache-key [resource operand-hash] + (let [^Hasher hasher (.newHasher (Hashing/farmHashFingerprint64))] + (.putInt hasher (int operand-hash)) + (when resource + (ed/hash-into! resource hasher)) + (.hash hasher))) + + +(defmacro compute [cache resource operand-hash & body] + `(let [key# (cache-key ~resource ~operand-hash)] + (.get ~(vary-meta cache assoc :tag `Cache) + key# + (reify Function (~'apply [~'_ ~'_] ~@body))))) + + (defmacro defunop {:arglists '([name attr-map? bindings & body])} [name & more] (let [attr-map (when (map? (first more)) (first more)) more (if (map? (first more)) (next more) more) - [[operand-binding expr-binding] & body] more] - (if expr-binding - `(defmethod core/compile* ~(compile-kw name) - [context# expr#] - (let [operand# (core/compile* (merge context# ~attr-map) (:operand expr#))] - (if (core/static? operand#) - (let [~operand-binding operand# - ~expr-binding expr#] - ~@body) - (reify core/Expression - (~'-eval [~'_ context# resource# scope#] - (let [~operand-binding (core/-eval operand# context# resource# scope#) - ~expr-binding expr#] - ~@body)) - (~'-form [~'_] - (list (quote ~name) (core/-form operand#))))))) - `(defmethod core/compile* ~(compile-kw name) - [context# expr#] - (let [operand# (core/compile* (merge context# ~attr-map) (:operand expr#))] - (if (core/static? operand#) - (let [~operand-binding operand#] - ~@body) - (reify core/Expression - (~'-eval [~'_ context# resource# scope#] - (let [~operand-binding (core/-eval operand# context# resource# scope#)] - ~@body)) - (~'-form [~'_] - (list (quote ~name) (core/-form operand#)))))))))) + [[operand-binding expr-binding] & body] more + operand-sym (gensym "operand") + expr-sym (gensym "expr")] + `(defmethod core/compile* ~(compile-kw name) + [context# ~expr-sym] + (let [~operand-sym (core/compile* (merge context# ~(dissoc attr-map :cache)) (:operand ~expr-sym))] + (if (core/static? ~operand-sym) + (let [~operand-binding ~operand-sym + ~(or expr-binding '_) ~expr-sym] + ~@body) + ~(if (:cache attr-map) + `(let [operand-hash# (hash (core/-form ~operand-sym))] + (reify core/Expression + (~'-static [~'_] + false) + (~'-eval [~'_ context# resource# scope#] + (compute + (::expr/cache context#) + resource# + operand-hash# + (let [~operand-binding (core/-eval ~operand-sym context# resource# scope#) + ~(or expr-binding '_) ~expr-sym] + ~@body))) + (~'-form [~'_] + (list (quote ~name) (core/-form ~operand-sym))))) + `(reify core/Expression + (~'-static [~'_] + false) + (~'-eval [~'_ context# resource# scope#] + (let [~operand-binding (core/-eval ~operand-sym context# resource# scope#) + ~(or expr-binding '_) ~expr-sym] + ~@body)) + (~'-form [~'_] + (list (quote ~name) (core/-form ~operand-sym)))))))))) (defmacro defbinop @@ -58,6 +87,8 @@ ~op-2-binding operand-2#] ~@body) (reify core/Expression + (~'-static [~'_] + false) (~'-eval [~'_ context# resource# scope#] (let [~op-1-binding (core/-eval operand-1# context# resource# scope#) ~op-2-binding (core/-eval operand-2# context# resource# scope#)] @@ -75,11 +106,16 @@ operand-2# (core/compile* context# operand-2#) operand-3# (core/compile* context# operand-3#)] (reify core/Expression + (~'-static [~'_] + false) (~'-eval [~'_ context# resource# scope#] (let [~op-1-binding (core/-eval operand-1# context# resource# scope#) ~op-2-binding (core/-eval operand-2# context# resource# scope#) ~op-3-binding (core/-eval operand-3# context# resource# scope#)] - ~@body)))))) + ~@body)) + (~'-form [~'_] + (list (quote ~name) (core/-form operand-1#) (core/-form operand-2#) + (core/-form operand-3#))))))) (defmacro defnaryop @@ -89,6 +125,8 @@ [context# {operands# :operand}] (let [operands# (mapv #(core/compile* context# %) operands#)] (reify core/Expression + (~'-static [~'_] + false) (~'-eval [~'_ context# resource# scope#] (let [~operands-binding (mapv #(core/-eval % context# resource# scope#) operands#)] ~@body)) @@ -103,9 +141,13 @@ [context# {source# :source}] (let [source# (core/compile* context# source#)] (reify core/Expression + (~'-static [~'_] + false) (~'-eval [~'_ context# resource# scope#] (let [~source-binding (core/-eval source# context# resource# scope#)] - ~@body)))))) + ~@body)) + (~'-form [~'_] + (list (quote ~name) (core/-form source#))))))) (defmacro defunopp @@ -117,6 +159,8 @@ ~precision-binding (some-> precision# core/to-chrono-unit) ~(or expr-binding '_) expr#] (reify core/Expression + (~'-static [~'_] + false) (~'-eval [~'_ context# resource# scope#] (let [~operand-binding (core/-eval operand# context# resource# scope#)] ~@body)) @@ -142,6 +186,8 @@ ~precision-binding chrono-precision#] ~@body) (reify core/Expression + (~'-static [~'_] + false) (~'-eval [~'_ context# resource# scope#] (let [~op-1-binding (core/-eval operand-1# context# resource# scope#) ~op-2-binding (core/-eval operand-2# context# resource# scope#) diff --git a/modules/cql/src/blaze/elm/compiler/nullological_operators.clj b/modules/cql/src/blaze/elm/compiler/nullological_operators.clj index ed0bda1ee..522073948 100644 --- a/modules/cql/src/blaze/elm/compiler/nullological_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/nullological_operators.clj @@ -28,6 +28,8 @@ (if (= "List" (:type operand)) (let [operand (core/compile* context operand)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (reduce (fn [_ elem] @@ -38,10 +40,14 @@ (core/-eval operand context resource scope))))) (let [operand (core/compile* context operand)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (core/-eval operand context resource scope)))))) (let [operands (mapv #(core/compile* context %) operands)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (reduce (fn [_ operand] diff --git a/modules/cql/src/blaze/elm/compiler/parameters.clj b/modules/cql/src/blaze/elm/compiler/parameters.clj index 2789f37ce..a457bfb14 100644 --- a/modules/cql/src/blaze/elm/compiler/parameters.clj +++ b/modules/cql/src/blaze/elm/compiler/parameters.clj @@ -22,6 +22,8 @@ (defrecord ParameterRef [name] core/Expression + (-static [_] + false) (-eval [_ {:keys [parameters] :as context} _ _] (let [value (get parameters name ::not-found)] (if (identical? ::not-found value) diff --git a/modules/cql/src/blaze/elm/compiler/queries.clj b/modules/cql/src/blaze/elm/compiler/queries.clj index 826a59663..b05f6a819 100644 --- a/modules/cql/src/blaze/elm/compiler/queries.clj +++ b/modules/cql/src/blaze/elm/compiler/queries.clj @@ -137,6 +137,8 @@ (defrecord EductionQueryExpression [xform-factory source] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (coll/eduction (-create xform-factory context resource scope) @@ -151,6 +153,8 @@ (defrecord IntoVectorQueryExpression [xform-factory source] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (into [] @@ -200,6 +204,8 @@ (defrecord SortQueryExpression [source sort-by-item] core/Expression + (-static [_] + false) (-eval [_ context resource scope] ;; TODO: build a comparator of all sort by items (->> (vec (core/-eval source context resource scope)) @@ -217,6 +223,8 @@ (defrecord XformSortQueryExpression [xform-factory source sort-by-item] core/Expression + (-static [_] + false) (-eval [_ context resource scope] ;; TODO: build a comparator of all sort by items (->> (into @@ -302,6 +310,8 @@ ;; 10.3. AliasRef (defrecord AliasRefExpression [key] core/Expression + (-static [_] + false) (-eval [_ _ _ scopes] (get scopes key)) (-form [_] diff --git a/modules/cql/src/blaze/elm/compiler/reusing_logic.clj b/modules/cql/src/blaze/elm/compiler/reusing_logic.clj index 8a4881096..0534253d6 100644 --- a/modules/cql/src/blaze/elm/compiler/reusing_logic.clj +++ b/modules/cql/src/blaze/elm/compiler/reusing_logic.clj @@ -31,6 +31,8 @@ (defrecord ExpressionRef [name] core/Expression + (-static [_] + false) (-eval [_ {:keys [expression-defs] :as context} resource _] (if-let [{:keys [expression]} (get expression-defs name)] (core/-eval expression context resource nil) @@ -70,6 +72,8 @@ ;; Unfiltered context. So we map the referenced expression over all ;; concrete resources. (reify core/Expression + (-static [_] + false) (-eval [_ {:keys [db expression-defs] :as context} _ _] (if-some [{:keys [expression]} (get expression-defs name)] (mapv @@ -104,6 +108,8 @@ (defrecord ToQuantityFunctionExpression [operand] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (-to-quantity (core/-eval operand context resource scope))) (-form [_] @@ -112,13 +118,19 @@ (defrecord ToCodeFunctionExpression [operand] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (let [{:keys [system version code]} (core/-eval operand context resource scope)] - (code/to-code (type/value system) (type/value version) (type/value code))))) + (code/to-code (type/value system) (type/value version) (type/value code)))) + (-form [_] + `(~'call "ToCode" ~(core/-form operand)))) (defrecord ToDateFunctionExpression [operand] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (type/value (core/-eval operand context resource scope))) (-form [_] @@ -127,6 +139,8 @@ (defrecord ToDateTimeFunctionExpression [operand] core/Expression + (-static [_] + false) (-eval [_ {:keys [now] :as context} resource scope] (p/to-date-time (type/value (core/-eval operand context resource scope)) now)) (-form [_] @@ -135,6 +149,8 @@ (defrecord ToStringFunctionExpression [operand] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (some-> (type/value (core/-eval operand context resource scope)) str)) (-form [_] @@ -158,6 +174,8 @@ (defrecord ToIntervalFunctionExpression [operand] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (-to-interval (core/-eval operand context resource scope) context)) (-form [_] @@ -210,6 +228,8 @@ (defmethod core/compile* :elm.compiler.type/operand-ref [_ {:keys [name]}] (reify core/Expression + (-static [_] + false) (-eval [_ _ _ scope] (scope name)) (-form [_] diff --git a/modules/cql/src/blaze/elm/compiler/string_operators.clj b/modules/cql/src/blaze/elm/compiler/string_operators.clj index 7e479d36b..7ee4c1d17 100644 --- a/modules/cql/src/blaze/elm/compiler/string_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/string_operators.clj @@ -21,14 +21,22 @@ separator (some->> separator (core/compile* context))] (if separator (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [source (core/-eval source context resource scope)] (string/combine (core/-eval separator context resource scope) - source)))) + source))) + (-form [_] + (list 'combine (core/-form source) (core/-form separator)))) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [source (core/-eval source context resource scope)] - (string/combine source))))))) + (string/combine source))) + (-form [_] + (list 'combine (core/-form source))))))) ;; 17.2. Concatenate @@ -53,10 +61,14 @@ (let [pattern (core/compile* context pattern) string (core/compile* context string)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [^String pattern (core/-eval pattern context resource scope)] (when-let [^String string (core/-eval string context resource scope)] - (.lastIndexOf string pattern))))))) + (.lastIndexOf string pattern)))) + (-form [_] + (list 'last-position-of (core/-form pattern) (core/-form string)))))) ;; 17.8. Length @@ -81,10 +93,14 @@ (let [pattern (core/compile* context pattern) string (core/compile* context string)] (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [^String pattern (core/-eval pattern context resource scope)] (when-let [^String string (core/-eval string context resource scope)] - (.indexOf string pattern))))))) + (.indexOf string pattern)))) + (-form [_] + (list 'position-of (core/-form pattern) (core/-form string)))))) ;; 17.13. ReplaceMatches @@ -100,6 +116,8 @@ separator (some->> separator (core/compile* context))] (if separator (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [string (core/-eval string context resource scope)] (if (= "" string) @@ -121,11 +139,17 @@ (conj result (str (.append acc char)))))) ;; TODO: implement split with more than one char. (throw (Exception. "TODO: implement split with separators longer than one char."))) - [string]))))) + [string])))) + (-form [_] + (list 'split (core/-form string) (core/-form separator)))) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [string (core/-eval string context resource scope)] - [string])))))) + [string])) + (-form [_] + (list 'split (core/-form string))))))) ;; 17.16. StartsWith @@ -142,18 +166,27 @@ length (some->> length (core/compile* context))] (if length (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [^String string (core/-eval string context resource scope)] (when-let [start-index (core/-eval start-index context resource scope)] (when (and (<= 0 start-index) (< start-index (count string))) (subs string start-index (min (+ start-index length) - (count string)))))))) + (count string))))))) + (-form [_] + (list 'substring (core/-form string) (core/-form start-index) + (core/-form length)))) (reify core/Expression + (-static [_] + false) (-eval [_ context resource scope] (when-let [^String string (core/-eval string context resource scope)] (when-let [start-index (core/-eval start-index context resource scope)] (when (and (<= 0 start-index) (< start-index (count string))) - (subs string start-index))))))))) + (subs string start-index))))) + (-form [_] + (list 'substring (core/-form string) (core/-form start-index))))))) ;; 17.18. Upper diff --git a/modules/cql/src/blaze/elm/compiler/structured_values.clj b/modules/cql/src/blaze/elm/compiler/structured_values.clj index 8805a4931..0b649a208 100644 --- a/modules/cql/src/blaze/elm/compiler/structured_values.clj +++ b/modules/cql/src/blaze/elm/compiler/structured_values.clj @@ -19,16 +19,6 @@ ;; 2.1. Tuple -(defrecord TupleExpression [elements] - core/Expression - (-eval [_ context resource scope] - (reduce-kv - (fn [r key value] - (assoc r key (core/-eval value context resource scope))) - {} - elements))) - - (defn- invalid-structured-type-access-msg [key] (format "Invalid structured type access with key `%s` on a collection." key)) @@ -62,7 +52,21 @@ (let [elements (compile-elements context elements)] (if (every? core/static? (vals elements)) elements - (->TupleExpression elements)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (reduce-kv + (fn [r key value] + (assoc r key (core/-eval value context resource scope))) + {} + elements)) + (-form [_] + (reduce-kv + (fn [r key value] + (assoc r key (core/-form value))) + {} + elements)))))) ;; 2.2. Instance @@ -79,6 +83,8 @@ ;; 2.3. Property (defrecord SourcePropertyExpression [source key] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (p/get (core/-eval source context resource scope) key)) (-form [_] @@ -87,6 +93,8 @@ (defrecord SourcePropertyValueExpression [source key] core/Expression + (-static [_] + false) (-eval [_ context resource scope] (type/value (p/get (core/-eval source context resource scope) key))) (-form [_] @@ -95,6 +103,8 @@ (defrecord SingleScopePropertyExpression [key] core/Expression + (-static [_] + false) (-eval [_ _ _ value] (p/get value key)) (-form [_] @@ -103,6 +113,8 @@ (defrecord ScopePropertyExpression [scope-key key] core/Expression + (-static [_] + false) (-eval [_ _ _ scope] (p/get (get scope scope-key) key)) (-form [_] @@ -111,6 +123,8 @@ (defrecord ScopePropertyValueExpression [scope-key key] core/Expression + (-static [_] + false) (-eval [_ _ _ scope] (type/value (p/get (get scope scope-key) key))) (-form [_] diff --git a/modules/cql/src/blaze/elm/compiler/type_operators.clj b/modules/cql/src/blaze/elm/compiler/type_operators.clj index d89f98f25..2ddbae60c 100644 --- a/modules/cql/src/blaze/elm/compiler/type_operators.clj +++ b/modules/cql/src/blaze/elm/compiler/type_operators.clj @@ -19,16 +19,6 @@ ;; 22.1. As -(defrecord AsExpression [operand type pred] - core/Expression - (-eval [_ context resource scope] - (let [value (core/-eval operand context resource scope)] - (when (pred value) - value))) - (-form [_] - `(~'as ~type ~(core/-form operand)))) - - (defn- matches-elm-named-type-fn [type-name] (case type-name "Boolean" ['elm/boolean boolean?] @@ -92,7 +82,15 @@ [context {:keys [operand] :as expression}] (when-some [operand (core/compile* context operand)] (let [[type pred] (matches-type-fn expression)] - (->AsExpression operand type pred)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (let [value (core/-eval operand context resource scope)] + (when (pred value) + value))) + (-form [_] + `(~'as ~type ~(core/-form operand))))))) ;; TODO 22.2. CanConvert @@ -104,16 +102,16 @@ ;; 22.4. Children -(defrecord ChildrenOperatorExpression [source] - core/Expression - (-eval [_ context resource scope] - (p/children (core/-eval source context resource scope)))) - - (defmethod core/compile* :elm.compiler.type/children [context {:keys [source]}] (when-let [source (core/compile* context source)] - (->ChildrenOperatorExpression source))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (p/children (core/-eval source context resource scope))) + (-form [_] + (list 'children (core/-form source)))))) ;; TODO 22.5. Convert @@ -131,39 +129,35 @@ ;; 22.8. ConvertsToDate -(defrecord ConvertsToDateOperatorExpression [operand] - core/Expression - (-eval [_ {:keys [now] :as context} resource scope] - (when-let [operand (core/-eval operand context resource scope)] - (when (some? operand) - (some? (p/to-date operand now))))) - (-form [_] - (list 'converts-to-date (core/-form operand)))) - - (defmethod core/compile* :elm.compiler.type/converts-to-date [context {:keys [operand]}] (when-let [operand (core/compile* context operand)] - (->ConvertsToDateOperatorExpression operand))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [now] :as context} resource scope] + (when-let [operand (core/-eval operand context resource scope)] + (when (some? operand) + (some? (p/to-date operand now))))) + (-form [_] + (list 'converts-to-date (core/-form operand)))))) ;; 22.9. ConvertsToDateTime -(defrecord ConvertsToDateTimeOperatorExpression [operand] - core/Expression - (-eval [_ {:keys [now] :as context} resource scope] - (when-let [operand (core/-eval operand context resource scope)] - (when (some? operand) - (some? (p/to-date-time operand now))))) - (-form [_] - (list 'converts-to-date-time (core/-form operand)))) - - (defmethod core/compile* :elm.compiler.type/converts-to-date-time [context {:keys [operand]}] (when-let [operand (core/compile* context operand)] (if (system/date? operand) (some? (p/to-date-time operand nil)) - (->ConvertsToDateTimeOperatorExpression operand)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [now] :as context} resource scope] + (when-let [operand (core/-eval operand context resource scope)] + (when (some? operand) + (some? (p/to-date-time operand now))))) + (-form [_] + (list 'converts-to-date-time (core/-form operand))))))) ;; 22.10. ConvertsToDecimal @@ -203,44 +197,33 @@ ;; 22.16. ConvertsToTime -(defrecord ConvertsToTimeOperatorExpression [operand] - core/Expression - (-eval [_ {:keys [now] :as context} resource scope] - (when-let [operand (core/-eval operand context resource scope)] - (when (some? operand) - (some? (p/to-time operand now))))) - (-form [_] - (list 'converts-to-time (core/-form operand)))) - - (defmethod core/compile* :elm.compiler.type/converts-to-time [context {:keys [operand]}] (when-let [operand (core/compile* context operand)] - (->ConvertsToTimeOperatorExpression operand))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [now] :as context} resource scope] + (when-some [operand (core/-eval operand context resource scope)] + (some? (p/to-time operand now)))) + (-form [_] + (list 'converts-to-time (core/-form operand)))))) ;; 22.17. Descendents -(defrecord DescendentsOperatorExpression [source] - core/Expression - (-eval [_ context resource scope] - (p/descendents (core/-eval source context resource scope)))) - - (defmethod core/compile* :elm.compiler.type/descendents [context {:keys [source]}] (when-let [source (core/compile* context source)] - (->DescendentsOperatorExpression source))) + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (p/descendents (core/-eval source context resource scope))) + (-form [_] + (list 'descendents (core/-form source)))))) ;; 22.18. Is -(defrecord IsExpression [operand type pred] - core/Expression - (-eval [_ context resource scope] - (pred (core/-eval operand context resource scope))) - (-form [_] - `(~'is ~type ~(core/-form operand)))) - - (defn- matches-elm-named-type-is [type-name] (case type-name "Boolean" ['elm/boolean boolean?] @@ -288,8 +271,15 @@ (defmethod core/compile* :elm.compiler.type/is [context {:keys [operand] :as expression}] - (let [[type pred] (matches-type-is expression)] - (->IsExpression (core/compile* context operand) type pred))) + (let [[type pred] (matches-type-is expression) + operand (core/compile* context operand)] + (reify core/Expression + (-static [_] + false) + (-eval [_ context resource scope] + (pred (core/-eval operand context resource scope))) + (-form [_] + `(~'is ~type ~(core/-form operand)))))) ;; 22.19. ToBoolean @@ -309,33 +299,33 @@ ;; 22.22. ToDate -(defrecord ToDateOperatorExpression [operand] - core/Expression - (-eval [_ {:keys [now] :as context} resource scope] - (p/to-date (core/-eval operand context resource scope) now))) - - (defmethod core/compile* :elm.compiler.type/to-date [context {:keys [operand]}] (when-let [operand (core/compile* context operand)] - (->ToDateOperatorExpression operand))) + (if (system/date? operand) + (p/to-date operand nil) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [now] :as context} resource scope] + (p/to-date (core/-eval operand context resource scope) now)) + (-form [_] + (list 'to-date (core/-form operand))))))) ;; 22.23. ToDateTime -(defrecord ToDateTimeOperatorExpression [operand] - core/Expression - (-eval [_ {:keys [now] :as context} resource scope] - (p/to-date-time (core/-eval operand context resource scope) now)) - (-form [_] - (list 'to-date-time (core/-form operand)))) - - (defmethod core/compile* :elm.compiler.type/to-date-time [context {:keys [operand]}] (when-let [operand (core/compile* context operand)] (if (system/date? operand) (p/to-date-time operand nil) - (->ToDateTimeOperatorExpression operand)))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [now] :as context} resource scope] + (p/to-date-time (core/-eval operand context resource scope) now)) + (-form [_] + (list 'to-date-time (core/-form operand))))))) ;; 22.24. ToDecimal @@ -374,13 +364,13 @@ ;; 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))) + (reify core/Expression + (-static [_] + false) + (-eval [_ {:keys [now] :as context} resource scope] + (p/to-time (core/-eval operand context resource scope) now)) + (-form [_] + (list 'to-time (core/-form operand)))))) diff --git a/modules/cql/src/blaze/elm/expression/spec.clj b/modules/cql/src/blaze/elm/expression/spec.clj index 40938f688..df57b5b7a 100644 --- a/modules/cql/src/blaze/elm/expression/spec.clj +++ b/modules/cql/src/blaze/elm/expression/spec.clj @@ -2,19 +2,27 @@ (:require [blaze.db.api-spec] [blaze.elm.compiler :as-alias c] + [blaze.elm.expression :as-alias expr] [blaze.elm.spec] [clojure.spec.alpha :as s] - [java-time.api :as time])) + [java-time.api :as time]) + (:import + [com.github.benmanes.caffeine.cache Cache])) (s/def ::now time/offset-date-time?) +(s/def ::expr/cache + #(instance? Cache %)) + + (s/def ::parameters (s/map-of :elm/name ::c/expression)) -(s/def :blaze.elm.expression/context - (s/keys :req-un [:blaze.db/db ::now] +(s/def ::expr/context + (s/keys :req [::expr/cache] + :req-un [:blaze.db/db ::now] :opt-un [::c/expression-defs ::parameters])) diff --git a/modules/cql/src/blaze/elm/quantity.clj b/modules/cql/src/blaze/elm/quantity.clj index 25b925ab4..a13adecef 100644 --- a/modules/cql/src/blaze/elm/quantity.clj +++ b/modules/cql/src/blaze/elm/quantity.clj @@ -5,6 +5,7 @@ https://cql.hl7.org/04-logicalspecification.html." (:require [blaze.anomaly :as ba :refer [throw-anom]] + [blaze.elm.compiler.core :as core] [blaze.elm.protocols :as p] [cuerdas.core :as c-str]) (:import @@ -73,6 +74,16 @@ (Quantities/getQuantity ^Number value ^Unit (parse-unit unit))) +(extend-protocol core/Expression + Quantity + (-static [_] + true) + (-eval [quantity _ _ _] + quantity) + (-form [quantity] + `(~'quantity ~(.getValue quantity) ~(format-unit (.getUnit quantity))))) + + (defprotocol QuantityDivide (quantity-divide [divisor quantity])) diff --git a/modules/cql/test/blaze/elm/compiler/aggregate_operators_test.clj b/modules/cql/test/blaze/elm/compiler/aggregate_operators_test.clj index f57e65ef1..278d49ddb 100644 --- a/modules/cql/test/blaze/elm/compiler/aggregate_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/aggregate_operators_test.clj @@ -7,6 +7,7 @@ [blaze.elm.compiler :as c] [blaze.elm.compiler.aggregate-operators] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] @@ -48,7 +49,11 @@ #elm/list [{:type "Null"}] true #elm/list [] true - {:type "Null"} true))) + {:type "Null"} true)) + + (tu/testing-unary-dynamic elm/all-true) + + (tu/testing-unary-form elm/all-true)) ;; 21.2. AnyTrue @@ -70,7 +75,11 @@ #elm/list [{:type "Null"}] false #elm/list [] false - {:type "Null"} false))) + {:type "Null"} false)) + + (tu/testing-unary-dynamic elm/any-true) + + (tu/testing-unary-form elm/any-true)) ;; 21.3. Avg @@ -92,7 +101,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/avg) + + (tu/testing-unary-form elm/avg)) ;; 21.4. Count @@ -116,7 +129,11 @@ #elm/list [{:type "Null"}] 0 #elm/list [] 0 - {:type "Null"} 0))) + {:type "Null"} 0)) + + (tu/testing-unary-dynamic elm/count) + + (tu/testing-unary-form elm/count)) ;; 21.5. GeometricMean @@ -139,7 +156,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/geometric-mean) + + (tu/testing-unary-form elm/geometric-mean)) ;; 21.6. Product @@ -162,7 +183,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/product) + + (tu/testing-unary-form elm/product)) ;; 21.7. Max @@ -186,7 +211,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/max) + + (tu/testing-unary-form elm/max)) ;; 21.8. Median @@ -209,7 +238,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/median) + + (tu/testing-unary-form elm/median)) ;; 21.9. Min @@ -233,7 +266,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/min) + + (tu/testing-unary-form elm/min)) ;; 21.10. Mode @@ -256,7 +293,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/mode) + + (tu/testing-unary-form elm/mode)) ;; 21.11. PopulationVariance @@ -277,7 +318,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/population-variance) + + (tu/testing-unary-form elm/population-variance)) ;; 21.12. PopulationStdDev @@ -298,7 +343,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/population-std-dev) + + (tu/testing-unary-form elm/population-std-dev)) ;; 21.13. Sum @@ -320,7 +369,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/sum) + + (tu/testing-unary-form elm/sum)) ;; 21.14. StdDev @@ -341,7 +394,11 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/std-dev) + + (tu/testing-unary-form elm/std-dev)) ;; 21.15. Variance @@ -362,4 +419,8 @@ #elm/list [{:type "Null"}] nil #elm/list [] nil - {:type "Null"} nil))) + {:type "Null"} nil)) + + (tu/testing-unary-dynamic elm/variance) + + (tu/testing-unary-form elm/variance)) diff --git a/modules/cql/test/blaze/elm/compiler/arithmetic_operators_test.clj b/modules/cql/test/blaze/elm/compiler/arithmetic_operators_test.clj index 3b8148ac4..870c110ec 100644 --- a/modules/cql/test/blaze/elm/compiler/arithmetic_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/arithmetic_operators_test.clj @@ -8,6 +8,7 @@ [blaze.elm.compiler :as c] [blaze.elm.compiler.arithmetic-operators-spec] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.date-time :as date-time] [blaze.elm.date-time-spec] @@ -86,8 +87,15 @@ [0M "m"] (quantity/quantity 0M "m") [1M "m"] (quantity/quantity 1M "m")))) + (testing "Dynamic" + (are [elm res] (= res (tu/dynamic-compile-eval (elm/abs elm))) + #elm/parameter-ref "1" 1 + #elm/parameter-ref "-1" 1)) + (tu/testing-unary-null elm/abs) + (tu/testing-unary-dynamic elm/abs) + (tu/testing-unary-form elm/abs)) @@ -362,6 +370,8 @@ #elm/time "00:00:00" #elm/quantity [1 "minute"] (date-time/local-time 0 1 0) #elm/time "00:00:00" #elm/quantity [1 "second"] (date-time/local-time 0 0 1))) + (tu/testing-binary-dynamic elm/add) + (tu/testing-binary-form elm/add)) @@ -378,6 +388,8 @@ (tu/testing-unary-null elm/ceiling) + (tu/testing-unary-dynamic elm/ceiling) + (tu/testing-unary-form elm/ceiling)) @@ -468,6 +480,8 @@ (let [elm (elm/equal [(elm/multiply [(elm/divide [decimal decimal]) decimal]) decimal])] (true? (core/-eval (c/compile {} elm) {} nil nil)))))) + (tu/testing-binary-dynamic elm/divide) + (tu/testing-binary-form elm/divide)) @@ -483,6 +497,8 @@ (tu/testing-unary-null elm/exp) + (tu/testing-unary-dynamic elm/exp) + (tu/testing-unary-form elm/exp)) @@ -499,6 +515,8 @@ (tu/testing-unary-null elm/floor) + (tu/testing-unary-dynamic elm/floor) + (tu/testing-unary-form elm/floor)) @@ -543,6 +561,8 @@ (tu/testing-binary-null elm/log #elm/decimal "1.1")) + (tu/testing-binary-dynamic elm/log) + (tu/testing-binary-form elm/log)) @@ -587,6 +607,8 @@ (tu/testing-unary-null elm/ln) + (tu/testing-unary-dynamic elm/ln) + (tu/testing-unary-form elm/ln)) @@ -714,6 +736,8 @@ #elm/integer "1" #elm/integer "0" nil #elm/decimal "1" #elm/decimal "0" nil)) + (tu/testing-binary-dynamic elm/modulo) + (tu/testing-binary-form elm/modulo)) @@ -757,6 +781,8 @@ (tu/testing-binary-null elm/multiply #elm/quantity [1])) + (tu/testing-binary-dynamic elm/multiply) + (tu/testing-binary-form elm/multiply)) @@ -787,6 +813,8 @@ (tu/testing-unary-null elm/negate) + (tu/testing-unary-dynamic elm/negate) + (tu/testing-unary-form elm/negate)) @@ -821,6 +849,8 @@ #elm/decimal "10" #elm/integer "2" 100M #elm/decimal "10" #elm/integer "2" 100M)) + (tu/testing-binary-dynamic elm/power) + (tu/testing-binary-form elm/power)) @@ -905,6 +935,8 @@ (tu/testing-unary-null elm/predecessor) + (tu/testing-unary-dynamic elm/predecessor) + (tu/testing-unary-form elm/predecessor)) @@ -954,14 +986,16 @@ eval-ctx {:parameters {"x" nil}}] (is (nil? (core/-eval expr eval-ctx nil nil)))))) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}}] - (are [elm form] (= form (core/-form (c/compile compile-ctx elm))) - #elm/round [#elm/parameter-ref "x"] - '(round (param-ref "x")) - #elm/round [#elm/parameter-ref "x" #elm/integer "3"] - '(round (param-ref "x") 3))))) + (tu/testing-unary-null elm/round) + + (tu/testing-unary-dynamic elm/round) + + (tu/testing-unary-form elm/round) + + (tu/testing-binary-dynamic elm/round) + + (tu/testing-binary-form elm/round)) ;; 16.20. Subtract @@ -1181,6 +1215,8 @@ #elm/time "00:00:00" #elm/quantity [1 "minute"] (date-time/local-time 23 59 0) #elm/time "00:00:00" #elm/quantity [1 "second"] (date-time/local-time 23 59 59))) + (tu/testing-binary-dynamic elm/subtract) + (tu/testing-binary-form elm/subtract)) @@ -1252,6 +1288,8 @@ (tu/testing-unary-null elm/successor) + (tu/testing-unary-dynamic elm/successor) + (tu/testing-unary-form elm/successor)) @@ -1268,6 +1306,8 @@ (tu/testing-unary-null elm/truncate) + (tu/testing-unary-dynamic elm/truncate) + (tu/testing-unary-form elm/truncate)) @@ -1329,4 +1369,6 @@ (tu/testing-binary-null elm/truncated-divide #elm/integer "1" #elm/decimal "1.1")) + (tu/testing-binary-dynamic elm/truncated-divide) + (tu/testing-binary-form elm/truncated-divide)) diff --git a/modules/cql/test/blaze/elm/compiler/clinical_operators_test.clj b/modules/cql/test/blaze/elm/compiler/clinical_operators_test.clj index 8882f5555..ca1124371 100644 --- a/modules/cql/test/blaze/elm/compiler/clinical_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/clinical_operators_test.clj @@ -7,6 +7,7 @@ [blaze.elm.compiler :as c] [blaze.elm.compiler.clinical-operators] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] @@ -77,6 +78,8 @@ (tu/testing-binary-null elm/calculate-age-at #elm/date"2018") (tu/testing-binary-null elm/calculate-age-at #elm/date-time"2018-01-01") + (tu/testing-binary-dynamic elm/calculate-age-at) + (tu/testing-binary-precision-form elm/calculate-age-at "year" "month" "day")) diff --git a/modules/cql/test/blaze/elm/compiler/clinical_values_test.clj b/modules/cql/test/blaze/elm/compiler/clinical_values_test.clj index c811064e9..1539ec8d8 100644 --- a/modules/cql/test/blaze/elm/compiler/clinical_values_test.clj +++ b/modules/cql/test/blaze/elm/compiler/clinical_values_test.clj @@ -9,7 +9,8 @@ [blaze.elm.compiler :as c] [blaze.elm.compiler.clinical-values] [blaze.elm.compiler.core :as core] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.core-spec] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.concept-spec] [blaze.elm.date-time :as date-time] [blaze.elm.literal] @@ -51,11 +52,16 @@ (let [context {:library {:codeSystems - {:def [{:name "sys-def-115852" :id "system-115910"}]}}}] - (given (c/compile context #elm/code ["sys-def-115852" "code-115927"]) + {:def [{:name "sys-def-115852" :id "system-115910"}]}}} + expr (c/compile context #elm/code ["sys-def-115852" "code-115927"])] + + (given expr type := Code :system := "system-115910" - :code := "code-115927"))) + :code := "code-115927") + + (testing "form" + (has-form expr '(code "system-115910" nil "code-115927"))))) (testing "with version" (let [context @@ -64,12 +70,17 @@ {:def [{:name "sys-def-120434" :id "system-120411" - :version "version-120408"}]}}}] - (given (c/compile context #elm/code ["sys-def-120434" "code-120416"]) + :version "version-120408"}]}}} + expr (c/compile context #elm/code ["sys-def-120434" "code-120416"])] + + (given expr type := Code :system := "system-120411" :version := "version-120408" - :code := "code-120416"))) + :code := "code-120416") + + (testing "form" + (has-form expr '(code "system-120411" "version-120408" "code-120416"))))) (testing "missing code system" (let [context {:library {:codeSystems {:def []}}}] @@ -299,6 +310,12 @@ #elm/quantity [1 "s"] (quantity/quantity 1 "s") #elm/quantity [1 "cm2"] (quantity/quantity 1 "cm2"))) + (testing "form" + (are [elm res] (= res (c/form (c/compile {} elm))) + #elm/quantity [1] '(quantity 1 "1") + #elm/quantity [1 "s"] '(quantity 1 "s") + #elm/quantity [2 "cm2"] '(quantity 2 "cm2"))) + (testing "Periods" (satisfies-prop 100 (prop/for-all [period (s/gen :elm/period)] diff --git a/modules/cql/test/blaze/elm/compiler/comparison_operators_test.clj b/modules/cql/test/blaze/elm/compiler/comparison_operators_test.clj index 9282bdc50..8f334c693 100644 --- a/modules/cql/test/blaze/elm/compiler/comparison_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/comparison_operators_test.clj @@ -7,6 +7,7 @@ [blaze.elm.compiler :as c] [blaze.elm.compiler.comparison-operators] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] @@ -260,6 +261,8 @@ (tu/testing-binary-null elm/equal (tu/code "a" "0"))) + (tu/testing-binary-dynamic elm/equal) + (tu/testing-binary-form elm/equal)) @@ -439,6 +442,8 @@ {:type "Null"} (tu/code "a" "0") false (tu/code "a" "0") {:type "Null"} false)) + (tu/testing-binary-dynamic elm/equivalent) + (tu/testing-binary-form elm/equivalent)) @@ -555,6 +560,8 @@ (tu/testing-binary-null elm/greater #elm/time "00:00:00")) + (tu/testing-binary-dynamic elm/greater) + (tu/testing-binary-form elm/greater)) @@ -683,6 +690,8 @@ (tu/testing-binary-null elm/greater-or-equal #elm/quantity [1])) + (tu/testing-binary-dynamic elm/greater-or-equal) + (tu/testing-binary-form elm/greater-or-equal)) @@ -815,6 +824,8 @@ (tu/testing-binary-null elm/less #elm/quantity [1])) + (tu/testing-binary-dynamic elm/less) + (tu/testing-binary-form elm/less)) @@ -936,6 +947,8 @@ (tu/testing-binary-null elm/less-or-equal #elm/quantity [1])) + (tu/testing-binary-dynamic elm/less-or-equal) + (tu/testing-binary-form elm/less-or-equal)) diff --git a/modules/cql/test/blaze/elm/compiler/conditional_operators_test.clj b/modules/cql/test/blaze/elm/compiler/conditional_operators_test.clj index ba936a8cb..f4ce27b4c 100644 --- a/modules/cql/test/blaze/elm/compiler/conditional_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/conditional_operators_test.clj @@ -5,10 +5,11 @@ https://cql.hl7.org/04-logicalspecification.html." (:require [blaze.elm.compiler :as c] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.literal-spec] [clojure.spec.test.alpha :as st] - [clojure.test :as test :refer [are deftest testing]])) + [clojure.test :as test :refer [are deftest is testing]])) (st/instrument) @@ -25,6 +26,106 @@ (test/use-fixtures :each fixture) +;; 15.1. Case +;; +;; The Case operator allows for multiple conditional expressions to be chained +;; together in a single expression, rather than having to nest multiple If +;; operators. In addition, the comparand operand provides a variant on the case +;; that allows a single value to be compared in each conditional. +;; +;; If a comparand is not provided, the type of each when element of the +;; caseItems within the Case is expected to be boolean. If a comparand is +;; provided, the type of each when element of the caseItems within the Case is +;; expected to be of the same type as the comparand. An else element must always +;; be provided. +;; +;; The static type of the then argument within the first caseItem determines the +;; type of the result, and the then argument of each subsequent caseItem and the +;; else argument must be of that same type. +(deftest compile-case-test + ;; Case is only implemented dynamically + (testing "Dynamic" + (testing "multi-conditional" + (are [when res] (= res (tu/dynamic-compile-eval + {:type "Case" + :caseItem + [{:when when + :then #elm/integer "1"}] + :else #elm/integer "2"})) + + #elm/parameter-ref "true" 1 + #elm/parameter-ref "false" 2 + #elm/parameter-ref "nil" 2)) + + (testing "comparand-based" + (are [comparand res] (= res (tu/dynamic-compile-eval + {:type "Case" + :comparand comparand + :caseItem + [{:when #elm/string "a" + :then #elm/integer "1"}] + :else #elm/integer "2"})) + + #elm/parameter-ref "a" 1 + #elm/parameter-ref "b" 2 + #elm/parameter-ref "nil" 2))) + + (testing "form" + (testing "Static" + (testing "multi-conditional" + (let [expr (c/compile {} {:type "Case" + :caseItem + [{:when #elm/boolean "true" + :then #elm/integer "1"}] + :else #elm/integer "2"})] + (has-form expr '(case true 1 2)))) + + (testing "comparand-based" + (let [expr (c/compile {} {:type "Case" + :comparand #elm/string "a" + :caseItem + [{:when #elm/string "b" + :then #elm/integer "1"}] + :else #elm/integer "2"})] + (has-form expr '(case "a" "b" 1 2))))) + + (testing "Dynamic" + (testing "multi-conditional" + (let [expr (tu/dynamic-compile + {:type "Case" + :caseItem + [{:when #elm/parameter-ref "true" + :then #elm/integer "1"}] + :else #elm/integer "2"})] + (has-form expr '(case (param-ref "true") 1 2)))) + + (testing "comparand-based" + (let [expr (tu/dynamic-compile + {:type "Case" + :comparand #elm/parameter-ref "a" + :caseItem + [{:when #elm/parameter-ref "b" + :then #elm/integer "1"}] + :else #elm/integer "2"})] + (has-form expr '(case (param-ref "a") (param-ref "b") 1 2)))))) + + (testing "expression is dynamic" + (testing "multi-conditional" + (is (false? (core/-static (tu/dynamic-compile {:type "Case" + :caseItem + [{:when #elm/parameter-ref "true" + :then #elm/parameter-ref "1"}] + :else #elm/parameter-ref "2"}))))) + + (testing "comparand-based" + (is (false? (core/-static (tu/dynamic-compile {:type "Case" + :comparand #elm/parameter-ref "a" + :caseItem + [{:when #elm/parameter-ref "b" + :then #elm/parameter-ref "1"}] + :else #elm/parameter-ref "2"}))))))) + + ;; 15.2. If ;; ;; The If operator evaluates a condition, and returns the then argument if the @@ -43,4 +144,9 @@ (are [elm res] (= res (tu/dynamic-compile-eval elm)) #elm/if [#elm/parameter-ref "true" #elm/integer "1" #elm/integer "2"] 1 #elm/if [#elm/parameter-ref "false" #elm/integer "1" #elm/integer "2"] 2 - #elm/if [#elm/parameter-ref "nil" #elm/integer "1" #elm/integer "2"] 2))) + #elm/if [#elm/parameter-ref "nil" #elm/integer "1" #elm/integer "2"] 2)) + + (testing "expression is dynamic" + (is (false? (core/-static (tu/dynamic-compile #elm/if [#elm/parameter-ref "x" + #elm/parameter-ref "y" + #elm/parameter-ref "z"])))))) diff --git a/modules/cql/test/blaze/elm/compiler/core_spec.clj b/modules/cql/test/blaze/elm/compiler/core_spec.clj new file mode 100644 index 000000000..a05d179d7 --- /dev/null +++ b/modules/cql/test/blaze/elm/compiler/core_spec.clj @@ -0,0 +1,15 @@ +(ns blaze.elm.compiler.core-spec + (:require + [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] + [clojure.spec.alpha :as s])) + + +(s/fdef core/expr? + :args (s/cat :x any?) + :ret boolean?) + + +(s/fdef core/static? + :args (s/cat :x any?) + :ret boolean?) diff --git a/modules/cql/test/blaze/elm/compiler/date_time_operators_test.clj b/modules/cql/test/blaze/elm/compiler/date_time_operators_test.clj index c2c7585ad..10d819361 100644 --- a/modules/cql/test/blaze/elm/compiler/date_time_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/date_time_operators_test.clj @@ -6,6 +6,7 @@ (:require [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.date-time :as date-time] [blaze.elm.literal :as elm] @@ -18,7 +19,7 @@ [clojure.test.check.properties :as prop] [java-time.api :as time]) (:import - [blaze.fhir.spec.type.system DateDate DateYear DateYearMonth] + [blaze.fhir.spec.type.system DateDate] [java.time OffsetDateTime] [java.time.temporal Temporal])) @@ -164,20 +165,57 @@ eval-ctx {:parameters {"day" 23}}] (is (= #system/date"2019-03-23" (core/-eval expr eval-ctx nil nil))))) - (testing "an ELM year (only literals) always compiles to a DateYear" + (testing "an ELM year (only literals) always compiles to a System.Date" (satisfies-prop 100 (prop/for-all [year (s/gen :elm/literal-year)] - (instance? DateYear (c/compile {} year))))) + (system/date? (c/compile {} year))))) - (testing "an ELM year-month (only literals) always compiles to a DateYearMonth" + (testing "an ELM year-month (only literals) always compiles to a System.Date" (satisfies-prop 100 (prop/for-all [year-month (s/gen :elm/literal-year-month)] - (instance? DateYearMonth (c/compile {} year-month))))) + (system/date? (c/compile {} year-month))))) (testing "an ELM date (only literals) always compiles to something implementing Temporal" (satisfies-prop 100 (prop/for-all [date (s/gen :elm/literal-date)] - (instance? Temporal (c/compile {} date)))))) + (instance? Temporal (c/compile {} date))))) + + (testing "form and static" + (let [compile-ctx {:library + {:parameters + {:def + [{:name "year"} + {:name "month"} + {:name "day"}]}}}] + + (testing "year" + (let [elm #elm/date [#elm/parameter-ref "year"] + expr (c/compile compile-ctx elm)] + + (is (= '(date (param-ref "year")) (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "year-month" + (let [elm #elm/date [#elm/parameter-ref "year" + #elm/parameter-ref "month"] + expr (c/compile compile-ctx elm)] + + (is (= '(date (param-ref "year") (param-ref "month")) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "date" + (let [elm #elm/date [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day"] + expr (c/compile compile-ctx elm)] + + (is (= '(date (param-ref "year") (param-ref "month") (param-ref "day")) + (core/-form expr))) + + (is (false? (core/-static expr)))))))) ;; 18.7. DateFrom @@ -198,6 +236,8 @@ (tu/testing-unary-null elm/date-from) + (tu/testing-unary-dynamic elm/date-from) + (tu/testing-unary-form elm/date-from)) @@ -327,7 +367,7 @@ (are [elm] (thrown? Exception (c/compile {} elm)) #elm/date-time"10000-12-31T23:59:59.999")) - (testing "with offset" + (testing "with timezone offset" (are [elm res] (= res (core/-eval (c/compile {} elm) {:now tu/now} nil nil)) #elm/date-time[#elm/integer "2019" #elm/integer "3" #elm/integer "23" #elm/integer "12" #elm/integer "13" #elm/integer "14" #elm/integer "0" @@ -359,17 +399,178 @@ #elm/decimal "7"] (system/date-time 2012 3 10 3 20 0 999))) - (testing "with decimal offset" + (testing "with decimal timezone offset" (are [elm res] (= res (core/-eval (c/compile {} elm) {:now tu/now} nil nil)) #elm/date-time[#elm/integer "2019" #elm/integer "3" #elm/integer "23" #elm/integer "12" #elm/integer "13" #elm/integer "14" #elm/integer "0" #elm/decimal "1.5"] (system/date-time 2019 3 23 10 43 14))) - (testing "an ELM date-time (only literals) always evaluates to something implementing Temporal" + (testing "an ELM date-time (only literals) always evaluates to a System.DateTime" (satisfies-prop 100 (prop/for-all [date-time (s/gen :elm/literal-date-time)] - (instance? Temporal (core/-eval (c/compile {} date-time) {:now tu/now} nil nil)))))) + (system/date-time? (core/-eval (c/compile {} date-time) {:now tu/now} nil nil))))) + + (testing "form and static" + (let [compile-ctx {:library + {:parameters + {:def + [{:name "year"} + {:name "month"} + {:name "day"} + {:name "hour"} + {:name "minute"} + {:name "second"} + {:name "millisecond"} + {:name "timezone-offset"}]}}}] + + (testing "year" + (let [elm #elm/date-time [#elm/parameter-ref "year"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year")) (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "year-month" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month")) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "date" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day")) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "with timezone offset" + (testing "All Static" + (let [elm #elm/date-time [#elm/integer "1" + #elm/integer "2" + #elm/integer "3" + #elm/integer "4" + #elm/integer "5" + #elm/integer "6" + #elm/integer "7" + #elm/integer "8"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time 1 2 3 4 5 6 7 8) (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "Offset Static" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day" + #elm/parameter-ref "hour" + #elm/parameter-ref "minute" + #elm/parameter-ref "second" + #elm/parameter-ref "millisecond" + #elm/integer "1"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day") (param-ref "hour") + (param-ref "minute") (param-ref "second") + (param-ref "millisecond") 1) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "Dynamic" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day" + #elm/parameter-ref "hour" + #elm/parameter-ref "minute" + #elm/parameter-ref "second" + #elm/parameter-ref "millisecond" + #elm/parameter-ref "timezone-offset"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day") (param-ref "hour") + (param-ref "minute") (param-ref "second") + (param-ref "millisecond") + (param-ref "timezone-offset")) + (core/-form expr))) + + (is (false? (core/-static expr)))))) + + (testing "without timezone offset" + (testing "hour" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day" + #elm/parameter-ref "hour"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day") (param-ref "hour") 0 0 0) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "minute" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day" + #elm/parameter-ref "hour" + #elm/parameter-ref "minute"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day") (param-ref "hour") + (param-ref "minute") 0 0) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "second" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day" + #elm/parameter-ref "hour" + #elm/parameter-ref "minute" + #elm/parameter-ref "second"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day") (param-ref "hour") + (param-ref "minute") (param-ref "second") 0) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "millisecond" + (let [elm #elm/date-time [#elm/parameter-ref "year" + #elm/parameter-ref "month" + #elm/parameter-ref "day" + #elm/parameter-ref "hour" + #elm/parameter-ref "minute" + #elm/parameter-ref "second" + #elm/parameter-ref "millisecond"] + expr (c/compile compile-ctx elm)] + + (is (= '(date-time (param-ref "year") (param-ref "month") + (param-ref "day") (param-ref "hour") + (param-ref "minute") (param-ref "second") + (param-ref "millisecond")) + (core/-form expr))) + + (is (false? (core/-static expr))))))))) ;; 18.9. DateTimeComponentFrom @@ -401,6 +602,9 @@ (are [x precision res] (= res (eval (compile elm/date-time x precision))) "2019-04-17T12:48" "Hour" 12)) + (tu/testing-unary-precision-dynamic elm/date-time-component-from "Year" "Month" + "Day" "Hour" "Minute" "Second" "Millisecond") + (tu/testing-unary-precision-form elm/date-time-component-from "Year" "Month" "Day" "Hour" "Minute" "Second" "Millisecond")) @@ -471,6 +675,8 @@ "2018-01" "2018-01" "Day" "2018-01-01" "2018-01-01" "Hour")))) + (tu/testing-binary-precision-dynamic elm/difference-between "Year" "Month" "Day") + (tu/testing-binary-precision-form elm/difference-between "Year" "Month" "Day")) @@ -502,8 +708,8 @@ (let [compile (partial tu/compile-binop-precision elm/duration-between)] (testing "Year precision" - (doseq [op-xtor [elm/date elm/date-time]] - (are [x y res] (= res (compile op-xtor x y "Year")) + (doseq [op-ctor [elm/date elm/date-time]] + (are [x y res] (= res (compile op-ctor x y "Year")) "2018" "2019" 1 "2018" "2017" -1 "2018" "2018" 0))) @@ -539,6 +745,8 @@ "2018-01" "2018-01" "Day" "2018-01-01" "2018-01-01" "Hour")))) + (tu/testing-binary-precision-dynamic elm/duration-between "Year" "Month" "Day") + (tu/testing-binary-precision-form elm/duration-between "Year" "Month" "Day")) @@ -646,6 +854,8 @@ "2019-04-17" "2019-04-17" true "2019-04-17" "2019-04-18" true))) + (tu/testing-binary-precision-dynamic elm/same-as) + (tu/testing-binary-precision-form elm/same-as)) @@ -748,6 +958,8 @@ "2019-04" "2019-04" true "2019-04" "2019-03" true))) + (tu/testing-binary-precision-dynamic elm/same-or-before) + (tu/testing-binary-precision-form elm/same-or-before)) @@ -850,6 +1062,8 @@ "2019-04" "2019-04" true "2019-04" "2019-05" true))) + (tu/testing-binary-precision-dynamic elm/same-or-after) + (tu/testing-binary-precision-form elm/same-or-after)) @@ -923,7 +1137,59 @@ (testing "an ELM time (only literals) always compiles to a LocalTime" (satisfies-prop 100 (prop/for-all [time (s/gen :elm/time)] - (date-time/local-time? (c/compile {} time)))))) + (date-time/local-time? (c/compile {} time))))) + + (testing "form and static" + (let [compile-ctx {:library + {:parameters + {:def + [{:name "hour"} + {:name "minute"} + {:name "second"} + {:name "millisecond"}]}}}] + + (testing "hour" + (let [elm #elm/time [#elm/parameter-ref "hour"] + expr (c/compile compile-ctx elm)] + + (is (= '(time (param-ref "hour")) (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "minute" + (let [elm #elm/time [#elm/parameter-ref "hour" + #elm/parameter-ref "minute"] + expr (c/compile compile-ctx elm)] + + (is (= '(time (param-ref "hour") (param-ref "minute")) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "second" + (let [elm #elm/time [#elm/parameter-ref "hour" + #elm/parameter-ref "minute" + #elm/parameter-ref "second"] + expr (c/compile compile-ctx elm)] + + (is (= '(time (param-ref "hour") (param-ref "minute") + (param-ref "second")) + (core/-form expr))) + + (is (false? (core/-static expr))))) + + (testing "millisecond" + (let [elm #elm/time [#elm/parameter-ref "hour" + #elm/parameter-ref "minute" + #elm/parameter-ref "second" + #elm/parameter-ref "millisecond"] + expr (c/compile compile-ctx elm)] + + (is (= '(time (param-ref "hour") (param-ref "minute") + (param-ref "second") (param-ref "millisecond")) + (core/-form expr))) + + (is (false? (core/-static expr)))))))) ;; 18.21. TimeOfDay @@ -932,8 +1198,12 @@ ;; associated with the evaluation request. See the Now operator for more ;; information on the rationale for defining the TimeOfDay operator in this way. (deftest compile-time-of-day-test - (are [res] (= res (core/-eval (c/compile {} {:type "TimeOfDay"}) {:now tu/now} nil nil)) - (time/local-time tu/now))) + (are [res] (= res (core/-eval (c/compile {} elm/time-of-day) {:now tu/now} nil nil)) + (time/local-time tu/now)) + + (tu/testing-constant-dynamic elm/time-of-day) + + (tu/testing-constant-form elm/time-of-day)) ;; 18.22. Today @@ -946,4 +1216,6 @@ (are [res] (= res (core/-eval (c/compile {} elm/today) {:now tu/now} nil nil)) (DateDate/fromLocalDate (.toLocalDate ^OffsetDateTime tu/now))) + (tu/testing-constant-dynamic elm/today) + (tu/testing-constant-form elm/today)) diff --git a/modules/cql/test/blaze/elm/compiler/external_data_test.clj b/modules/cql/test/blaze/elm/compiler/external_data_test.clj index c8c902281..0cba08feb 100644 --- a/modules/cql/test/blaze/elm/compiler/external_data_test.clj +++ b/modules/cql/test/blaze/elm/compiler/external_data_test.clj @@ -8,9 +8,10 @@ [blaze.db.api :as d] [blaze.db.api-stub :refer [mem-node-config with-system-data]] [blaze.elm.compiler :as c] + [blaze.elm.compiler.core :as core] [blaze.elm.compiler.external-data :as ed] [blaze.elm.compiler.external-data-spec] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.expression :as expr] [blaze.elm.expression-spec] [blaze.fhir.spec :as fhir-spec] @@ -21,8 +22,7 @@ [cognitect.anomalies :as anom] [juxt.iota :refer [given]]) (:import - [blaze.elm.compiler.external_data - WithRelatedContextQueryRetrieveExpression] + [com.github.benmanes.caffeine.cache Caffeine] [java.time OffsetDateTime])) @@ -41,6 +41,12 @@ (test/use-fixtures :each fixture) +(defn- eval-context [db] + {:db db + ::expr/cache (.build (Caffeine/newBuilder)) + :now (OffsetDateTime/now)}) + + ;; 11.1. Retrieve ;; ;; All access to external data within ELM is represented by Retrieve expressions. @@ -80,12 +86,15 @@ patient (ed/mk-resource db (d/resource-handle db "Patient" "0"))] (testing "eval" - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr patient) + (given (expr/eval (eval-context db) expr patient) [0 fhir-spec/fhir-type] := :fhir/Patient [0 :id] := "0")) + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(retrieve-resource) (c/form expr))))))) + (has-form expr '(retrieve-resource)))))) (testing "Observation" (with-system-data [{:blaze.db/keys [node]} mem-node-config] @@ -103,12 +112,15 @@ patient (ed/mk-resource db (d/resource-handle db "Patient" "0"))] (testing "eval" - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr patient) + (given (expr/eval (eval-context db) expr patient) [0 fhir-spec/fhir-type] := :fhir/Observation [0 :id] := "1")) + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(compartment-list-retrieve "Observation") (c/form expr)))))) + (has-form expr '(retrieve "Observation"))))) (testing "with one code" (with-system-data [{:blaze.db/keys [node]} mem-node-config] @@ -143,14 +155,17 @@ patient (ed/mk-resource db (d/resource-handle db "Patient" "0"))] (testing "eval" - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr patient) + (given (expr/eval (eval-context db) expr patient) count := 1 [0 fhir-spec/fhir-type] := :fhir/Observation [0 :id] := "1")) + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(compartment-query-retrieve "Observation" [["code" "system-192253|code-192300"]]) - (c/form expr))))))) + (has-form expr + '(retrieve "Observation" [["code" "system-192253|code-192300"]])))))) (testing "with two codes" (with-system-data [{:blaze.db/keys [node]} mem-node-config] @@ -194,12 +209,24 @@ db (d/db node) patient (ed/mk-resource db (d/resource-handle db "Patient" "0"))] - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr patient) - count := 2 - [0 fhir-spec/fhir-type] := :fhir/Observation - [0 :id] := "1" - [1 fhir-spec/fhir-type] := :fhir/Observation - [1 :id] := "2")))) + (testing "eval" + (given (expr/eval (eval-context db) expr patient) + count := 2 + [0 fhir-spec/fhir-type] := :fhir/Observation + [0 :id] := "1" + [1 fhir-spec/fhir-type] := :fhir/Observation + [1 :id] := "2")) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr + '(retrieve + "Observation" + [["code" + "system-192253|code-192300" + "system-192253|code-140541"]])))))) (testing "with one concept" (with-system-data [{:blaze.db/keys [node]} mem-node-config] @@ -246,12 +273,24 @@ db (d/db node) patient (ed/mk-resource db (d/resource-handle db "Patient" "0"))] - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr patient) - count := 2 - [0 fhir-spec/fhir-type] := :fhir/Observation - [0 :id] := "1" - [1 fhir-spec/fhir-type] := :fhir/Observation - [1 :id] := "2")))))) + (testing "eval" + (given (expr/eval (eval-context db) expr patient) + count := 2 + [0 fhir-spec/fhir-type] := :fhir/Observation + [0 :id] := "1" + [1 fhir-spec/fhir-type] := :fhir/Observation + [1 :id] := "2")) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr + '(retrieve + "Observation" + [["code" + "system-192253|code-192300" + "system-192253|code-140541"]])))))))) (testing "Specimen context" (testing "Patient" @@ -268,9 +307,17 @@ db (d/db node) specimen (ed/mk-resource db (d/resource-handle db "Specimen" "0"))] - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr specimen) - [0 fhir-spec/fhir-type] := :fhir/Patient - [0 :id] := "0"))))) + (testing "eval" + (given (expr/eval (eval-context db) expr specimen) + [0 fhir-spec/fhir-type] := :fhir/Patient + [0 :id] := "0")) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr + '(retrieve (Specimen) "Patient"))))))) (testing "Unfiltered context" (testing "Medication" @@ -298,10 +345,18 @@ expr (c/compile context elm) db (d/db node)] - (given (expr/eval {:db db :now (OffsetDateTime/now)} expr nil) - count := 1 - [0 fhir-spec/fhir-type] := :fhir/Medication - [0 :id] := "0")))) + (testing "eval" + (given (expr/eval (eval-context db) expr nil) + count := 1 + [0 fhir-spec/fhir-type] := :fhir/Medication + [0 :id] := "0")) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr + '(retrieve "Medication" [["code" "system-225806|code-225809"]])))))) (testing "unknown code property" (with-system [{:blaze.db/keys [node]} mem-node-config] @@ -324,6 +379,24 @@ ::anom/message := "The search-param with code `foo` and type `Medication` was not found."))))) (testing "with related context" + (testing "without code" + (with-system [{:blaze.db/keys [node]} mem-node-config] + (let [library {:statements + {:def + [{:type "ExpressionDef" + :name "name-174207" + :resultTypeName "{http://hl7.org/fhir}Patient"}]}} + elm #elm/retrieve + {:type "Observation" + :context #elm/expression-ref "name-174207"} + expr (c/compile {:node node :library library} elm)] + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(retrieve (expr-ref "name-174207") "Observation")))))) + (testing "with pre-compiled database query" (with-system [{:blaze.db/keys [node]} mem-node-config] (let [library {:codeSystems @@ -339,8 +412,14 @@ :codes #elm/list [#elm/code ["sys-def-174848" "code-174911"]]} expr (c/compile {:node node :library library} elm)] - (given expr - type := WithRelatedContextQueryRetrieveExpression)))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr + '(retrieve (expr-ref "name-174207") "Observation" + [["code" "system-174915|code-174911"]])))))) (testing "unknown code property" (with-system [{:blaze.db/keys [node]} mem-node-config] @@ -357,6 +436,7 @@ :codes #elm/list [#elm/code ["sys-def-174848" "code-174911"]] :code-property "foo"}] + (given (ba/try-anomaly (c/compile {:node node :library library} elm)) ::anom/category := ::anom/not-found ::anom/message := "The search-param with code `foo` and type `Observation` was not found."))))) diff --git a/modules/cql/test/blaze/elm/compiler/interval_operators_test.clj b/modules/cql/test/blaze/elm/compiler/interval_operators_test.clj index 8d7e77a58..d65cc4e17 100644 --- a/modules/cql/test/blaze/elm/compiler/interval_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/interval_operators_test.clj @@ -6,12 +6,14 @@ (:require [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.interval-operators] [blaze.elm.compiler.test-util :as tu] [blaze.elm.decimal :as decimal] [blaze.elm.interval :refer [interval]] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] + [blaze.test-util :refer [given-thrown]] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [are deftest testing]])) @@ -249,6 +251,8 @@ "2019-04-17" "2019-04-17" false "2019-04-17" "2019-04-18" false))) + (tu/testing-binary-precision-dynamic elm/after) + (tu/testing-binary-precision-form elm/after)) @@ -386,6 +390,8 @@ "2019-04-17" "2019-04-17" false "2019-04-17" "2019-04-16" false))) + (tu/testing-binary-precision-dynamic elm/before) + (tu/testing-binary-precision-form elm/before)) @@ -444,6 +450,8 @@ {:type "Null"} [(interval #system/date-time"2012-01-01" #system/date-time"2012-05-25")])) + (tu/testing-binary-dynamic elm/collapse) + (tu/testing-binary-form elm/collapse)) @@ -490,6 +498,8 @@ (tu/testing-binary-null elm/contains #elm/list [] #elm/integer "1")) + (tu/testing-binary-precision-dynamic elm/contains) + (tu/testing-binary-precision-form elm/contains)) @@ -521,6 +531,8 @@ (tu/testing-unary-null elm/end) + (tu/testing-unary-dynamic elm/end) + (tu/testing-unary-form elm/end)) @@ -548,6 +560,8 @@ (tu/testing-binary-null elm/ends interval-zero) + (tu/testing-binary-dynamic elm/ends) + (tu/testing-binary-precision-form elm/ends)) @@ -600,6 +614,8 @@ (tu/testing-binary-null elm/except interval-zero)) + (tu/testing-binary-dynamic elm/except) + (tu/testing-binary-form elm/except)) @@ -694,6 +710,8 @@ (tu/testing-binary-null elm/includes interval-zero)) + (tu/testing-binary-precision-dynamic elm/includes) + (tu/testing-binary-precision-form elm/includes)) @@ -759,6 +777,8 @@ (tu/testing-binary-null elm/intersect interval-zero)) + (tu/testing-binary-dynamic elm/intersect) + (tu/testing-binary-form elm/intersect)) @@ -792,6 +812,8 @@ (tu/testing-binary-null elm/meets-before interval-zero) + (tu/testing-binary-precision-dynamic elm/meets-before) + (tu/testing-binary-precision-form elm/meets-before)) @@ -817,6 +839,8 @@ (tu/testing-binary-null elm/meets-after interval-zero) + (tu/testing-binary-precision-dynamic elm/meets-after) + (tu/testing-binary-precision-form elm/meets-after)) @@ -872,6 +896,8 @@ (tu/testing-binary-null elm/overlaps interval-zero) + (tu/testing-binary-precision-dynamic elm/overlaps) + (tu/testing-binary-precision-form elm/overlaps)) @@ -897,13 +923,37 @@ ;; ;; If the source interval is null, the result is null. (deftest compile-point-from-test - (testing "Integer" - (are [x res] (= res (tu/compile-unop elm/point-from elm/interval x)) - [#elm/integer "1" #elm/integer "1"] 1 - [#elm/integer "2" #elm/integer "2"] 2)) + (testing "Static" + (testing "Integer" + (are [x res] (= res (tu/compile-unop elm/point-from elm/interval x)) + [#elm/integer "1" #elm/integer "1"] 1 + [#elm/integer "2" #elm/integer "2"] 2) + + (given-thrown (tu/compile-unop elm/point-from + (tu/with-locator elm/interval "locator-214950") + [#elm/integer "1" #elm/integer "2"]) + :message := "Invalid non-unit interval in `PointFrom` expression at locator-214950." + [:expression :type] := "PointFrom" + [:expression :operand :type] := "Interval" + [:expression :operand :locator] := "locator-214950"))) + + (testing "Dynamic" + (testing "Integer" + (are [elm res] (= res (tu/dynamic-compile-eval elm)) + #elm/point-from #elm/interval [#elm/integer "1" #elm/parameter-ref "1"] 1 + #elm/point-from #elm/interval [#elm/integer "2" #elm/parameter-ref "2"] 2) + + (given-thrown (tu/dynamic-compile-eval (elm/point-from ((tu/with-locator elm/interval "locator-161410") + [#elm/integer "1" #elm/parameter-ref "2"]))) + :message := "Invalid non-unit interval in `PointFrom` expression at locator-161410." + [:expression :type] := "PointFrom" + [:expression :operand :type] := "Interval" + [:expression :operand :locator] := "locator-161410"))) (tu/testing-unary-null elm/point-from) + (tu/testing-unary-dynamic elm/point-from) + (tu/testing-unary-form elm/point-from)) @@ -937,6 +987,8 @@ (tu/testing-binary-null elm/proper-contains interval-zero)) + (tu/testing-binary-precision-dynamic elm/proper-contains) + (tu/testing-binary-precision-form elm/proper-contains)) @@ -978,6 +1030,8 @@ (tu/testing-binary-null elm/proper-includes interval-zero)) + (tu/testing-binary-precision-dynamic elm/proper-includes) + (tu/testing-binary-precision-form elm/proper-includes)) @@ -1032,6 +1086,8 @@ (tu/testing-unary-null elm/start) + (tu/testing-unary-dynamic elm/start) + (tu/testing-unary-form elm/start)) @@ -1059,6 +1115,8 @@ (tu/testing-binary-null elm/starts interval-zero) + (tu/testing-binary-precision-dynamic elm/starts) + (tu/testing-binary-precision-form elm/starts)) @@ -1095,6 +1153,8 @@ (tu/testing-binary-null elm/union interval-zero)) + (tu/testing-binary-dynamic elm/union) + (tu/testing-binary-form elm/union)) @@ -1114,4 +1174,6 @@ (tu/testing-unary-null elm/width) + (tu/testing-unary-dynamic elm/width) + (tu/testing-unary-form elm/width)) diff --git a/modules/cql/test/blaze/elm/compiler/list_operators_test.clj b/modules/cql/test/blaze/elm/compiler/list_operators_test.clj index 73ca2b0b6..8709ea928 100644 --- a/modules/cql/test/blaze/elm/compiler/list_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/list_operators_test.clj @@ -5,20 +5,29 @@ https://cql.hl7.org/04-logicalspecification.html." (:require [blaze.anomaly-spec] + [blaze.db.api :as d] + [blaze.db.api-stub :refer [mem-node-config with-system-data]] [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] + [blaze.elm.compiler.external-data :as ed] [blaze.elm.compiler.list-operators] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] + [blaze.elm.expression :as expr] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] [blaze.elm.quantity :as quantity] [blaze.test-util :refer [satisfies-prop]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] - [clojure.test :as test :refer [are deftest testing]] - [clojure.test.check.properties :as prop])) + [clojure.test :as test :refer [are deftest is testing]] + [clojure.test.check.properties :as prop]) + (:import + [com.github.benmanes.caffeine.cache Caffeine] + [java.time OffsetDateTime])) +(set! *warn-on-reflection* true) (st/instrument) (tu/instrument-compile) @@ -44,21 +53,27 @@ ;; ;; If any argument is null, the resulting list will have null for that element. (deftest compile-list-test - (are [elm res] (= res (core/-eval (c/compile {} elm) {} nil nil)) - #elm/list [] - [] + (testing "Static" + (are [elm res] (= res (c/compile {} elm)) + #elm/list [] [] + #elm/list [{:type "Null"}] [nil] + #elm/list [#elm/integer "1"] [1] + #elm/list [#elm/integer "1" {:type "Null"}] [1 nil] + #elm/list [#elm/integer "1" #elm/integer "2"] [1 2]) - #elm/list [{:type "Null"}] - [nil] + (testing "form" + (is (= [] (c/form (c/compile {} #elm/list [])))))) - #elm/list [#elm/integer "1"] - [1] + (testing "Dynamic" + (are [elm res] (= res (tu/dynamic-compile-eval elm)) + #elm/list [#elm/parameter-ref "nil"] [nil] + #elm/list [#elm/parameter-ref "1"] [1] + #elm/list [#elm/parameter-ref "1" #elm/parameter-ref "nil"] [1 nil] + #elm/list [#elm/parameter-ref "1" #elm/parameter-ref "2"] [1 2]) - #elm/list [#elm/integer "1" {:type "Null"}] - [1 nil] - - #elm/list [#elm/integer "1" #elm/integer "2"] - [1 2])) + (testing "form" + (let [expr (tu/dynamic-compile #elm/list [#elm/parameter-ref "x"])] + (has-form expr '(list (param-ref "x"))))))) ;; 20.2. Contains @@ -78,14 +93,22 @@ (testing "default scope" (satisfies-prop 100 (prop/for-all [x (s/gen int?)] - (= x (core/-eval (c/compile {} {:type "Current"}) {} nil x))))) + (= x (core/-eval (c/compile {} #elm/current nil) {} nil x)))) + + (testing "form" + (let [expr (c/compile {} #elm/current nil)] + (has-form expr 'current)))) (testing "named scope" (satisfies-prop 100 (prop/for-all [scope (s/gen string?) x (s/gen int?)] - (let [expr (c/compile {} {:type "Current" :scope scope})] - (= x (core/-eval expr {} nil {scope x}))))))) + (let [expr (c/compile {} (elm/current scope))] + (= x (core/-eval expr {} nil {scope x}))))) + + (testing "form" + (let [expr (c/compile {} #elm/current "x")] + (has-form expr '(current "x")))))) ;; 20.4. Distinct @@ -113,6 +136,8 @@ (tu/testing-unary-null elm/distinct) + (tu/testing-unary-dynamic elm/distinct) + (tu/testing-unary-form elm/distinct)) @@ -133,16 +158,60 @@ ;; 20.8. Exists ;; -;; The Exists operator returns true if the list contains any elements. +;; The Exists operator returns true if the list contains any non-null elements. ;; ;; If the argument is null, the result is false. (deftest compile-exists-test - (are [list res] (= res (c/compile {} (elm/exists list))) - #elm/list [#elm/integer "1"] true - #elm/list [#elm/integer "1" #elm/integer "1"] true - #elm/list [] false - - {:type "Null"} false) + (testing "Static" + (are [list res] (= res (c/compile {} (elm/exists list))) + #elm/list [#elm/integer "1"] true + #elm/list [#elm/integer "1" #elm/integer "1"] true + #elm/list [{:type "Null"}] false + #elm/list [] false + + {:type "Null"} false)) + + (testing "Dynamic" + (are [list res] (= res (tu/dynamic-compile-eval (elm/exists list))) + #elm/list [#elm/parameter-ref "1"] true + #elm/list [#elm/parameter-ref "1" #elm/parameter-ref "1"] true + #elm/list [#elm/parameter-ref "nil"] false + #elm/list [] false + + {:type "Null"} false) + + (testing "with patient" + (with-system-data [{:blaze.db/keys [node]} mem-node-config] + [[[:put {:fhir/type :fhir/Patient :id "0"}]]] + + (let [db (d/db node) + patient (ed/mk-resource db (d/resource-handle db "Patient" "0")) + elm #elm/exists #elm/retrieve{:type "Observation"} + compile-context + {:node node + :eval-context "Patient" + :library {}} + expr (c/compile compile-context elm) + eval-context + {:db db + ::expr/cache (.build (Caffeine/newBuilder)) + :now (OffsetDateTime/now)}] + + (testing "has no Observation at the beginning" + (is (false? (expr/eval eval-context expr patient)))) + + (let [tx-op [:put {:fhir/type :fhir/Observation :id "0" + :subject #fhir/Reference{:reference "Patient/0"}}] + db-after @(d/transact node [tx-op])] + + (testing "has an Observation after transaction" + (let [patient (ed/mk-resource db-after (d/resource-handle db "Patient" "0"))] + (is (true? (expr/eval (assoc eval-context :db db-after) expr patient))))) + + (testing "has still no Observation at the old database" + (is (false? (expr/eval eval-context expr patient))))))))) + + (tu/testing-unary-dynamic elm/exists) (tu/testing-unary-form elm/exists)) @@ -154,11 +223,46 @@ ;; ;; If the source argument is null, the result is null. (deftest compile-filter-test - (are [source condition res] (= res (core/-eval (c/compile {} {:type "Filter" :source source :condition condition :scope "A"}) {} nil nil)) - #elm/list [#elm/integer "1"] #elm/boolean "false" [] - #elm/list [#elm/integer "1"] #elm/equal [#elm/current "A" #elm/integer "1"] [1] + (testing "eval" + (let [eval #(core/-eval % {} nil nil)] + (testing "with scope" + (are [source condition res] (= res (eval (c/compile {} {:type "Filter" + :source source + :condition condition + :scope "A"}))) + #elm/list [#elm/integer "1"] #elm/boolean "false" [] + #elm/list [#elm/integer "1"] #elm/equal [#elm/current "A" #elm/integer "1"] [1] + + {:type "Null"} #elm/boolean "true" nil)) + + (testing "without scope" + (are [source condition res] (= res (eval (c/compile {} {:type "Filter" + :source source + :condition condition}))) + #elm/list [#elm/integer "1"] #elm/boolean "false" [] + #elm/list [#elm/integer "1"] #elm/equal [#elm/current nil #elm/integer "1"] [1] + + {:type "Null"} #elm/boolean "true" nil)))) + + (testing "form and static" + (testing "with scope" + (let [expr (tu/dynamic-compile {:type "Filter" + :source #elm/parameter-ref "x" + :condition #elm/parameter-ref "y" + :scope "A"})] + + (has-form expr '(filter (param-ref "x") (param-ref "y") "A")) - {:type "Null"} #elm/boolean "true" nil)) + (is (false? (core/-static expr))))) + + (testing "without scope" + (let [expr (tu/dynamic-compile {:type "Filter" + :source #elm/parameter-ref "x" + :condition #elm/parameter-ref "y"})] + + (has-form expr '(filter (param-ref "x") (param-ref "y"))) + + (is (false? (core/-static expr))))))) ;; 20.10. First @@ -169,11 +273,21 @@ ;; ;; If the argument is null, the result is null. (deftest compile-first-test - (are [source res] (= res (core/-eval (c/compile {} (elm/first source)) {} nil nil)) - #elm/list [#elm/integer "1"] 1 - #elm/list [#elm/integer "1" #elm/integer "2"] 1 + (testing "Static" + (are [source res] (= res (core/-eval (c/compile {} (elm/first source)) {} nil nil)) + #elm/list [#elm/integer "1"] 1 + #elm/list [#elm/integer "1" #elm/integer "2"] 1)) + + (testing "Dynamic" + (are [source res] (= res (tu/dynamic-compile-eval (elm/first source))) + #elm/parameter-ref "[1]" 1 + #elm/parameter-ref "[1 2]" 1)) - {:type "Null"} nil)) + (tu/testing-unary-null elm/first) + + (tu/testing-unary-dynamic elm/first) + + (tu/testing-unary-form elm/first)) ;; 20.11. Flatten @@ -192,6 +306,8 @@ (tu/testing-unary-null elm/flatten) + (tu/testing-unary-dynamic elm/flatten) + (tu/testing-unary-form elm/flatten)) @@ -207,18 +323,46 @@ ;; If the element argument evaluates to null for some item in the source list, ;; the resulting list will contain a null for that element. (deftest compile-for-each-test - (testing "Without scope" - (are [source element res] (= res (core/-eval (c/compile {} {:type "ForEach" :source source :element element}) {} nil nil)) - #elm/list [#elm/integer "1"] {:type "Null"} [nil] + (testing "eval" + (let [eval #(core/-eval % {} nil nil)] + (testing "with scope" + (are [source element res] (= res (eval (c/compile {} {:type "ForEach" + :source source + :element element + :scope "A"}))) + #elm/list [#elm/integer "1"] #elm/current "A" [1] + #elm/list [#elm/integer "1" #elm/integer "2"] #elm/add [#elm/current "A" #elm/integer "1"] [2 3] + + {:type "Null"} {:type "Null"} nil)) + + (testing "without scope" + (are [source element res] (= res (eval (c/compile {} {:type "ForEach" + :source source + :element element}))) + #elm/list [#elm/integer "1"] #elm/current nil [1] + #elm/list [#elm/integer "1" #elm/integer "2"] #elm/add [#elm/current nil #elm/integer "1"] [2 3] - {:type "Null"} {:type "Null"} nil)) + {:type "Null"} {:type "Null"} nil)))) - (testing "With scope" - (are [source element res] (= res (core/-eval (c/compile {} {:type "ForEach" :source source :element element :scope "A"}) {} nil nil)) - #elm/list [#elm/integer "1"] #elm/current "A" [1] - #elm/list [#elm/integer "1" #elm/integer "2"] #elm/add [#elm/current "A" #elm/integer "1"] [2 3] + (testing "form and static" + (testing "with scope" + (let [expr (tu/dynamic-compile {:type "ForEach" + :source #elm/parameter-ref "x" + :element #elm/parameter-ref "y" + :scope "A"})] - {:type "Null"} {:type "Null"} nil))) + (has-form expr '(for-each (param-ref "x") (param-ref "y") "A")) + + (is (false? (core/-static expr))))) + + (testing "without scope" + (let [expr (tu/dynamic-compile {:type "ForEach" + :source #elm/parameter-ref "x" + :element #elm/parameter-ref "y"})] + + (has-form expr '(for-each (param-ref "x") (param-ref "y"))) + + (is (false? (core/-static expr))))))) ;; 20.13. In @@ -249,7 +393,7 @@ ;; ;; If either argument is null, the result is null. (deftest compile-index-of-test - (are [source element res] (= res (core/-eval (c/compile {} {:type "IndexOf" :source source :element element}) {} nil nil)) + (are [source element res] (= res (core/-eval (c/compile {} (elm/index-of [source element])) {} nil nil)) #elm/list [] #elm/integer "1" -1 #elm/list [#elm/integer "1"] #elm/integer "1" 0 #elm/list [#elm/integer "1" #elm/integer "1"] #elm/integer "1" 0 @@ -257,7 +401,13 @@ #elm/list [] {:type "Null"} nil {:type "Null"} #elm/integer "1" nil - {:type "Null"} {:type "Null"} nil)) + {:type "Null"} {:type "Null"} nil) + + (tu/testing-binary-dynamic-null elm/index-of #elm/list [] #elm/integer "1") + + (tu/testing-binary-dynamic elm/index-of) + + (tu/testing-binary-form elm/index-of)) ;; 20.17. Intersect @@ -273,11 +423,21 @@ ;; ;; If the argument is null, the result is null. (deftest compile-last-test - (are [source res] (= res (core/-eval (c/compile {} {:type "Last" :source source}) {} nil nil)) - #elm/list [#elm/integer "1"] 1 - #elm/list [#elm/integer "1" #elm/integer "2"] 2 + (testing "Static" + (are [source res] (= res (core/-eval (c/compile {} (elm/last source)) {} nil nil)) + #elm/list [#elm/integer "1"] 1 + #elm/list [#elm/integer "1" #elm/integer "2"] 2)) + + (testing "Dynamic" + (are [source res] (= res (tu/dynamic-compile-eval (elm/last source))) + #elm/parameter-ref "[1]" 1 + #elm/parameter-ref "[1 2]" 2)) + + (tu/testing-unary-null elm/last) - {:type "Null"} nil)) + (tu/testing-unary-dynamic elm/last) + + (tu/testing-unary-form elm/last)) ;; 20.19. Not Equal @@ -337,7 +497,11 @@ (are [list] (thrown? Exception (core/-eval (c/compile {} (elm/singleton-from list)) {} nil nil)) #elm/list [#elm/integer "1" #elm/integer "1"]) - (tu/testing-unary-null elm/singleton-from)) + (tu/testing-unary-null elm/singleton-from) + + (tu/testing-unary-dynamic elm/singleton-from) + + (tu/testing-unary-form elm/singleton-from)) ;; 20.26. Slice @@ -366,7 +530,19 @@ {:type "Null"} #elm/integer "0" #elm/integer "0" nil - {:type "Null"} {:type "Null"} {:type "Null"} nil)) + {:type "Null"} {:type "Null"} {:type "Null"} nil) + + (let [expr (tu/dynamic-compile {:type "Slice" + :source #elm/parameter-ref "x" + :startIndex #elm/parameter-ref "y" + :endIndex #elm/parameter-ref "z"})] + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (is (= '(slice (param-ref "x") (param-ref "y") (param-ref "z")) + (core/-form expr)))))) ;; 20.27. Sort @@ -387,7 +563,17 @@ #elm/list [#elm/integer "1" #elm/integer "2"] {:type "ByDirection" :direction "desc"} [2 1] - {:type "Null"} {:type "ByDirection" :direction "asc"} nil)) + {:type "Null"} {:type "ByDirection" :direction "asc"} nil) + + (let [expr (tu/dynamic-compile {:type "Sort" + :source #elm/parameter-ref "x" + :by [{:type "ByDirection" :direction "asc"}]})] + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (is (= '(sort (param-ref "x") :asc) (core/-form expr)))))) ;; 20.28. Times @@ -447,6 +633,8 @@ (tu/testing-binary-null elm/times #elm/list[#elm/tuple{"name" #elm/string "hans"}]) + (tu/testing-binary-dynamic elm/times) + (tu/testing-binary-form elm/times)) diff --git a/modules/cql/test/blaze/elm/compiler/logical_operators_test.clj b/modules/cql/test/blaze/elm/compiler/logical_operators_test.clj index edfd657f6..87ae59d81 100644 --- a/modules/cql/test/blaze/elm/compiler/logical_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/logical_operators_test.clj @@ -5,6 +5,7 @@ https://cql.hl7.org/04-logicalspecification.html." (:require [blaze.elm.compiler :as c] + [blaze.elm.compiler.core :as core] [blaze.elm.compiler.logical-operators] [blaze.elm.compiler.test-util :as tu] [blaze.elm.literal :as elm] @@ -72,54 +73,55 @@ #elm/parameter-ref "nil" #elm/parameter-ref "nil" nil)) (testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "a"} {:name "b"}]}}}] - (are [x y form] (= form (c/form (c/compile compile-ctx# (elm/and [x y])))) - #elm/boolean "true" #elm/boolean "true" true - #elm/boolean "true" #elm/boolean "false" false - #elm/boolean "true" {:type "Null"} nil - #elm/boolean "true" #elm/parameter-ref "b" '(param-ref "b") - - #elm/boolean "false" #elm/boolean "true" false - #elm/boolean "false" #elm/boolean "false" false - #elm/boolean "false" {:type "Null"} false - #elm/boolean "false" #elm/parameter-ref "b" false + (are [x y form] (= form (c/form (tu/dynamic-compile (elm/and [x y])))) + #elm/boolean "true" #elm/boolean "true" true + #elm/boolean "true" #elm/boolean "false" false + #elm/boolean "true" {:type "Null"} nil + #elm/boolean "true" #elm/parameter-ref "b" '(param-ref "b") - {:type "Null"} #elm/boolean "true" nil - {:type "Null"} #elm/boolean "false" false - {:type "Null"} {:type "Null"} nil - {:type "Null"} #elm/parameter-ref "b" '(and nil (param-ref "b")) + #elm/boolean "false" #elm/boolean "true" false + #elm/boolean "false" #elm/boolean "false" false + #elm/boolean "false" {:type "Null"} false + #elm/boolean "false" #elm/parameter-ref "b" false - #elm/parameter-ref "a" #elm/boolean "true" '(param-ref "a") - #elm/parameter-ref "a" #elm/boolean "false" false - #elm/parameter-ref "a" {:type "Null"} '(and nil (param-ref "a")) - #elm/parameter-ref "a" #elm/parameter-ref "b" '(and (param-ref "a") (param-ref "b")))))) + {:type "Null"} #elm/boolean "true" nil + {:type "Null"} #elm/boolean "false" false + {:type "Null"} {:type "Null"} nil + {:type "Null"} #elm/parameter-ref "b" '(and nil (param-ref "b")) + #elm/parameter-ref "a" #elm/boolean "true" '(param-ref "a") + #elm/parameter-ref "a" #elm/boolean "false" false + #elm/parameter-ref "a" {:type "Null"} '(and nil (param-ref "a")) + #elm/parameter-ref "a" #elm/parameter-ref "b" '(and (param-ref "a") (param-ref "b")))) -;; 13.2. Implies -;; -;; The Implies operator returns the logical implication of its arguments. Note -;; that this operator is defined using 3-valued logic semantics. This means that -;; if the left operand evaluates to true, this operator returns the boolean -;; evaluation of the right operand. If the left operand evaluates to false, this -;; operator returns true. Otherwise, this operator returns true if the right -;; operand evaluates to true, and null otherwise. -;; -;; Note that implies may use short-circuit evaluation in the case that the first -;; operand evaluates to false. -(deftest compile-implies-test - (testing "Static" - (are [x y res] (= res (c/compile {} (elm/or [(elm/not x) y]))) + (testing "static" + (are [x y static] (identical? static (core/-static (tu/dynamic-compile (elm/and [x y])))) #elm/boolean "true" #elm/boolean "true" true - #elm/boolean "true" #elm/boolean "false" false - #elm/boolean "true" {:type "Null"} nil + #elm/boolean "true" #elm/boolean "false" true + #elm/boolean "true" {:type "Null"} true + #elm/boolean "true" #elm/parameter-ref "b" false #elm/boolean "false" #elm/boolean "true" true #elm/boolean "false" #elm/boolean "false" true #elm/boolean "false" {:type "Null"} true + #elm/boolean "false" #elm/parameter-ref "b" true {:type "Null"} #elm/boolean "true" true - {:type "Null"} #elm/boolean "false" nil - {:type "Null"} {:type "Null"} nil))) + {:type "Null"} #elm/boolean "false" true + {:type "Null"} {:type "Null"} true + {:type "Null"} #elm/parameter-ref "b" false + + #elm/parameter-ref "a" #elm/boolean "true" false + #elm/parameter-ref "a" #elm/boolean "false" true + #elm/parameter-ref "a" {:type "Null"} false + #elm/parameter-ref "a" #elm/parameter-ref "b" false))) + + +;; 13.2. Implies +;; +;; Normalized to (Or (Not x) y) +(deftest compile-implies-test + (tu/unsupported-binary-operand "Implies")) ;; 13.3. Not @@ -131,14 +133,16 @@ (testing "Static" (are [x res] (= res (c/compile {} (elm/not x))) #elm/boolean "true" false - #elm/boolean "false" true - {:type "Null"} nil)) + #elm/boolean "false" true)) (testing "Dynamic" (are [x res] (= res (tu/dynamic-compile-eval (elm/not x))) #elm/parameter-ref "true" false - #elm/parameter-ref "false" true - #elm/parameter-ref "nil" nil)) + #elm/parameter-ref "false" true)) + + (tu/testing-unary-null elm/not) + + (tu/testing-unary-dynamic elm/not) (tu/testing-unary-form elm/not)) @@ -186,27 +190,48 @@ #elm/parameter-ref "nil" #elm/parameter-ref "nil" nil)) (testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "a"} {:name "b"}]}}}] - (are [x y form] (= form (c/form (c/compile compile-ctx# (elm/or [x y])))) - #elm/boolean "true" #elm/boolean "true" true - #elm/boolean "true" #elm/boolean "false" true - #elm/boolean "true" {:type "Null"} true - #elm/boolean "true" #elm/parameter-ref "b" true + (are [x y form] (= form (c/form (tu/dynamic-compile (elm/or [x y])))) + #elm/boolean "true" #elm/boolean "true" true + #elm/boolean "true" #elm/boolean "false" true + #elm/boolean "true" {:type "Null"} true + #elm/boolean "true" #elm/parameter-ref "b" true - #elm/boolean "false" #elm/boolean "true" true - #elm/boolean "false" #elm/boolean "false" false - #elm/boolean "false" {:type "Null"} nil - #elm/boolean "false" #elm/parameter-ref "b" '(param-ref "b") + #elm/boolean "false" #elm/boolean "true" true + #elm/boolean "false" #elm/boolean "false" false + #elm/boolean "false" {:type "Null"} nil + #elm/boolean "false" #elm/parameter-ref "b" '(param-ref "b") - {:type "Null"} #elm/boolean "true" true - {:type "Null"} #elm/boolean "false" nil - {:type "Null"} {:type "Null"} nil - {:type "Null"} #elm/parameter-ref "b" '(or nil (param-ref "b")) + {:type "Null"} #elm/boolean "true" true + {:type "Null"} #elm/boolean "false" nil + {:type "Null"} {:type "Null"} nil + {:type "Null"} #elm/parameter-ref "b" '(or nil (param-ref "b")) - #elm/parameter-ref "a" #elm/boolean "true" true - #elm/parameter-ref "a" #elm/boolean "false" '(param-ref "a") - #elm/parameter-ref "a" {:type "Null"} '(or nil (param-ref "a")) - #elm/parameter-ref "a" #elm/parameter-ref "b" '(or (param-ref "a") (param-ref "b")))))) + #elm/parameter-ref "a" #elm/boolean "true" true + #elm/parameter-ref "a" #elm/boolean "false" '(param-ref "a") + #elm/parameter-ref "a" {:type "Null"} '(or nil (param-ref "a")) + #elm/parameter-ref "a" #elm/parameter-ref "b" '(or (param-ref "a") (param-ref "b")))) + + (testing "static" + (are [x y static] (identical? static (core/-static (tu/dynamic-compile (elm/or [x y])))) + #elm/boolean "true" #elm/boolean "true" true + #elm/boolean "true" #elm/boolean "false" true + #elm/boolean "true" {:type "Null"} true + #elm/boolean "true" #elm/parameter-ref "b" true + + #elm/boolean "false" #elm/boolean "true" true + #elm/boolean "false" #elm/boolean "false" true + #elm/boolean "false" {:type "Null"} true + #elm/boolean "false" #elm/parameter-ref "b" false + + {:type "Null"} #elm/boolean "true" true + {:type "Null"} #elm/boolean "false" true + {:type "Null"} {:type "Null"} true + {:type "Null"} #elm/parameter-ref "b" false + + #elm/parameter-ref "a" #elm/boolean "true" true + #elm/parameter-ref "a" #elm/boolean "false" false + #elm/parameter-ref "a" {:type "Null"} false + #elm/parameter-ref "a" #elm/parameter-ref "b" false))) ;; 13.5. Xor @@ -255,24 +280,45 @@ #elm/parameter-ref "nil" #elm/parameter-ref "nil" nil)) (testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "a"} {:name "b"}]}}}] - (are [x y form] (= form (c/form (c/compile compile-ctx# (elm/xor [x y])))) - #elm/boolean "true" #elm/boolean "true" false - #elm/boolean "true" #elm/boolean "false" true - #elm/boolean "true" {:type "Null"} nil - #elm/boolean "true" #elm/parameter-ref "b" '(not (param-ref "b")) - - #elm/boolean "false" #elm/boolean "true" true - #elm/boolean "false" #elm/boolean "false" false - #elm/boolean "false" {:type "Null"} nil - #elm/boolean "false" #elm/parameter-ref "b" '(param-ref "b") - - {:type "Null"} #elm/boolean "true" nil - {:type "Null"} #elm/boolean "false" nil - {:type "Null"} {:type "Null"} nil - {:type "Null"} #elm/parameter-ref "b" nil - - #elm/parameter-ref "a" #elm/boolean "true" '(not (param-ref "a")) - #elm/parameter-ref "a" #elm/boolean "false" '(param-ref "a") - #elm/parameter-ref "a" {:type "Null"} nil - #elm/parameter-ref "a" #elm/parameter-ref "b" '(xor (param-ref "a") (param-ref "b")))))) + (are [x y form] (= form (c/form (tu/dynamic-compile (elm/xor [x y])))) + #elm/boolean "true" #elm/boolean "true" false + #elm/boolean "true" #elm/boolean "false" true + #elm/boolean "true" {:type "Null"} nil + #elm/boolean "true" #elm/parameter-ref "b" '(not (param-ref "b")) + + #elm/boolean "false" #elm/boolean "true" true + #elm/boolean "false" #elm/boolean "false" false + #elm/boolean "false" {:type "Null"} nil + #elm/boolean "false" #elm/parameter-ref "b" '(param-ref "b") + + {:type "Null"} #elm/boolean "true" nil + {:type "Null"} #elm/boolean "false" nil + {:type "Null"} {:type "Null"} nil + {:type "Null"} #elm/parameter-ref "b" nil + + #elm/parameter-ref "a" #elm/boolean "true" '(not (param-ref "a")) + #elm/parameter-ref "a" #elm/boolean "false" '(param-ref "a") + #elm/parameter-ref "a" {:type "Null"} nil + #elm/parameter-ref "a" #elm/parameter-ref "b" '(xor (param-ref "a") (param-ref "b")))) + + (testing "static" + (are [x y static] (identical? static (core/-static (tu/dynamic-compile (elm/xor [x y])))) + #elm/boolean "true" #elm/boolean "true" true + #elm/boolean "true" #elm/boolean "false" true + #elm/boolean "true" {:type "Null"} true + #elm/boolean "true" #elm/parameter-ref "b" false + + #elm/boolean "false" #elm/boolean "true" true + #elm/boolean "false" #elm/boolean "false" true + #elm/boolean "false" {:type "Null"} true + #elm/boolean "false" #elm/parameter-ref "b" false + + {:type "Null"} #elm/boolean "true" true + {:type "Null"} #elm/boolean "false" true + {:type "Null"} {:type "Null"} true + {:type "Null"} #elm/parameter-ref "b" true + + #elm/parameter-ref "a" #elm/boolean "true" false + #elm/parameter-ref "a" #elm/boolean "false" false + #elm/parameter-ref "a" {:type "Null"} true + #elm/parameter-ref "a" #elm/parameter-ref "b" false))) diff --git a/modules/cql/test/blaze/elm/compiler/nullological_operators_test.clj b/modules/cql/test/blaze/elm/compiler/nullological_operators_test.clj index 7a73dc6c8..1e701182a 100644 --- a/modules/cql/test/blaze/elm/compiler/nullological_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/nullological_operators_test.clj @@ -6,6 +6,7 @@ (:require [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] @@ -50,7 +51,13 @@ [#elm/integer "2"] 2 [#elm/list []] nil [{:type "Null"} #elm/list [#elm/string "a"]] ["a"] - [#elm/list [{:type "Null"} #elm/string "a"]] "a")) + [#elm/list [{:type "Null"} #elm/string "a"]] "a") + + (testing "expression is dynamic" + (are [elm] (false? (core/-static (tu/dynamic-compile (elm/coalesce elm)))) + [] + [{:type "Null"}] + [#elm/list []]))) ;; 14.3. IsFalse @@ -71,6 +78,8 @@ #elm/parameter-ref "false" true #elm/parameter-ref "nil" false)) + (tu/testing-unary-dynamic elm/is-false) + (tu/testing-unary-form elm/is-false)) @@ -92,6 +101,8 @@ #elm/parameter-ref "false" false #elm/parameter-ref "nil" true)) + (tu/testing-unary-dynamic elm/is-null) + (tu/testing-unary-form elm/is-null)) @@ -113,4 +124,6 @@ #elm/parameter-ref "false" false #elm/parameter-ref "nil" false)) + (tu/testing-unary-dynamic elm/is-true) + (tu/testing-unary-form elm/is-true)) diff --git a/modules/cql/test/blaze/elm/compiler/parameters_test.clj b/modules/cql/test/blaze/elm/compiler/parameters_test.clj index bcef1b140..665c5d23f 100644 --- a/modules/cql/test/blaze/elm/compiler/parameters_test.clj +++ b/modules/cql/test/blaze/elm/compiler/parameters_test.clj @@ -8,8 +8,9 @@ [blaze.elm.code-spec] [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.parameters :refer [->ParameterRef]] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.literal] [blaze.elm.literal-spec] [clojure.spec.test.alpha :as st] @@ -47,7 +48,7 @@ (is (= (->ParameterRef "parameter-def-101820") expr)) (testing "form" - (is (= '(param-ref "parameter-def-101820") (core/-form expr)))))) + (has-form expr '(param-ref "parameter-def-101820"))))) (testing "definition not found" (let [context {:library {}}] diff --git a/modules/cql/test/blaze/elm/compiler/queries_test.clj b/modules/cql/test/blaze/elm/compiler/queries_test.clj index 1bd86002b..57bf10167 100644 --- a/modules/cql/test/blaze/elm/compiler/queries_test.clj +++ b/modules/cql/test/blaze/elm/compiler/queries_test.clj @@ -11,8 +11,9 @@ [blaze.elm.code-spec] [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.queries :as queries] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.literal] [blaze.elm.literal-spec] [blaze.elm.quantity :as quantity] @@ -62,9 +63,9 @@ [{:alias "S" :expression #elm/list - [#elm/quantity [2 "m"] - #elm/quantity [1 "m"] - #elm/quantity [1 "m"]]}] + [#elm/quantity [2 "m"] + #elm/quantity [1 "m"] + #elm/quantity [1 "m"]]}] :sort {:by [{:type "ByExpression" @@ -83,12 +84,12 @@ [{:alias "S" :expression #elm/list - [#elm/instance ["{urn:hl7-org:elm-types:r1}Code" - {"system" #elm/string "foo" - "code" #elm/string "c"}] - #elm/instance ["{urn:hl7-org:elm-types:r1}Code" - {"system" #elm/string "bar" - "code" #elm/string "c"}]]}] + [#elm/instance ["{urn:hl7-org:elm-types:r1}Code" + {"system" #elm/string "foo" + "code" #elm/string "c"}] + #elm/instance ["{urn:hl7-org:elm-types:r1}Code" + {"system" #elm/string "bar" + "code" #elm/string "c"}]]}] :sort {:by [{:type "ByExpression" @@ -111,8 +112,7 @@ (is (= [1 1] (core/-eval expr {} nil nil)))) (testing "form" - (is (= '(vector-query (return (fn [S] (alias-ref S))) [1 1]) - (core/-form expr)))))) + (has-form expr '(vector-query (return (fn [S] (alias-ref S))) [1 1]))))) (testing "with query hint optimize first" (let [elm {:type "Query" @@ -125,7 +125,7 @@ (is (= [1] (into [] (core/-eval expr {} nil nil))))) (testing "form" - (is (= '(eduction-query distinct [1 1]) (core/-form expr))))))) + (has-form expr '(eduction-query distinct [1 1])))))) (testing "Retrieve queries" (with-system-data [{:blaze.db/keys [node]} mem-node-config] @@ -167,7 +167,7 @@ [1 :id] := "1")) (testing "form" - (is (= '(vector-query distinct (retrieve "Patient")) (core/-form expr)))))) + (has-form expr '(vector-query distinct (retrieve "Patient")))))) (testing "with where clause" (let [elm {:type "Query" @@ -184,14 +184,14 @@ [0 :id] := "0")) (testing "form" - (is (= '(vector-query - (comp - (where - (fn [P] - (equal (call "ToString" (:gender P)) "female"))) - distinct) - (retrieve "Patient")) - (core/-form expr)))))) + (has-form expr + '(vector-query + (comp + (where + (fn [P] + (equal (call "ToString" (:gender P)) "female"))) + distinct) + (retrieve "Patient")))))) (testing "with return clause" (let [elm {:type "Query" @@ -208,10 +208,10 @@ [1] := #fhir/code"male")) (testing "form" - (is (= '(vector-query - (distinct (return (fn [P] (:gender P)))) - (retrieve "Patient")) - (core/-form expr)))))) + (has-form expr + '(vector-query + (distinct (return (fn [P] (:gender P)))) + (retrieve "Patient")))))) (testing "with where and return clauses" (let [elm {:type "Query" @@ -228,14 +228,14 @@ [0] := #fhir/code"female")) (testing "form" - (is (= '(vector-query - (comp - (where - (fn [P] - (equal (call "ToString" (:gender P)) "female"))) - (distinct (return (fn [P] (:gender P))))) - (retrieve "Patient")) - (core/-form expr))))))))) + (has-form expr + '(vector-query + (comp + (where + (fn [P] + (equal (call "ToString" (:gender P)) "female"))) + (distinct (return (fn [P] (:gender P))))) + (retrieve "Patient"))))))))) (testing "Unsupported With clause" (let [elm {:type "Query" @@ -286,7 +286,7 @@ (is (= ::result (core/-eval expr {} nil {"foo" ::result})))) (testing "form" - (is (= '(alias-ref foo) (core/-form expr)))))) + (has-form expr '(alias-ref foo))))) ;; 10.7. IdentifierRef @@ -300,7 +300,7 @@ (let [expr (c/compile {} {:type "IdentifierRef" :name "foo"})] (testing "form" - (is (= '(:foo default) (core/-form expr)))))) + (has-form expr '(:foo default))))) ;; TODO 10.9. QueryLetRef diff --git a/modules/cql/test/blaze/elm/compiler/reusing_logic_test.clj b/modules/cql/test/blaze/elm/compiler/reusing_logic_test.clj index 9c4dfe195..d95984342 100644 --- a/modules/cql/test/blaze/elm/compiler/reusing_logic_test.clj +++ b/modules/cql/test/blaze/elm/compiler/reusing_logic_test.clj @@ -5,10 +5,12 @@ https://cql.hl7.org/04-logicalspecification.html." (:require [blaze.anomaly :as ba] + [blaze.elm.code :as code] [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.function :as function] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.interval :as interval] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] @@ -59,11 +61,14 @@ expr (c/compile {:library library} #elm/expression-ref "name-170312")] (is (= ::result (core/-eval expr {:expression-defs {"name-170312" {:expression ::result}}} nil nil))))) - (testing "form" + (testing "form and static" (let [library {:statements {:def [{:type "ExpressionDef" :name "name-170312"}]}} expr (c/compile {:library library} #elm/expression-ref "name-170312")] - (is (= '(expr-ref "name-170312") (core/-form expr)))))) + + (has-form expr '(expr-ref "name-170312")) + + (is (false? (core/-static expr)))))) ;; 9.4. FunctionRef @@ -83,11 +88,15 @@ compile-ctx {:function-defs {function-name {:function (partial function/arity-n function-name fn-expr [])}}} elm (elm/function-ref [function-name]) expr (c/compile compile-ctx elm)] + (testing "eval" (is (= 1 (core/-eval expr {} nil nil)))) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= `(~'call ~function-name) (core/-form expr)))))) + (has-form expr (list 'call function-name))))) (testing "Custom function with arity 1" (let [function-name "name-180815" @@ -96,14 +105,18 @@ :function-defs {function-name {:function (partial function/arity-n function-name fn-expr ["x"])}}} elm (elm/function-ref [function-name #elm/parameter-ref "a"]) expr (c/compile compile-ctx elm)] + (testing "eval" (are [a res] (= res (core/-eval expr {:parameters {"a" a}} nil nil)) 1 -1 -1 1 0 0)) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= `(~'call ~function-name (~'param-ref "a")) (core/-form expr)))))) + (has-form expr (list 'call function-name '(param-ref "a")))))) (testing "Custom function with arity 2" (let [function-name "name-184652" @@ -112,33 +125,42 @@ :function-defs {function-name {:function (partial function/arity-n function-name fn-expr ["x" "y"])}}} elm (elm/function-ref [function-name #elm/parameter-ref "a" #elm/parameter-ref "b"]) expr (c/compile compile-ctx elm)] + (testing "eval" (are [a b res] (= res (core/-eval expr {:parameters {"a" a "b" b}} nil nil)) 1 1 2 1 0 1 0 1 1)) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= `(~'call ~function-name (~'param-ref "a") (~'param-ref "b")) (core/-form expr)))))) + (has-form expr (list 'call function-name '(param-ref "a") '(param-ref "b")))))) (testing "ToQuantity" (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} elm #elm/function-ref ["ToQuantity" #elm/parameter-ref "x"] expr (c/compile compile-ctx elm)] + (testing "eval" (are [x res] (= res (core/-eval expr {:parameters {"x" x}} nil nil)) {:value 23M :code "kg"} (quantity/quantity 23M "kg") {:value 42M} (quantity/quantity 42M "1") {} nil)) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(call "ToQuantity" (param-ref "x")) (core/-form expr)))))) + (has-form expr '(call "ToQuantity" (param-ref "x")))))) (testing "ToDate" (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} elm #elm/function-ref ["ToDate" #elm/parameter-ref "x"] expr (c/compile compile-ctx elm) - eval-ctx (fn [x] {:now tu/now :parameters {"x" x}})] + eval-ctx (fn [x] {:now tu/now :parameters {"x" x}}) + ] (testing "eval" (are [x res] (= res (core/-eval expr (eval-ctx x) nil nil)) #fhir/date{:id "foo"} nil @@ -147,14 +169,18 @@ #fhir/date"2023-05" #system/date"2023-05" #fhir/date"2023-05-07" #system/date"2023-05-07")) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(call "ToDate" (param-ref "x")) (core/-form expr)))))) + (has-form expr '(call "ToDate" (param-ref "x")))))) (testing "ToDateTime" (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} elm #elm/function-ref ["ToDateTime" #elm/parameter-ref "x"] expr (c/compile compile-ctx elm) eval-ctx (fn [x] {:now tu/now :parameters {"x" x}})] + (testing "eval" (are [x res] (= res (core/-eval expr (eval-ctx x) nil nil)) #fhir/dateTime{:id "foo"} nil @@ -169,13 +195,17 @@ #fhir/instant"2021-02-23T15:12:45Z" #system/date-time"2021-02-23T15:12:45" #fhir/instant"2021-02-23T15:12:45+01:00" #system/date-time"2021-02-23T14:12:45")) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(call "ToDateTime" (param-ref "x")) (core/-form expr)))))) + (has-form expr '(call "ToDateTime" (param-ref "x")))))) (testing "ToString" (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} elm #elm/function-ref ["ToString" #elm/parameter-ref "x"] expr (c/compile compile-ctx elm)] + (testing "eval" (are [x res] (= res (core/-eval expr {:parameters {"x" x}} nil nil)) "string-195733" "string-195733" @@ -183,14 +213,36 @@ #fhir/code{:id "foo" :value "code-211914"} "code-211914" #fhir/code{:id "foo"} nil)) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(call "ToString" (param-ref "x")) (core/-form expr)))))) + (has-form expr '(call "ToString" (param-ref "x")))))) + + (testing "ToCode" + (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} + elm #elm/function-ref ["ToCode" #elm/parameter-ref "x"] + expr (c/compile compile-ctx elm)] + + (testing "eval" + (are [x res] (= res (core/-eval expr {:parameters {"x" x}} nil nil)) + {:system "system-140820" + :version "version-140924" + :code "code-140828"} + (code/to-code "system-140820" "version-140924" "code-140828"))) + + (testing "static" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(call "ToCode" (param-ref "x")))))) (testing "ToInterval" (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} elm #elm/function-ref ["ToInterval" #elm/parameter-ref "x"] expr (c/compile compile-ctx elm) eval-ctx (fn [x] {:now tu/now :parameters {"x" x}})] + (testing "eval" (are [x res] (= res (core/-eval expr (eval-ctx x) nil nil)) #fhir/Period @@ -212,8 +264,11 @@ (system/date-time 2021 2 23 14 12 45) nil))) + (testing "static" + (is (false? (core/-static expr)))) + (testing "form" - (is (= '(call "ToInterval" (param-ref "x")) (core/-form expr))))))) + (has-form expr '(call "ToInterval" (param-ref "x"))))))) ;; 9.5 OperandRef @@ -221,5 +276,7 @@ ;; The OperandRef expression allows the value of an operand to be referenced as ;; part of an expression within the body of a function definition. (deftest compile-operand-ref-test - (testing "form" - (is (= '(operand-ref "x") (core/-form (c/compile {} #elm/operand-ref"x")))))) + (testing "form and static" + (let [expr (c/compile {} #elm/operand-ref"x")] + (has-form expr '(operand-ref "x")) + (is (false? (core/-static expr)))))) diff --git a/modules/cql/test/blaze/elm/compiler/simple_values_test.clj b/modules/cql/test/blaze/elm/compiler/simple_values_test.clj index 59c3feac8..440f4bdca 100644 --- a/modules/cql/test/blaze/elm/compiler/simple_values_test.clj +++ b/modules/cql/test/blaze/elm/compiler/simple_values_test.clj @@ -36,12 +36,12 @@ ;; the boolean value true or the string "antithrombotic". (deftest compile-literal-test (testing "Boolean Literal" - (are [elm res] (= res (c/compile {} elm)) + (are [elm res] (let [expr (c/compile {} elm)] (= res expr (c/form expr))) #elm/boolean "true" true #elm/boolean "false" false)) (testing "Decimal Literal" - (are [elm res] (= res (c/compile {} elm)) + (are [elm res] (let [expr (c/compile {} elm)] (= res expr (c/form expr))) #elm/decimal "-1" -1M #elm/decimal "0" 0M #elm/decimal "1" 1M @@ -62,7 +62,7 @@ ::anom/message := "Incorrect decimal literal `x`."))) (testing "Long Literal" - (are [elm res] (= res (c/compile {} elm)) + (are [elm res] (let [expr (c/compile {} elm)] (= res expr (c/form expr))) #elm/long "-1" -1 #elm/long "0" 0 #elm/long "1" 1) @@ -73,7 +73,7 @@ ::anom/message := "Incorrect long literal `x`."))) (testing "Integer Literal" - (are [elm res] (= res (c/compile {} elm)) + (are [elm res] (let [expr (c/compile {} elm)] (= res expr (c/form expr))) #elm/integer "-1" -1 #elm/integer "0" 0 #elm/integer "1" 1) diff --git a/modules/cql/test/blaze/elm/compiler/string_operators_test.clj b/modules/cql/test/blaze/elm/compiler/string_operators_test.clj index 5bc9923d8..f8c8df716 100644 --- a/modules/cql/test/blaze/elm/compiler/string_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/string_operators_test.clj @@ -8,11 +8,12 @@ [blaze.db.api-stub :refer [mem-node-config with-system-data]] [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.core-spec] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] [clojure.spec.test.alpha :as st] - [clojure.test :as test :refer [are deftest testing]])) + [clojure.test :as test :refer [are deftest is testing]])) (st/instrument) @@ -47,7 +48,15 @@ #elm/list [] nil #elm/list [#elm/string "a" {:type "Null"}] nil #elm/list [{:type "Null"}] nil - {:type "Null"} nil)) + {:type "Null"} nil) + + (testing "form and static" + (let [expr (tu/dynamic-compile {:type "Combine" + :source #elm/parameter-ref "x"})] + + (has-form expr '(combine (param-ref "x"))) + + (is (false? (core/-static expr)))))) (testing "With separator" (are [src res] (= res (core/-eval (c/compile {} {:type "Combine" :source src :separator #elm/string " "}) {} nil nil)) @@ -57,7 +66,16 @@ #elm/list [] nil #elm/list [#elm/string "a" {:type "Null"}] nil #elm/list [{:type "Null"}] nil - {:type "Null"} nil))) + {:type "Null"} nil) + + (testing "form and static" + (let [expr (tu/dynamic-compile {:type "Combine" + :source #elm/parameter-ref "x" + :separator #elm/parameter-ref "y"})] + + (has-form expr '(combine (param-ref "x") (param-ref "y"))) + + (is (false? (core/-static expr))))))) ;; 17.2. Concatenate @@ -74,10 +92,16 @@ [{:type "Null"}] nil) (testing "form" - (are [args form] (= form (core/-form (c/compile {} {:type "Concatenate" :operand args}))) + (are [args form] (= form (c/form (c/compile {} {:type "Concatenate" :operand args}))) [#elm/string "a"] '(concatenate "a") [#elm/string "a" #elm/string "b"] '(concatenate "a" "b") - [#elm/string "a" {:type "Null"}] '(concatenate "a" nil)))) + [#elm/string "a" {:type "Null"}] '(concatenate "a" nil))) + + (testing "static" + (are [args] (false? (core/-static (c/compile {} {:type "Concatenate" :operand args}))) + [#elm/string "a"] + [#elm/string "a" #elm/string "b"] + [#elm/string "a" {:type "Null"}]))) ;; 17.3. EndsWith @@ -97,7 +121,7 @@ #elm/string "a" #elm/string "b" false #elm/string "ba" #elm/string "b" false)) - (testing "dynamic" + (testing "Dynamic" (are [s suffix res] (= res (tu/dynamic-compile-eval (elm/ends-with [s suffix]))) #elm/parameter-ref "a" #elm/string "a" true #elm/parameter-ref "ab" #elm/string "b" true @@ -107,6 +131,8 @@ (tu/testing-binary-null elm/ends-with #elm/string "a") + (tu/testing-binary-dynamic elm/ends-with) + (tu/testing-binary-form elm/ends-with)) @@ -151,6 +177,8 @@ (tu/testing-binary-null elm/indexer #elm/list [] #elm/integer "0")) + (tu/testing-binary-dynamic elm/indexer) + (tu/testing-binary-form elm/indexer)) @@ -163,15 +191,17 @@ ;; ;; If either argument is null, the result is null. (deftest compile-last-position-of-test - (are [pattern s res] (= res (core/-eval (c/compile {} {:type "LastPositionOf" :pattern pattern :string s}) {} nil nil)) + (are [pattern s res] (= res (core/-eval (c/compile {} (elm/last-position-of [pattern s])) {} nil nil)) #elm/string "a" #elm/string "a" 0 #elm/string "a" #elm/string "aa" 1 - #elm/string "a" #elm/string "b" -1 + #elm/string "a" #elm/string "b" -1) + + (tu/testing-binary-dynamic-null elm/last-position-of #elm/string "a" #elm/string "a") - {:type "Null"} #elm/string "a" nil - #elm/string "a" {:type "Null"} nil - {:type "Null"} {:type "Null"} nil)) + (tu/testing-binary-dynamic elm/last-position-of) + + (tu/testing-binary-form elm/last-position-of)) ;; 17.8. Length @@ -195,7 +225,7 @@ {:type "Null"} 0)) - (testing "dynamic" + (testing "Dynamic" (are [x res] (identical? res (tu/dynamic-compile-eval (elm/length x))) #elm/parameter-ref "empty-string" 0 #elm/parameter-ref "a" 1 @@ -221,6 +251,8 @@ (identical? count (core/-eval expr {:db db} patient nil)))) 0 1 2)) + (tu/testing-unary-dynamic elm/length) + (tu/testing-unary-form elm/length)) @@ -241,13 +273,15 @@ #elm/string "" "" #elm/string "A" "a")) - (testing "dynamic" + (testing "Dynamic" (are [s res] (= res (tu/dynamic-compile-eval (elm/lower s))) #elm/parameter-ref "empty-string" "" #elm/parameter-ref "A" "a")) (tu/testing-unary-null elm/lower) + (tu/testing-unary-dynamic elm/lower) + (tu/testing-unary-form elm/lower)) @@ -272,6 +306,8 @@ (tu/testing-binary-null elm/matches #elm/string "a") + (tu/testing-binary-dynamic elm/matches) + (tu/testing-binary-form elm/matches)) @@ -289,15 +325,17 @@ ;; ;; If either argument is null, the result is null. (deftest compile-position-of-test - (are [pattern s res] (= res (core/-eval (c/compile {} {:type "PositionOf" :pattern pattern :string s}) {} nil nil)) + (are [pattern s res] (= res (core/-eval (c/compile {} (elm/position-of [pattern s])) {} nil nil)) #elm/string "a" #elm/string "a" 0 #elm/string "a" #elm/string "aa" 0 - #elm/string "a" #elm/string "b" -1 + #elm/string "a" #elm/string "b" -1) + + (tu/testing-binary-dynamic-null elm/position-of #elm/string "a" #elm/string "a") + + (tu/testing-binary-dynamic elm/position-of) - {:type "Null"} #elm/string "a" nil - #elm/string "a" {:type "Null"} nil - {:type "Null"} {:type "Null"} nil)) + (tu/testing-binary-form elm/position-of)) ;; 17.13. ReplaceMatches @@ -316,12 +354,14 @@ ;; such, CQL does not prescribe a particular dialect, but recommends the use of ;; the PCRE dialect. (deftest compile-replace-matches-test - (are [s pattern substitution res] (= res (core/-eval (c/compile {} {:type "ReplaceMatches" :operand [s pattern substitution]}) {} nil nil)) - #elm/string "a" #elm/string "a" #elm/string "b" "b" + (are [s pattern substitution res] (= res (core/-eval (c/compile {} (elm/replace-matches [s pattern substitution])) {} nil nil)) + #elm/string "a" #elm/string "a" #elm/string "b" "b") - {:type "Null"} #elm/string "a" {:type "Null"} nil - #elm/string "a" {:type "Null"} {:type "Null"} nil - {:type "Null"} {:type "Null"} {:type "Null"} nil)) + (tu/testing-ternary-dynamic-null elm/replace-matches #elm/string "a" #elm/string "a" #elm/string "a") + + (tu/testing-ternary-dynamic elm/replace-matches) + + (tu/testing-ternary-form elm/replace-matches)) ;; 17.14. Split @@ -339,7 +379,15 @@ #elm/string "" [""] #elm/string "a" ["a"] - {:type "Null"} nil)) + {:type "Null"} nil) + + (testing "form and static" + (let [expr (tu/dynamic-compile {:type "Split" + :stringToSplit #elm/parameter-ref "x"})] + + (has-form expr '(split (param-ref "x"))) + + (is (false? (core/-static expr)))))) (testing "With separator" (are [s separator res] (= res (core/-eval (c/compile {} {:type "Split" :stringToSplit s :separator separator}) {} nil nil)) @@ -349,7 +397,16 @@ {:type "Null"} #elm/string "," nil #elm/string "a" {:type "Null"} ["a"] - {:type "Null"} {:type "Null"} nil))) + {:type "Null"} {:type "Null"} nil) + + (testing "form and static" + (let [expr (tu/dynamic-compile {:type "Split" + :stringToSplit #elm/parameter-ref "x" + :separator #elm/parameter-ref "y"})] + + (has-form expr '(split (param-ref "x") (param-ref "y"))) + + (is (false? (core/-static expr))))))) ;; 17.15. SplitOnMatches @@ -384,7 +441,7 @@ #elm/string "a" #elm/string "b" false #elm/string "ab" #elm/string "b" false)) - (testing "dynamic" + (testing "Dynamic" (are [s prefix res] (= res (tu/dynamic-compile-eval (elm/starts-with [s prefix]))) #elm/parameter-ref "a" #elm/string "a" true #elm/parameter-ref "ba" #elm/string "b" true @@ -394,6 +451,8 @@ (tu/testing-binary-null elm/starts-with #elm/string "a") + (tu/testing-binary-dynamic elm/starts-with) + (tu/testing-binary-form elm/starts-with)) @@ -418,7 +477,16 @@ #elm/string "a" #elm/integer "1" nil {:type "Null"} #elm/integer "0" nil #elm/string "a" {:type "Null"} nil - {:type "Null"} {:type "Null"} nil)) + {:type "Null"} {:type "Null"} nil) + + (testing "form and static" + (let [expr (tu/dynamic-compile {:type "Substring" + :stringToSub #elm/parameter-ref "x" + :startIndex #elm/parameter-ref "y"})] + + (has-form expr '(substring (param-ref "x") (param-ref "y"))) + + (is (false? (core/-static expr)))))) (testing "With length" (are [s start-index length res] (= res (core/-eval (c/compile {} {:type "Substring" :stringToSub s :startIndex start-index :length length}) {} nil nil)) @@ -430,7 +498,17 @@ #elm/string "a" #elm/integer "2" #elm/integer "0" nil {:type "Null"} #elm/integer "0" #elm/integer "0" nil #elm/string "a" {:type "Null"} #elm/integer "0" nil - {:type "Null"} {:type "Null"} #elm/integer "0" nil))) + {:type "Null"} {:type "Null"} #elm/integer "0" nil) + + (testing "form and static" + (let [expr (tu/dynamic-compile {:type "Substring" + :stringToSub #elm/parameter-ref "x" + :startIndex #elm/parameter-ref "y" + :length #elm/parameter-ref "z"})] + + (has-form expr '(substring (param-ref "x") (param-ref "y") (param-ref "z"))) + + (is (false? (core/-static expr))))))) ;; 17.18. Upper @@ -450,11 +528,13 @@ #elm/string "" "" #elm/string "a" "A")) - (testing "dynamic" + (testing "Dynamic" (are [s res] (= res (tu/dynamic-compile-eval (elm/upper s))) #elm/parameter-ref "empty-string" "" #elm/parameter-ref "a" "A")) (tu/testing-unary-null elm/upper) + (tu/testing-unary-dynamic elm/upper) + (tu/testing-unary-form elm/upper)) diff --git a/modules/cql/test/blaze/elm/compiler/structured_values_test.clj b/modules/cql/test/blaze/elm/compiler/structured_values_test.clj index f7fd7f3ee..558e2e056 100644 --- a/modules/cql/test/blaze/elm/compiler/structured_values_test.clj +++ b/modules/cql/test/blaze/elm/compiler/structured_values_test.clj @@ -8,7 +8,8 @@ [blaze.elm.code-spec] [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] - [blaze.elm.compiler.test-util :as tu] + [blaze.elm.compiler.core-spec] + [blaze.elm.compiler.test-util :as tu :refer [has-form]] [blaze.elm.literal] [blaze.elm.literal-spec] [blaze.fhir.spec.type] @@ -41,12 +42,28 @@ ;; elements of the tuple. Note that the value of an element may be any ;; expression, including another Tuple. (deftest compile-tuple-test - (are [elm res] (= res (core/-eval (c/compile {} elm) {} nil nil)) - #elm/tuple{"id" #elm/integer "1"} - {:id 1} + (testing "Static" + (are [elm res] (= res (core/-eval (c/compile {} elm) {} nil nil)) + #elm/tuple{"id" #elm/integer "1"} + {:id 1} - #elm/tuple{"id" #elm/integer "1" "name" #elm/string "john"} - {:id 1 :name "john"})) + #elm/tuple{"id" #elm/integer "1" "name" #elm/string "john"} + {:id 1 :name "john"})) + + (testing "Dynamic" + (are [elm res] (= res (tu/dynamic-compile-eval elm)) + #elm/tuple{"id" #elm/parameter-ref "1"} + {:id 1} + + #elm/tuple{"id" #elm/parameter-ref "1" "name" #elm/parameter-ref "a"} + {:id 1 :name "a"}) + + (testing "static" + (is (false? (core/-static (tu/dynamic-compile #elm/tuple{"id" #elm/parameter-ref "1"}))))) + + (testing "form" + (is (= '{:id (param-ref "x")} + (core/-form (tu/dynamic-compile #elm/tuple{"id" #elm/parameter-ref "x"}))))))) ;; 2.2. Instance @@ -97,20 +114,24 @@ :type "Property"} identifier #fhir/Identifier - {:system #fhir/uri"foo" - :value "bar"} + {:system #fhir/uri"foo" + :value "bar"} entity {:fhir/type :fhir/Patient :id "0" :identifier [identifier]} expr (c/compile {:eval-context "Patient"} - elm) - result (coll/first (core/-eval expr nil nil {"R" entity}))] - (is (= identifier result)) + elm)] + + (testing "eval" + (is (= identifier (coll/first (core/-eval expr nil nil {"R" entity}))))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) (testing "form" - (is (= '(:identifier R) (core/-form expr)))))) + (has-form expr '(:identifier R))))) (testing "without source-type" (let [elm @@ -119,17 +140,24 @@ :type "Property"} identifier #fhir/Identifier - {:system #fhir/uri"foo" - :value "bar"} + {:system #fhir/uri"foo" + :value "bar"} entity {:fhir/type :fhir/Patient :id "0" :identifier [identifier]} expr (c/compile {:eval-context "Patient"} - elm) - result (coll/first (core/-eval expr nil nil {"R" entity}))] - (is (= identifier result))))) + elm)] + + (testing "eval" + (is (= identifier (coll/first (core/-eval expr nil nil {"R" entity}))))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:identifier R)))))) (testing "Patient.extension" (testing "without source-type" @@ -139,17 +167,24 @@ :type "Property"} extension #fhir/Extension - {:url "foo" - :valueString "bar"} + {:url "foo" + :valueString "bar"} entity {:fhir/type :fhir/Patient :id "0" :extension [extension]} expr (c/compile {:eval-context "Patient"} - elm) - result (coll/first (core/-eval expr nil nil {"R" entity}))] - (is (= extension result))))) + elm)] + + (testing "eval" + (is (= extension (coll/first (core/-eval expr nil nil {"R" entity}))))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:extension R)))))) (testing "Patient.gender" (testing "with source-type" @@ -164,7 +199,15 @@ (c/compile {:eval-context "Patient"} elm)] - (is (= #fhir/code"male" (core/-eval expr nil nil {"R" entity}))))) + + (testing "eval" + (is (= #fhir/code"male" (core/-eval expr nil nil {"R" entity})))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:gender R))))) (testing "without source-type" (let [elm @@ -178,7 +221,15 @@ (c/compile {:eval-context "Patient"} elm)] - (is (= #fhir/code"male" (core/-eval expr nil nil {"R" entity})))))) + + (testing "eval" + (is (= #fhir/code"male" (core/-eval expr nil nil {"R" entity})))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:gender R)))))) (testing "Patient.birthDate.value" (let [elm @@ -193,11 +244,19 @@ (c/compile {:eval-context "Patient"} elm)] - (are [birth-date res] (= res (core/-eval expr nil nil {"R" (entity birth-date)})) - #fhir/date"2023-05-07" #system/date"2023-05-07" - #fhir/date{:id "foo" :value "2023-05-07"} #system/date"2023-05-07" - #fhir/date{:id "foo"} nil - #fhir/date{:extension [#fhir/Extension{:url "foo"}]} nil))) + + (testing "eval" + (are [birth-date res] (= res (core/-eval expr nil nil {"R" (entity birth-date)})) + #fhir/date"2023-05-07" #system/date"2023-05-07" + #fhir/date{:id "foo" :value "2023-05-07"} #system/date"2023-05-07" + #fhir/date{:id "foo"} nil + #fhir/date{:extension [#fhir/Extension{:url "foo"}]} nil)) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:value (:birthDate R)))))) (testing "Observation.value" (testing "with source-type" @@ -212,7 +271,15 @@ (c/compile {:eval-context "Patient"} elm)] - (is (= "value-114318" (core/-eval expr nil nil {"R" entity}))))) + + (testing "eval" + (is (= "value-114318" (core/-eval expr nil nil {"R" entity})))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:value R))))) (testing "without source-type" (let [elm @@ -226,7 +293,15 @@ (c/compile {:eval-context "Patient"} elm)] - (is (= "value-114318" (core/-eval expr nil nil {"R" entity})))))))) + + (testing "eval" + (is (= "value-114318" (core/-eval expr nil nil {"R" entity})))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:value R)))))))) (testing "with source" (testing "Patient.identifier" @@ -239,17 +314,21 @@ :type "Property"} identifier #fhir/Identifier - {:system #fhir/uri"foo" - :value "bar"} + {:system #fhir/uri"foo" + :value "bar"} source {:fhir/type :fhir/Patient :id "0" :identifier [identifier]} - expr (c/compile {:library library :eval-context "Patient"} elm) - result (coll/first (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil))] - (is (= identifier result)) + expr (c/compile {:library library :eval-context "Patient"} elm)] + + (testing "eval" + (is (= identifier (coll/first (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil))))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) (testing "form" - (is (= '(:identifier (expr-ref "Patient")) (core/-form expr)))))) + (has-form expr '(:identifier (expr-ref "Patient")))))) (testing "without source-type" (let [library {:statements {:def [{:type "ExpressionDef" @@ -260,14 +339,21 @@ :type "Property"} identifier #fhir/Identifier - {:system #fhir/uri"foo" - :value "bar"} + {:system #fhir/uri"foo" + :value "bar"} source {:fhir/type :fhir/Patient :id "0" :identifier [identifier]} - expr (c/compile {:library library :eval-context "Patient"} elm) - result (coll/first (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil))] - (is (= identifier result))))) + expr (c/compile {:library library :eval-context "Patient"} elm)] + + (testing "eval" + (is (= identifier (coll/first (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil))))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:identifier (expr-ref "Patient"))))))) (testing "Patient.gender" (testing "with source-type" @@ -280,9 +366,16 @@ source {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"male"} - expr (c/compile {:library library :eval-context "Patient"} elm) - result (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil)] - (is (= #fhir/code"male" result)))) + expr (c/compile {:library library :eval-context "Patient"} elm)] + + (testing "eval" + (is (= #fhir/code"male" (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil)))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:gender (expr-ref "Patient")))))) (testing "without source-type" (let [library {:statements {:def [{:type "ExpressionDef" @@ -294,9 +387,16 @@ source {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"male"} - expr (c/compile {:library library :eval-context "Patient"} elm) - result (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil)] - (is (= #fhir/code"male" result))))) + expr (c/compile {:library library :eval-context "Patient"} elm)] + + (testing "eval" + (is (= #fhir/code"male" (core/-eval expr {:expression-defs {"Patient" {:expression source}}} nil nil)))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:gender (expr-ref "Patient"))))))) (testing "Patient.birthDate.value" (let [library {:statements {:def [{:type "ExpressionDef" @@ -310,11 +410,19 @@ {:fhir/type :fhir/Patient :id "0" :birthDate x}) expr (c/compile {:library library :eval-context "Patient"} elm)] - (are [birth-date res] (= res (core/-eval expr {:expression-defs {"Patient" {:expression (source birth-date)}}} nil nil)) - #fhir/date"2023-05-07" #system/date"2023-05-07" - #fhir/date{:id "foo" :value "2023-05-07"} #system/date"2023-05-07" - #fhir/date{:id "foo"} nil - #fhir/date{:extension [#fhir/Extension{:url "foo"}]} nil))) + + (testing "eval" + (are [birth-date res] (= res (core/-eval expr {:expression-defs {"Patient" {:expression (source birth-date)}}} nil nil)) + #fhir/date"2023-05-07" #system/date"2023-05-07" + #fhir/date{:id "foo" :value "2023-05-07"} #system/date"2023-05-07" + #fhir/date{:id "foo"} nil + #fhir/date{:extension [#fhir/Extension{:url "foo"}]} nil)) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:value (:birthDate (expr-ref "Patient"))))))) (testing "Observation.value" (testing "with source-type" @@ -327,9 +435,16 @@ source {:fhir/type :fhir/Observation :id "0" :value "value-114318"} - expr (c/compile {:library library :eval-context "Patient"} elm) - result (core/-eval expr {:expression-defs {"Observation" {:expression source}}} nil nil)] - (is (= "value-114318" result)))) + expr (c/compile {:library library :eval-context "Patient"} elm)] + + (testing "eval" + (is (= "value-114318" (core/-eval expr {:expression-defs {"Observation" {:expression source}}} nil nil)))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:value (expr-ref "Observation")))))) (testing "without source-type" (let [library {:statements {:def [{:type "ExpressionDef" @@ -341,9 +456,16 @@ source {:fhir/type :fhir/Observation :id "0" :value "value-114318"} - expr (c/compile {:library library :eval-context "Patient"} elm) - result (core/-eval expr {:expression-defs {"Observation" {:expression source}}} nil nil)] - (is (= "value-114318" result))))) + expr (c/compile {:library library :eval-context "Patient"} elm)] + + (testing "eval" + (is (= "value-114318" (core/-eval expr {:expression-defs {"Observation" {:expression source}}} nil nil)))) + + (testing "expression is dynamic" + (is (false? (core/-static expr)))) + + (testing "form" + (has-form expr '(:value (expr-ref "Observation"))))))) (testing "Tuple" (are [elm result] diff --git a/modules/cql/test/blaze/elm/compiler/test_util.clj b/modules/cql/test/blaze/elm/compiler/test_util.clj index df9e4121b..ee7e25411 100644 --- a/modules/cql/test/blaze/elm/compiler/test_util.clj +++ b/modules/cql/test/blaze/elm/compiler/test_util.clj @@ -2,6 +2,8 @@ (:require [blaze.elm.compiler :as c] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] + [blaze.elm.expression :as-alias expr] [blaze.elm.literal :as elm] [blaze.elm.literal-spec] [blaze.elm.spec] @@ -10,6 +12,7 @@ [clojure.spec.test.alpha :as st] [clojure.test :refer [is testing]]) (:import + [com.github.benmanes.caffeine.cache Caffeine] [java.time OffsetDateTime ZoneOffset])) @@ -52,31 +55,43 @@ [{:name "true"} {:name "false"} {:name "nil"} + {:name "-1"} {:name "1"} {:name "2"} {:name "3"} {:name "4"} {:name "empty-string"} + {:name "x"} + {:name "y"} + {:name "z"} {:name "a"} {:name "ab"} {:name "b"} {:name "ba"} {:name "A"} {:name "12:54:00"} - {:name "2020-01-02T03:04:05.006Z"}]}}}) + {:name "2020-01-02T03:04:05.006Z"} + {:name "[1]"} + {:name "[1 2]"}]}}}) (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" + {"true" true "false" false "nil" nil "-1" -1 "1" 1 "2" 2 "3" 3 "4" 4 + "empty-string" "" "x" "x" "y" "y" "z" "z" "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)} + "2020-01-02T03:04:05.006Z" (system/date-time 2020 1 2 3 4 5 6 ZoneOffset/UTC) + "[1]" [1] "[1 2]" [1 2]} + ::expr/cache (.build (Caffeine/newBuilder)) :now now}) +(defn dynamic-compile [elm] + (c/compile dynamic-compile-ctx elm)) + + (defn dynamic-compile-eval [elm] - (core/-eval (c/compile dynamic-compile-ctx elm) dynamic-eval-ctx nil nil)) + (core/-eval (dynamic-compile elm) dynamic-eval-ctx nil nil)) (defn binary-operand [type] @@ -119,7 +134,8 @@ (is (nil? (c/compile {} (~elm-constructor [{:type "Null"} ~non-null-op-2])))))) -(defmacro testing-binary-dynamic-null [elm-constructor non-null-op-1 non-null-op-2] +(defmacro testing-binary-dynamic-null + [elm-constructor non-null-op-1 non-null-op-2] `(testing "Dynamic Null" (let [elm# (~elm-constructor [#elm/parameter-ref "nil" @@ -135,6 +151,26 @@ (is (nil? (dynamic-compile-eval elm#)))))) +(defmacro testing-ternary-dynamic-null + [elm-constructor non-null-op-1 non-null-op-2 non-null-op-3] + `(testing "Dynamic Null" + (let [elm# (~elm-constructor + [#elm/parameter-ref "nil" + ~non-null-op-2 + ~non-null-op-3])] + (is (nil? (dynamic-compile-eval elm#)))) + (let [elm# (~elm-constructor + [~non-null-op-1 + #elm/parameter-ref "nil" + ~non-null-op-3])] + (is (nil? (dynamic-compile-eval elm#)))) + (let [elm# (~elm-constructor + [~non-null-op-1 + ~non-null-op-2 + #elm/parameter-ref "nil"])] + (is (nil? (dynamic-compile-eval elm#)))))) + + (defmacro testing-binary-null ([elm-constructor non-null-op] `(testing-binary-null ~elm-constructor ~non-null-op ~non-null-op)) @@ -163,22 +199,25 @@ (c/compile {} (constructor [(op-constructor op-1) (op-constructor op-2) precision]))) +(defmacro has-form [expr form] + `(is (= ~form (core/-form ~expr)))) + + (defmacro testing-constant-form [elm-constructor] (let [form-name (symbol (name elm-constructor))] `(testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "x"}]}}} - elm# ~elm-constructor - expr# (c/compile compile-ctx# elm#)] - (is (= (quote ~form-name) (core/-form expr#))))))) + (let [expr# (dynamic-compile ~elm-constructor)] + (has-form expr# (quote ~form-name)))))) -(defmacro testing-unary-form [elm-constructor] +(defmacro testing-unary-form + "Works with unary and aggregate operators." + [elm-constructor] (let [form-name (symbol (name elm-constructor))] `(testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "x"}]}}} - elm# (~elm-constructor (elm/parameter-ref "x")) - expr# (c/compile compile-ctx# elm#)] - (is (= (quote (~form-name (~'param-ref "x"))) (core/-form expr#))))))) + (let [elm# (~elm-constructor (elm/parameter-ref "x")) + expr# (dynamic-compile elm#)] + (has-form expr# '(~form-name (~'param-ref "x"))))))) (defmacro testing-unary-precision-form @@ -187,23 +226,21 @@ ([elm-constructor & precisions] (let [form-name (symbol (name elm-constructor))] `(testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "x"}]}}}] - (doseq [precision# ~(vec precisions)] - (let [elm# (~elm-constructor [(elm/parameter-ref "x") precision#]) - expr# (c/compile compile-ctx# elm#)] - (is (= (list '~form-name '(~'param-ref "x") precision#) - (core/-form expr#)))))))))) + (doseq [precision# ~(vec precisions)] + (let [elm# (~elm-constructor [(elm/parameter-ref "x") precision#]) + expr# (dynamic-compile elm#)] + (has-form expr# + (list '~form-name '(~'param-ref "x") precision#)))))))) (defmacro testing-binary-form [elm-constructor] (let [form-name (symbol (name elm-constructor))] `(testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "x"} {:name "y"}]}}} - elm# (~elm-constructor [(elm/parameter-ref "x") + (let [elm# (~elm-constructor [(elm/parameter-ref "x") (elm/parameter-ref "y")]) - expr# (c/compile compile-ctx# elm#)] - (is (= (quote (~form-name (~'param-ref "x") (~'param-ref "y"))) - (core/-form expr#))))))) + expr# (dynamic-compile elm#)] + (has-form expr# + (quote (~form-name (~'param-ref "x") (~'param-ref "y")))))))) (defmacro testing-binary-precision-form @@ -212,10 +249,71 @@ ([elm-constructor & precisions] (let [form-name (symbol (name elm-constructor))] `(testing "form" - (let [compile-ctx# {:library {:parameters {:def [{:name "x"} {:name "y"}]}}}] - (doseq [precision# ~(vec precisions)] - (let [elm# (~elm-constructor [(elm/parameter-ref "x") - (elm/parameter-ref "y") precision#]) - expr# (c/compile compile-ctx# elm#)] - (is (= (list '~form-name '(~'param-ref "x") '(~'param-ref "y") - precision#) (core/-form expr#)))))))))) + (doseq [precision# ~(vec precisions)] + (let [elm# (~elm-constructor [(elm/parameter-ref "x") + (elm/parameter-ref "y") precision#]) + expr# (dynamic-compile elm#)] + (has-form expr# + (list '~form-name '(~'param-ref "x") '(~'param-ref "y") precision#)))))))) + + +(defmacro testing-ternary-form [elm-constructor] + (let [form-name (symbol (name elm-constructor))] + `(testing "form" + (let [elm# (~elm-constructor [(elm/parameter-ref "x") + (elm/parameter-ref "y") + (elm/parameter-ref "z")]) + expr# (dynamic-compile elm#)] + (has-form expr# + (quote (~form-name (~'param-ref "x") (~'param-ref "y") (~'param-ref "z")))))))) + + +(defn with-locator [constructor locator] + (comp #(assoc % :locator locator) constructor)) + + +(defmacro testing-constant-dynamic [elm-constructor] + `(testing "expression is dynamic" + (is (false? (core/-static (dynamic-compile ~elm-constructor)))))) + + +(defmacro testing-unary-dynamic [elm-constructor] + `(testing "expression is dynamic" + (is (false? (core/-static (dynamic-compile (~elm-constructor + #elm/parameter-ref "x"))))))) + + +(defmacro testing-unary-precision-dynamic + [elm-constructor & precisions] + `(testing "expression is dynamic" + (doseq [precision# ~(vec precisions)] + (is (false? (core/-static (dynamic-compile (~elm-constructor + [(elm/parameter-ref "x") + precision#])))))))) + + +(defmacro testing-binary-dynamic [elm-constructor] + `(testing "expression is dynamic" + (is (false? (core/-static (dynamic-compile (~elm-constructor + [#elm/parameter-ref "x" + #elm/parameter-ref "y"]))))))) + + +(defmacro testing-binary-precision-dynamic + ([elm-constructor] + `(testing-binary-precision-dynamic ~elm-constructor "year" "month")) + ([elm-constructor & precisions] + `(testing "expression is dynamic" + (doseq [precision# ~(vec precisions)] + (is (false? (core/-static (dynamic-compile (~elm-constructor + [(elm/parameter-ref "x") + (elm/parameter-ref "y") + precision#]))))))))) + + +(defmacro testing-ternary-dynamic [elm-constructor] + `(testing "expression is dynamic" + (is (false? (core/-static (dynamic-compile (~elm-constructor + [#elm/parameter-ref "x" + #elm/parameter-ref "y" + #elm/parameter-ref "z"]))))))) diff --git a/modules/cql/test/blaze/elm/compiler/type_operators_test.clj b/modules/cql/test/blaze/elm/compiler/type_operators_test.clj index 4a9402bf2..4763c58e6 100644 --- a/modules/cql/test/blaze/elm/compiler/type_operators_test.clj +++ b/modules/cql/test/blaze/elm/compiler/type_operators_test.clj @@ -8,6 +8,7 @@ [blaze.elm.compiler :as c] [blaze.elm.compiler.clinical-operators] [blaze.elm.compiler.core :as core] + [blaze.elm.compiler.core-spec] [blaze.elm.compiler.test-util :as tu] [blaze.elm.compiler.type-operators] [blaze.elm.concept :as concept] @@ -49,58 +50,58 @@ (testing "FHIR types" (are [elm resource res] (= res (core/-eval (c/compile {} elm) {} nil {"R" resource})) #elm/as ["{http://hl7.org/fhir}boolean" - {:path "deceased" - :scope "R" - :type "Property"}] + {:path "deceased" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Patient :id "0" :deceased true} true #elm/as ["{http://hl7.org/fhir}integer" - {:path "value" - :scope "R" - :type "Property"}] + {:path "value" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Observation :value (int 1)} (int 1) #elm/as ["{http://hl7.org/fhir}string" - {:path "name" - :scope "R" - :type "Property"}] + {:path "name" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Account :name "a"} "a" #elm/as ["{http://hl7.org/fhir}decimal" - {:path "duration" - :scope "R" - :type "Property"}] + {:path "duration" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Media :duration 1.1M} 1.1M #elm/as ["{http://hl7.org/fhir}uri" - {:path "url" - :scope "R" - :type "Property"}] + {:path "url" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Measure :url #fhir/uri"a"} #fhir/uri"a" #elm/as ["{http://hl7.org/fhir}url" - {:path "address" - :scope "R" - :type "Property"}] + {:path "address" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Endpoint :address #fhir/url"a"} #fhir/url"a" #elm/as ["{http://hl7.org/fhir}dateTime" - {:path "value" - :scope "R" - :type "Property"}] + {:path "value" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Observation :value #fhir/dateTime"2019-09-04"} #fhir/dateTime"2019-09-04" #elm/as ["{http://hl7.org/fhir}Quantity" - {:path "value" - :scope "R" - :type "Property"}] + {:path "value" + :scope "R" + :type "Property"}] {:fhir/type :fhir/Observation :value #fhir/dateTime"2019-09-04"} nil)) @@ -118,8 +119,13 @@ #elm/as ["{urn:hl7-org:elm-types:r1}DateTime" #elm/date-time"2019-09-04"] (system/date-time 2019 9 4))) + (testing "expression is dynamic" + (is (false? (core/-static (tu/dynamic-compile + #elm/as["{urn:hl7-org:elm-types:r1}Integer" + #elm/parameter-ref "x"]))))) + (testing "form" - (are [elm form] (= form (core/-form (c/compile {} elm))) + (are [elm form] (= form (c/form (c/compile {} elm))) #elm/as ["{urn:hl7-org:elm-types:r1}Integer" {:type "Null"}] nil @@ -127,9 +133,9 @@ '(as elm/integer 1) #elm/as ["{http://hl7.org/fhir}dateTime" - {:path "value" - :scope "R" - :type "Property"}] + {:path "value" + :scope "R" + :type "Property"}] '(as fhir/dateTime (:value R)) {:type "As" @@ -194,11 +200,9 @@ (tu/testing-binary-null elm/can-convert-quantity #elm/quantity [1 "m"] #elm/string "m") - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "q"}]}}} - elm #elm/can-convert-quantity[#elm/parameter-ref "q" #elm/string "g"] - expr (c/compile compile-ctx elm)] - (is (= '(can-convert-quantity (param-ref "q") "g") (core/-form expr)))))) + (tu/testing-binary-dynamic elm/can-convert-quantity) + + (tu/testing-binary-form elm/can-convert-quantity)) ;; 22.4. Children @@ -220,7 +224,11 @@ ;; TODO: other types - (tu/testing-unary-null elm/children)) + (tu/testing-unary-null elm/children) + + (tu/testing-unary-dynamic elm/children) + + (tu/testing-unary-form elm/children)) ;; TODO 22.5. Convert @@ -274,11 +282,9 @@ (tu/testing-binary-null elm/convert-quantity #elm/quantity [5 "mg"] #elm/string "m") - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "q"}]}}} - elm #elm/convert-quantity[#elm/parameter-ref "q" #elm/string "g"] - expr (c/compile compile-ctx elm)] - (is (= '(convert-quantity (param-ref "q") "g") (core/-form expr)))))) + (tu/testing-binary-dynamic elm/convert-quantity) + + (tu/testing-binary-form elm/convert-quantity)) ;; 22.7. ConvertsToBoolean @@ -330,7 +336,7 @@ "bar" "")) - (testing "integer" + (testing "Integer" (is (true? (tu/compile-unop elm/converts-to-boolean elm/integer "1"))) (is (true? (tu/compile-unop elm/converts-to-boolean elm/integer "0"))) @@ -339,7 +345,7 @@ "2" "-1")) - (testing "long" + (testing "Long" (is (true? (tu/compile-unop elm/converts-to-boolean elm/long "1"))) (is (true? (tu/compile-unop elm/converts-to-boolean elm/long "0"))) @@ -348,7 +354,7 @@ "2" "-1")) - (testing "decimal" + (testing "Decimal" (are [x] (true? (tu/compile-unop elm/converts-to-boolean elm/decimal x)) "1" "1.0" @@ -366,22 +372,21 @@ "1.1" "0.9")) - (testing "boolean" + (testing "Boolean" (is (true? (tu/compile-unop elm/converts-to-boolean elm/boolean "true"))) (is (true? (tu/compile-unop elm/converts-to-boolean elm/boolean "false")))) - (testing "dynamic" + (testing "Dynamic" (are [x res] (= res (tu/dynamic-compile-eval (elm/converts-to-boolean x))) #elm/parameter-ref "A" false)) (tu/testing-unary-null elm/converts-to-boolean) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-boolean #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-boolean (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-boolean) + + (tu/testing-unary-form elm/converts-to-boolean)) + ;; 22.8. ConvertsToDate ;; @@ -435,6 +440,8 @@ (tu/testing-unary-null elm/converts-to-date) + (tu/testing-unary-dynamic elm/converts-to-date) + (tu/testing-unary-form elm/converts-to-date)) @@ -483,10 +490,12 @@ "2020" "2020-03" "2020-03-08" - "2020-03-08T12:13" ))) + "2020-03-08T12:13"))) (tu/testing-unary-null elm/converts-to-date-time) + (tu/testing-unary-dynamic elm/converts-to-date-time) + (tu/testing-unary-form elm/converts-to-date-time)) @@ -538,7 +547,7 @@ (are [x] (true? (tu/compile-unop elm/converts-to-decimal elm/decimal x)) "1.1")) - (testing "dynamic" + (testing "Dynamic" (are [x] (false? (tu/dynamic-compile-eval (elm/converts-to-decimal x))) #elm/parameter-ref "A") (are [x] (true? (tu/dynamic-compile-eval (elm/converts-to-decimal x))) @@ -546,11 +555,9 @@ (tu/testing-unary-null elm/converts-to-decimal) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-decimal #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-decimal (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-decimal) + + (tu/testing-unary-form elm/converts-to-decimal)) ;; 22.11. ConvertsToLong @@ -598,7 +605,7 @@ (are [x] (true? (tu/compile-unop elm/converts-to-long elm/long x)) "1")) - (testing "dynamic" + (testing "Dynamic" (are [x] (false? (tu/dynamic-compile-eval (elm/converts-to-long x))) #elm/parameter-ref "A") (are [x] (true? (tu/dynamic-compile-eval (elm/converts-to-long x))) @@ -606,11 +613,9 @@ (tu/testing-unary-null elm/converts-to-long) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-long #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-long (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-long) + + (tu/testing-unary-form elm/converts-to-long)) ;; 22.12. ConvertsToInteger @@ -657,7 +662,7 @@ (are [x] (true? (tu/compile-unop elm/converts-to-integer elm/integer x)) "1")) - (testing "dynamic" + (testing "Dynamic" (are [x] (false? (tu/dynamic-compile-eval (elm/converts-to-integer x))) #elm/parameter-ref "A") (are [x] (true? (tu/dynamic-compile-eval (elm/converts-to-integer x))) @@ -665,11 +670,9 @@ (tu/testing-unary-null elm/converts-to-integer) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-integer #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-integer (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-integer) + + (tu/testing-unary-form elm/converts-to-integer)) ;; 22.13. ConvertsToQuantity @@ -732,7 +735,7 @@ [[1 "m"] [1 "s"]] [[10 "s"] [1 "s"]])) - (testing "dynamic" + (testing "Dynamic" (are [x] (false? (tu/dynamic-compile-eval (elm/converts-to-quantity x))) #elm/parameter-ref "A") (are [x] (true? (tu/dynamic-compile-eval (elm/converts-to-quantity x))) @@ -740,11 +743,9 @@ (tu/testing-unary-null elm/converts-to-quantity) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-quantity #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-quantity (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-quantity) + + (tu/testing-unary-form elm/converts-to-quantity)) ;; 22.14. ConvertsToRatio @@ -775,17 +776,15 @@ "a" "0'm';0'm'")) - (testing "dynamic" + (testing "Dynamic" (are [x] (false? (tu/dynamic-compile-eval (elm/converts-to-ratio x))) #elm/parameter-ref "A")) (tu/testing-unary-null elm/converts-to-ratio) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-ratio #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-ratio (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-ratio) + + (tu/testing-unary-form elm/converts-to-ratio)) ;; 22.15. ConvertsToString @@ -852,17 +851,16 @@ (are [x] (false? (c/compile {} (elm/converts-to-string (elm/tuple x)))) {"foo" #elm/integer "1"})) - (testing "dynamic" + (testing "Dynamic" (are [x] (true? (tu/dynamic-compile-eval (elm/converts-to-string x))) #elm/parameter-ref "A")) (tu/testing-unary-null elm/converts-to-string) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/converts-to-string #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(converts-to-string (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/converts-to-string) + + (tu/testing-unary-form elm/converts-to-string)) + ;; 22.16. ConvertsToTime ;; @@ -888,13 +886,17 @@ ;; ;; If the argument is null, the result is null. (deftest compile-converts-to-time-test - (let [eval #(core/-eval % {:now tu/now} nil nil)] + (let [compile (partial tu/compile-unop elm/converts-to-time) + eval #(core/-eval % {:now tu/now} nil nil)] (testing "String" - (are [x] (true? (eval (tu/compile-unop elm/converts-to-time elm/string x))) + (testing "expression is dynamic" + (is (not (core/static? (compile elm/string ""))))) + + (are [x] (true? (eval (compile elm/string x))) "12:54:30" "12:54:30.010") - (are [x] (false? (eval (tu/compile-unop elm/converts-to-time elm/string x))) + (are [x] (false? (eval (compile elm/string x))) "aaaa" "12:54" "24:54:00" @@ -902,23 +904,31 @@ "14-30-00.0")) (testing "Time" - (are [x] (true? (eval (tu/compile-unop elm/converts-to-time elm/time x))) + (testing "expression is dynamic" + (is (not (core/static? (compile elm/time "12:54"))))) + + (are [x] (true? (eval (compile elm/time x))) "12:54" "12:54:00" "12:54:30.010")) (testing "DateTime" - (are [x] (true? (eval (tu/compile-unop elm/converts-to-time elm/date-time x))) + (testing "expression is dynamic" + (is (not (core/static? (compile elm/string "2020-03-08T12:54:00"))))) + + (are [x] (true? (eval (compile elm/date-time x))) "2020-03-08T12:54:00" "2020-03-08T12:54:30.010")) - (testing "dynamic" + (testing "Dynamic" (are [x] (true? (tu/dynamic-compile-eval (elm/converts-to-time x))) #elm/parameter-ref "12:54:00" #elm/parameter-ref "2020-01-02T03:04:05.006Z"))) (tu/testing-unary-null elm/converts-to-time) + (tu/testing-unary-dynamic elm/converts-to-time) + (tu/testing-unary-form elm/converts-to-time)) @@ -934,6 +944,9 @@ ;; If the source is null, the result is null. (deftest compile-to-descendents-test (testing "Code" + (testing "expression is dynamic" + (is (not (core/static? (c/compile {} (elm/descendents (tu/code "system-134534" "code-134551"))))))) + (are [x res] (= res (core/-eval (c/compile {} (elm/descendents x)) {:now tu/now} nil nil)) (tu/code "system-134534" "code-134551") @@ -941,7 +954,11 @@ ;; TODO: other types - (tu/testing-unary-null elm/descendents)) + (tu/testing-unary-null elm/descendents) + + (tu/testing-unary-dynamic elm/descendents) + + (tu/testing-unary-form elm/descendents)) ;; 22.18. Is @@ -1087,8 +1104,13 @@ #elm/is ["{urn:hl7-org:elm-types:r1}DateTime" #elm/string "2019-09-04"] #elm/is ["{urn:hl7-org:elm-types:r1}DateTime" {:type "Null"}])) + (testing "expression is dynamic" + (is (false? (core/-static (tu/dynamic-compile + #elm/is["{urn:hl7-org:elm-types:r1}Integer" + #elm/parameter-ref "x"]))))) + (testing "form" - (are [elm form] (= form (core/-form (c/compile {} elm))) + (are [elm form] (= form (c/form (c/compile {} elm))) #elm/is ["{urn:hl7-org:elm-types:r1}Integer" {:type "Null"}] '(is elm/integer nil) @@ -1131,88 +1153,88 @@ ;; ;; If the argument is null the result is null. (deftest compile-to-boolean-test - (testing "String" - (are [x] (true? (tu/compile-unop elm/to-boolean elm/string x)) - "true" - "t" - "yes" - "y" - "1" - "True" - "T" - "TRUE" - "YES" - "Yes" - "Y") - - (are [x] (false? (tu/compile-unop elm/to-boolean elm/string x)) - "false" - "f" - "no" - "n" - "0" - "False" - "F" - "FALSE" - "NO" - "No" - "N") - - (are [x] (nil? (tu/compile-unop elm/to-boolean elm/string x)) - "foo" - "bar" - "")) - - (testing "integer" - (is (true? (tu/compile-unop elm/to-boolean elm/integer "1"))) - - (is (false? (tu/compile-unop elm/to-boolean elm/integer "0"))) - - (are [x] (nil? (tu/compile-unop elm/to-boolean elm/integer x)) - "2" - "-1")) - - (testing "long" - (is (true? (tu/compile-unop elm/to-boolean elm/long "1"))) - - (is (false? (tu/compile-unop elm/to-boolean elm/long "0"))) - - (are [x] (nil? (tu/compile-unop elm/to-boolean elm/long x)) - "2" - "-1")) - - (testing "decimal" - (are [x] (true? (tu/compile-unop elm/to-boolean elm/decimal x)) - "1" - "1.0" - "1.00" - "1.00000000") - - (are [x] (false? (tu/compile-unop elm/to-boolean elm/decimal x)) - "0" - "0.0" - "0.00" - "0.00000000") - - (are [x] (nil? (tu/compile-unop elm/to-boolean elm/decimal x)) - "0.1" - "-1.0" - "2.0" - "1.1" - "0.9")) - - (testing "boolean" - (is (true? (tu/compile-unop elm/to-boolean elm/boolean "true"))) + (testing "Static" + (testing "String" + (are [x] (true? (tu/compile-unop elm/to-boolean elm/string x)) + "true" + "t" + "yes" + "y" + "1" + "True" + "T" + "TRUE" + "YES" + "Yes" + "Y") + + (are [x] (false? (tu/compile-unop elm/to-boolean elm/string x)) + "false" + "f" + "no" + "n" + "0" + "False" + "F" + "FALSE" + "NO" + "No" + "N") + + (are [x] (nil? (tu/compile-unop elm/to-boolean elm/string x)) + "foo" + "bar" + "")) + + (testing "Integer" + (is (true? (tu/compile-unop elm/to-boolean elm/integer "1"))) + + (is (false? (tu/compile-unop elm/to-boolean elm/integer "0"))) + + (are [x] (nil? (tu/compile-unop elm/to-boolean elm/integer x)) + "2" + "-1")) + + (testing "Long" + (is (true? (tu/compile-unop elm/to-boolean elm/long "1"))) + + (is (false? (tu/compile-unop elm/to-boolean elm/long "0"))) + + (are [x] (nil? (tu/compile-unop elm/to-boolean elm/long x)) + "2" + "-1")) + + (testing "Decimal" + (are [x] (true? (tu/compile-unop elm/to-boolean elm/decimal x)) + "1" + "1.0" + "1.00" + "1.00000000") + + (are [x] (false? (tu/compile-unop elm/to-boolean elm/decimal x)) + "0" + "0.0" + "0.00" + "0.00000000") + + (are [x] (nil? (tu/compile-unop elm/to-boolean elm/decimal x)) + "0.1" + "-1.0" + "2.0" + "1.1" + "0.9")) + + (testing "Boolean" + (is (true? (tu/compile-unop elm/to-boolean elm/boolean "true"))) + + (is (false? (tu/compile-unop elm/to-boolean elm/boolean "false"))))) - (is (false? (tu/compile-unop elm/to-boolean elm/boolean "false")))) (tu/testing-unary-null elm/to-boolean) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-boolean #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-boolean (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-boolean) + + (tu/testing-unary-form elm/to-boolean)) ;; 22.20. ToChars @@ -1231,9 +1253,9 @@ (testing "Integer" (are [x] (nil? (tu/compile-unop elm/to-chars elm/integer x)) - "1" )) + "1")) - (testing "dynamic" + (testing "Dynamic" (are [x res] (= res (tu/dynamic-compile-eval (elm/to-chars x))) #elm/parameter-ref "A" '("A") #elm/parameter-ref "ab" '("a" "b") @@ -1241,11 +1263,10 @@ (tu/testing-unary-null elm/to-chars) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-chars #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-chars (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-chars) + + (tu/testing-unary-form elm/to-chars)) + ;; 22.21. ToConcept ;; @@ -1272,11 +1293,9 @@ (tu/testing-unary-null elm/to-concept) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-concept #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-concept (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-concept) + + (tu/testing-unary-form elm/to-concept)) ;; 22.22. ToDate @@ -1300,9 +1319,13 @@ ;; ;; If the argument is null, the result is null. (deftest compile-to-date-test - (let [eval #(core/-eval % {:now tu/now} nil nil)] + (let [compile (partial tu/compile-unop elm/to-date) + eval #(core/-eval % {:now tu/now} nil nil)] (testing "String" - (are [x res] (= res (eval (tu/compile-unop elm/to-date elm/string x))) + (testing "expression is dynamic" + (is (not (core/static? (compile elm/string ""))))) + + (are [x res] (= res (eval (compile elm/string x))) "2019" #system/date"2019" "2019-01" #system/date"2019-01" "2019-01-01" #system/date"2019-01-01" @@ -1312,13 +1335,20 @@ "2019-02-29" nil)) (testing "Date" - (are [x res] (= res (eval (tu/compile-unop elm/to-date elm/date x))) - "2019" #system/date"2019" - "2019-01" #system/date"2019-01" - "2019-01-01" #system/date"2019-01-01")) + (testing "Static" + (testing "expression is static" + (is (core/static? (compile elm/date "2023")))) + + (are [x res] (= res (compile elm/date x)) + "2020" #system/date"2020" + "2020-03" #system/date"2020-03" + "2020-03-08" #system/date"2020-03-08"))) (testing "DateTime" - (are [x res] (= res (eval (tu/compile-unop elm/to-date elm/date-time x))) + (testing "expression is dynamic" + (is (not (core/static? (compile elm/string "2019"))))) + + (are [x res] (= res (eval (compile elm/date-time x))) "2019" #system/date"2019" "2019-01" #system/date"2019-01" "2019-01-01" #system/date"2019-01-01" @@ -1326,7 +1356,7 @@ "2019-01-01T12:13:14" #system/date"2019-01-01" "2019-01-01T12:13:14.000-01:00" #system/date"2019-01-01") - (testing "dynamic" + (testing "Dynamic" (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} elm #elm/to-date #elm/parameter-ref "x" expr (c/compile compile-ctx elm) @@ -1340,7 +1370,11 @@ #system/date-time"2023-05-07T16:07:00" #system/date"2023-05-07" #system/date-time"2023-05-07T16:07:00+02:00" #system/date"2023-05-07"))))) - (tu/testing-unary-null elm/to-date)) + (tu/testing-unary-null elm/to-date) + + (tu/testing-unary-dynamic elm/to-date) + + (tu/testing-unary-form elm/to-date)) ;; 22.23. ToDateTime @@ -1368,9 +1402,13 @@ ;; ;; If the argument is null, the result is null. (deftest compile-to-date-time-test - (let [eval #(core/-eval % {:now tu/now} nil nil)] + (let [compile (partial tu/compile-unop elm/to-date-time) + eval #(core/-eval % {:now tu/now} nil nil)] (testing "String" - (are [x res] (= res (eval (tu/compile-unop elm/to-date-time elm/string x))) + (testing "expression is dynamic" + (is (not (core/static? (compile elm/string ""))))) + + (are [x res] (= res (eval (compile elm/string x))) "2020" #system/date-time"2020" "2020-03" #system/date-time"2020-03" "2020-03-08" #system/date-time"2020-03-08" @@ -1384,13 +1422,16 @@ (testing "Date" (testing "Static" - (are [x res] (= res (tu/compile-unop elm/to-date-time elm/date x)) + (testing "expression is static" + (is (core/static? (compile elm/date "2023")))) + + (are [x res] (= res (compile elm/date x)) "2020" #system/date-time"2020" "2020-03" #system/date-time"2020-03" "2020-03-08" #system/date-time"2020-03-08"))) (testing "DateTime" - (are [x res] (= res (eval (tu/compile-unop elm/to-date-time elm/date-time x))) + (are [x res] (= res (eval (compile elm/date-time x))) "2020" #system/date-time"2020" "2020-03" #system/date-time"2020-03" "2020-03-08" #system/date-time"2020-03-08" @@ -1398,6 +1439,8 @@ (tu/testing-unary-null elm/to-date-time) + (tu/testing-unary-dynamic elm/to-date-time) + (tu/testing-unary-form elm/to-date-time)) @@ -1447,11 +1490,9 @@ (tu/testing-unary-null elm/to-decimal) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-decimal #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-decimal (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-decimal) + + (tu/testing-unary-form elm/to-decimal)) ;; 22.25. ToInteger @@ -1493,11 +1534,9 @@ (tu/testing-unary-null elm/to-integer) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-integer #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-integer (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-integer) + + (tu/testing-unary-form elm/to-integer)) ;; 22.26. ToList @@ -1513,22 +1552,26 @@ ;; ;; The operator is used to implement list promotion efficiently. (deftest compile-to-list-test - (testing "Boolean" - (are [x res] (= res (tu/compile-unop elm/to-list elm/boolean x)) - "false" [false])) + (testing "Static" + (testing "Boolean" + (are [x res] (= res (tu/compile-unop elm/to-list elm/boolean x)) + "false" [false])) - (testing "Integer" - (are [x res] (= res (tu/compile-unop elm/to-list elm/integer x)) - "1" [1])) + (testing "Integer" + (are [x res] (= res (tu/compile-unop elm/to-list elm/integer x)) + "1" [1])) - (testing "Null" - (is (= [] (c/compile {} #elm/to-list{:type "Null"})))) + (testing "Null" + (is (= [] (c/compile {} #elm/to-list{:type "Null"}))))) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-list #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-list (param-ref "x")) (core/-form expr)))))) + (testing "Dynamic" + (are [x res] (= res (tu/dynamic-compile-eval (elm/to-list x))) + #elm/parameter-ref "nil" [] + #elm/parameter-ref "a" ["a"])) + + (tu/testing-unary-dynamic elm/to-list) + + (tu/testing-unary-form elm/to-list)) ;; 22.27. ToLong @@ -1574,11 +1617,9 @@ (tu/testing-unary-null elm/to-long) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-long #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-long (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-long) + + (tu/testing-unary-form elm/to-long)) ;; 22.28. ToQuantity @@ -1656,11 +1697,9 @@ (tu/testing-unary-null elm/to-quantity) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-quantity #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-quantity (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-quantity) + + (tu/testing-unary-form elm/to-quantity)) ;; 22.29. ToRatio @@ -1710,11 +1749,9 @@ (tu/testing-unary-null elm/to-ratio) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-ratio #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-ratio (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-ratio) + + (tu/testing-unary-form elm/to-ratio)) ;; 22.30. ToString @@ -1792,11 +1829,9 @@ (tu/testing-unary-null elm/to-string) - (testing "form" - (let [compile-ctx {:library {:parameters {:def [{:name "x"}]}}} - elm #elm/to-string #elm/parameter-ref "x" - expr (c/compile compile-ctx elm)] - (is (= '(to-string (param-ref "x")) (core/-form expr)))))) + (tu/testing-unary-dynamic elm/to-string) + + (tu/testing-unary-form elm/to-string)) ;; 22.31. ToTime @@ -1847,9 +1882,13 @@ "2020-03-08T12:54:00" (system/time 12 54 00) "2020-03-08T12:54:30.010" (system/time 12 54 30 10))) - (testing "dynamic" + (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)) + (tu/testing-unary-null elm/to-time) + + (tu/testing-unary-dynamic elm/to-time) + + (tu/testing-unary-form elm/to-time)) diff --git a/modules/cql/test/blaze/elm/literal.clj b/modules/cql/test/blaze/elm/literal.clj index 148f47e1c..17aa8eff9 100644 --- a/modules/cql/test/blaze/elm/literal.clj +++ b/modules/cql/test/blaze/elm/literal.clj @@ -1,6 +1,6 @@ (ns blaze.elm.literal (:refer-clojure - :exclude [abs and boolean count distinct first flatten list long max min not or + :exclude [abs and boolean count distinct first flatten last list long max min not or time]) (:require [blaze.elm.spec] @@ -262,6 +262,7 @@ :element elements}) +;; 15.2. If (defn if-expr [[condition then else]] {:type "If" :condition condition :then then :else else}) @@ -355,12 +356,13 @@ ;; 16.19. Round -(defn round [[operand precision]] - (cond-> - {:type "Round" - :operand operand} - precision - (assoc :precision precision))) +(defn round [arg] + (let [[operand precision] (if (sequential? arg) arg [arg])] + (cond-> + {:type "Round" + :operand operand} + precision + (assoc :precision precision)))) ;; 16.20. Subtract @@ -402,6 +404,13 @@ :operand ops}) +;; 17.7. LastPositionOf +(defn last-position-of [[pattern s]] + {:type "LastPositionOf" + :pattern pattern + :string s}) + + ;; 17.8. Length (defn length [x] {:type "Length" @@ -420,6 +429,19 @@ :operand ops}) +;; 17.12. PositionOf +(defn position-of [[pattern s]] + {:type "PositionOf" + :pattern pattern + :string s}) + + +;; 17.13. ReplaceMatches +(defn replace-matches [ops] + {:type "ReplaceMatches" + :operand ops}) + + ;; 17.16. StartsWith (defn starts-with [ops] {:type "StartsWith" @@ -535,6 +557,11 @@ millisecond (assoc :millisecond millisecond))))) +;; 18.21. TimeOfDay +(def time-of-day + {:type "TimeOfDay"}) + + ;; 18.22. Today (def today {:type "Today"}) @@ -716,7 +743,7 @@ ;; 20.3. Current (defn current [scope] - {:type "Current" :scope scope}) + (cond-> {:type "Current"} scope (assoc :scope scope))) ;; 20.4. Distinct @@ -739,6 +766,16 @@ {:type "Flatten" :operand list}) +;; 20.16. IndexOf +(defn index-of [[source element]] + {:type "IndexOf" :source source :element element}) + + +;; 20.18. Last +(defn last [source] + {:type "Last" :source source}) + + ;; 20.25. SingletonFrom (defn singleton-from [list] {:type "SingletonFrom" :operand list}) diff --git a/modules/cql/test/blaze/elm/literal_spec.clj b/modules/cql/test/blaze/elm/literal_spec.clj index b52d04117..a2cd8ca69 100644 --- a/modules/cql/test/blaze/elm/literal_spec.clj +++ b/modules/cql/test/blaze/elm/literal_spec.clj @@ -247,8 +247,9 @@ (s/fdef elm/round - :args (s/cat :ops (s/spec (s/cat :x :elm/expression - :precision (s/? :elm/expression)))) + :args (s/cat :ops (s/alt :single :elm/expression + :multi (s/spec (s/cat :x :elm/expression + :precision (s/? :elm/expression))))) :ret :elm/expression) @@ -413,7 +414,7 @@ ;; 20.3. Current (s/fdef elm/current - :args (s/cat :scope string?) + :args (s/cat :scope (s/nilable string?)) :ret :elm/expression) diff --git a/modules/cql/test/data_readers.clj b/modules/cql/test/data_readers.clj index 6b25344ae..0c90a6a8e 100644 --- a/modules/cql/test/data_readers.clj +++ b/modules/cql/test/data_readers.clj @@ -67,11 +67,28 @@ elm/interval blaze.elm.literal/interval elm/contains blaze.elm.literal/contains elm/intersect blaze.elm.literal/intersect + elm/point-from blaze.elm.literal/point-from elm/current blaze.elm.literal/current elm/distinct blaze.elm.literal/distinct elm/exists blaze.elm.literal/exists elm/first blaze.elm.literal/first + elm/last blaze.elm.literal/last elm/singleton-from blaze.elm.literal/singleton-from + elm/all-true blaze.elm.literal/all-true + elm/any-true blaze.elm.literal/any-true + elm/avg blaze.elm.literal/avg + elm/count blaze.elm.literal/count + elm/geometric-mean blaze.elm.literal/geometric-mean + elm/product blaze.elm.literal/product + elm/max blaze.elm.literal/max + elm/median blaze.elm.literal/median + elm/min blaze.elm.literal/min + elm/mode blaze.elm.literal/mode + elm/population-variance blaze.elm.literal/population-variance + elm/population-std-dev blaze.elm.literal/population-std-dev + elm/sum blaze.elm.literal/sum + elm/std-dev blaze.elm.literal/std-dev + elm/variance blaze.elm.literal/variance elm/as blaze.elm.literal/as elm/can-convert-quantity blaze.elm.literal/can-convert-quantity elm/convert-quantity blaze.elm.literal/convert-quantity diff --git a/modules/db-protocols/src/blaze/db/impl/protocols.clj b/modules/db-protocols/src/blaze/db/impl/protocols.clj index 982e57ce9..9a1ef5ca5 100644 --- a/modules/db-protocols/src/blaze/db/impl/protocols.clj +++ b/modules/db-protocols/src/blaze/db/impl/protocols.clj @@ -24,6 +24,8 @@ [db compartment tid] [db compartment tid start-id]) + (-patient-compartment-last-change-t [db patient-id]) + (-count-query [db query] "Returns a CompletableFuture that will complete with the count of the matching resource handles.") @@ -109,4 +111,4 @@ (-list-by-type [_ type]) (-list-by-target [_ target]) (-linked-compartments [_ resource]) - (-compartment-resources [_ type])) + (-compartment-resources [_ compartment-type] [_ compartment-type type])) diff --git a/modules/db-resource-store-cassandra/.clj-kondo/config.edn b/modules/db-resource-store-cassandra/.clj-kondo/config.edn index c0dd2f789..884a543ed 100644 --- a/modules/db-resource-store-cassandra/.clj-kondo/config.edn +++ b/modules/db-resource-store-cassandra/.clj-kondo/config.edn @@ -21,6 +21,7 @@ :consistent-alias {:aliases - {cuerdas.core c-str}}} + {cognitect.anomalies anom + cuerdas.core c-str}}} :skip-comments true} diff --git a/modules/db-resource-store/.clj-kondo/config.edn b/modules/db-resource-store/.clj-kondo/config.edn index c0dd2f789..884a543ed 100644 --- a/modules/db-resource-store/.clj-kondo/config.edn +++ b/modules/db-resource-store/.clj-kondo/config.edn @@ -21,6 +21,7 @@ :consistent-alias {:aliases - {cuerdas.core c-str}}} + {cognitect.anomalies anom + cuerdas.core c-str}}} :skip-comments true} diff --git a/modules/db-stub/src/blaze/db/api_stub.clj b/modules/db-stub/src/blaze/db/api_stub.clj index 9c4123355..561de85f2 100644 --- a/modules/db-stub/src/blaze/db/api_stub.clj +++ b/modules/db-stub/src/blaze/db/api_stub.clj @@ -29,6 +29,7 @@ :kv-store (ig/ref :blaze.db/index-kv-store) :resource-indexer (ig/ref :blaze.db.node/resource-indexer) :search-param-registry (ig/ref :blaze.db/search-param-registry) + :scheduler (ig/ref :blaze/scheduler) :poll-timeout (time/millis 10)} node-config) @@ -57,6 +58,7 @@ :resource-as-of-index nil :type-as-of-index nil :system-as-of-index nil + :patient-as-of-index nil :type-stats-index nil :system-stats-index nil}} @@ -76,7 +78,9 @@ :blaze.db.node.resource-indexer/executor {} :blaze.db/search-param-registry - {:structure-definition-repo structure-definition-repo}}) + {:structure-definition-repo structure-definition-repo} + + :blaze/scheduler {}}) (def mem-node-config diff --git a/modules/db/.clj-kondo/config.edn b/modules/db/.clj-kondo/config.edn index 3d510f5ed..f57f4bffc 100644 --- a/modules/db/.clj-kondo/config.edn +++ b/modules/db/.clj-kondo/config.edn @@ -38,6 +38,7 @@ blaze.db.impl.protocols p blaze.db.search-param-registry sr blaze.executors ex + blaze.scheduler sched buddy.auth auth cognitect.anomalies anom clojure.java.io io diff --git a/modules/db/deps.edn b/modules/db/deps.edn index 8023f0d6d..90e89975d 100644 --- a/modules/db/deps.edn +++ b/modules/db/deps.edn @@ -10,6 +10,9 @@ blaze/byte-string {:local/root "../byte-string"} + blaze/cache-collector + {:local/root "../cache-collector"} + blaze/coll {:local/root "../coll"} @@ -34,6 +37,9 @@ blaze/db-resource-store {:local/root "../db-resource-store"} + blaze/scheduler + {:local/root "../scheduler"} + blaze/spec {:local/root "../spec"} diff --git a/modules/db/src/blaze/db/api.clj b/modules/db/src/blaze/db/api.clj index f41ab6181..1d0138327 100644 --- a/modules/db/src/blaze/db/api.clj +++ b/modules/db/src/blaze/db/api.clj @@ -75,6 +75,12 @@ (p/-as-of db t)) +(defn t + "Returns the effective `t` of `db`." + [db] + (or (p/-as-of-t db) (p/-basis-t db))) + + (defn basis-t "Returns the `t` of the most recent transaction reachable via `db`." [db] @@ -284,6 +290,13 @@ +;; ---- Patient-Compartment-Level Functions ----------------------------------- + +(defn patient-compartment-last-change-t [db patient-id] + (p/-patient-compartment-last-change-t db (codec/id-byte-string patient-id))) + + + ;; ---- Common Query Functions ------------------------------------------------ (defn count-query diff --git a/modules/db/src/blaze/db/api_spec.clj b/modules/db/src/blaze/db/api_spec.clj index c139353e1..daa16adee 100644 --- a/modules/db/src/blaze/db/api_spec.clj +++ b/modules/db/src/blaze/db/api_spec.clj @@ -31,6 +31,11 @@ :ret :blaze.db/node) +(s/fdef d/t + :args (s/cat :db :blaze.db/db) + :ret :blaze.db/t) + + (s/fdef d/basis-t :args (s/cat :db :blaze.db/db) :ret :blaze.db/t) diff --git a/modules/db/src/blaze/db/cache_collector/spec.clj b/modules/db/src/blaze/db/cache_collector/spec.clj deleted file mode 100644 index 1f515be65..000000000 --- a/modules/db/src/blaze/db/cache_collector/spec.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns blaze.db.cache-collector.spec - (:require - [blaze.db.cache-collector.protocols :as p] - [clojure.spec.alpha :as s])) - - -(s/def :blaze.db.cache-collector/caches - (s/map-of string? (s/nilable #(satisfies? p/StatsCache %)))) diff --git a/modules/db/src/blaze/db/impl/batch_db.clj b/modules/db/src/blaze/db/impl/batch_db.clj index 89a087c8f..16d7d693a 100644 --- a/modules/db/src/blaze/db/impl/batch_db.clj +++ b/modules/db/src/blaze/db/impl/batch_db.clj @@ -9,6 +9,7 @@ [blaze.db.impl.codec :as codec] [blaze.db.impl.index :as index] [blaze.db.impl.index.compartment.resource :as cr] + [blaze.db.impl.index.patient-as-of :as pao] [blaze.db.impl.index.resource-as-of :as rao] [blaze.db.impl.index.resource-handle :as rh] [blaze.db.impl.index.search-param-value-resource :as sp-vr] @@ -37,7 +38,7 @@ (:total (type-stats/get! iter tid t) 0))) -(defrecord BatchDb [node basis-t context] +(defrecord BatchDb [node basis-t t context] p/Db (-node [_] node) @@ -45,6 +46,9 @@ (-basis-t [_] basis-t) + (-as-of-t [_] + (when (not= basis-t t) t)) + ;; ---- Instance-Level Functions -------------------------------------------- @@ -92,6 +96,13 @@ + ;; ---- Patient-Compartment-Level Functions --------------------------------- + + (-patient-compartment-last-change-t [_ patient-id] + (pao/last-change-t (:paoi context) patient-id t)) + + + ;; ---- Common Query Functions ---------------------------------------------- (-count-query [_ query] @@ -321,9 +332,11 @@ (->BatchDb node basis-t + t (let [raoi (kv/new-iterator snapshot :resource-as-of-index)] {:snapshot snapshot :raoi raoi + :paoi (kv/new-iterator snapshot :patient-as-of-index) :resource-handle (rao/resource-handle raoi t) :svri (kv/new-iterator snapshot :search-param-value-index) :rsvi (kv/new-iterator snapshot :resource-value-index) diff --git a/modules/db/src/blaze/db/impl/codec.clj b/modules/db/src/blaze/db/impl/codec.clj index 1d5a5a68b..1ce913ce4 100644 --- a/modules/db/src/blaze/db/impl/codec.clj +++ b/modules/db/src/blaze/db/impl/codec.clj @@ -226,6 +226,7 @@ (defn id + "Creates an resource id as String from the byte array `id-bytes`." {:inline (fn [id-bytes offset length] `(String. ~id-bytes ~offset ~length StandardCharsets/ISO_8859_1))} diff --git a/modules/db/src/blaze/db/impl/db.clj b/modules/db/src/blaze/db/impl/db.clj index b2a30c0eb..3201a18bc 100644 --- a/modules/db/src/blaze/db/impl/db.clj +++ b/modules/db/src/blaze/db/impl/db.clj @@ -3,6 +3,7 @@ (:require [blaze.async.comp :as ac] [blaze.db.impl.batch-db :as batch-db] + [blaze.db.impl.index.patient-as-of :as pao] [blaze.db.impl.index.resource-as-of :as rao] [blaze.db.impl.macros :refer [with-open-coll]] [blaze.db.impl.protocols :as p] @@ -85,6 +86,15 @@ + ;; ---- Patient-Compartment-Level Functions --------------------------------- + + (-patient-compartment-last-change-t [_ patient-id] + (with-open [snapshot (kv/new-snapshot kv-store) + paoi (kv/new-iterator snapshot :patient-as-of-index)] + (pao/last-change-t paoi patient-id t))) + + + ;; ---- Common Query Functions ---------------------------------------------- (-count-query [_ query] diff --git a/modules/db/src/blaze/db/impl/index/patient_as_of.clj b/modules/db/src/blaze/db/impl/index/patient_as_of.clj new file mode 100644 index 000000000..b249b0109 --- /dev/null +++ b/modules/db/src/blaze/db/impl/index/patient_as_of.clj @@ -0,0 +1,87 @@ +(ns blaze.db.impl.index.patient-as-of + "Functions for accessing the PatientAsOf index." + (:require + [blaze.byte-buffer :as bb] + [blaze.byte-string :as bs] + [blaze.db.impl.codec :as codec] + [blaze.db.impl.index.rts-as-of :as rts] + [blaze.db.kv :as kv]) + (:import + [java.nio.charset StandardCharsets])) + + +(set! *warn-on-reflection* true) +(set! *unchecked-math* :warn-on-boxed) + + +(def ^:private ^:const ^long t-tid-size + (+ codec/t-size codec/tid-size)) + + +(defn- encode-key + "Encodes the key of the PatientAsOf index from `patient-id`, `t`, `tid` and + `id`." + [patient-id t tid id] + (-> (bb/allocate (-> (unchecked-add-int (bs/size patient-id) (bs/size id)) + (unchecked-add-int t-tid-size))) + (bb/put-byte-string! patient-id) + (bb/put-long! (codec/descending-long ^long t)) + (bb/put-int! tid) + (bb/put-byte-string! id) + bb/array)) + + +(defn index-entry [patient-id tid id t hash num-changes op] + [:patient-as-of-index (encode-key patient-id t tid id) + (rts/encode-value hash num-changes op)]) + + +(defn- encode-patient-id-t [patient-id t] + (-> (bb/allocate (unchecked-add-int (bs/size patient-id) codec/t-size)) + (bb/put-byte-string! patient-id) + (bb/put-long! (codec/descending-long ^long t)) + bb/array)) + + +(defn last-change-t + "Returns the `t` of last change of any resource in the patient compartment not + newer than `t`." + [paoi patient-id t] + (kv/seek! paoi (encode-patient-id-t patient-id t)) + (when (kv/valid? paoi) + (-> (bb/get-long! (bb/wrap (kv/key paoi)) (bs/size patient-id)) + (codec/descending-long)))) + + +(def ^:private state-key + (.getBytes "patient-as-of-state" StandardCharsets/ISO_8859_1)) + + +(defn- encode-state [{:keys [type t]}] + (if (identical? :current type) + (byte-array [0]) + (-> (bb/allocate (inc Long/BYTES)) + (bb/put-byte! 1) + (bb/put-long! t) + bb/array))) + + +(defn decode-state [bytes] + (let [buf (bb/wrap bytes)] + (if (zero? (bb/get-byte! buf)) + {:type :current} + {:type :building + :t (bb/get-long! buf)}))) + + +(defn state + "Returns the state of the PatientAsOf index. + + The state is on of :current or last-t." + [kv-store] + (or (some-> (kv/get kv-store state-key) decode-state) + {:type :building :t 0})) + + +(defn state-index-entry [state] + [state-key (encode-state state)]) diff --git a/modules/db/src/blaze/db/impl/index/system_as_of.clj b/modules/db/src/blaze/db/impl/index/system_as_of.clj index 275e22839..9d2339bc6 100644 --- a/modules/db/src/blaze/db/impl/index/system_as_of.clj +++ b/modules/db/src/blaze/db/impl/index/system_as_of.clj @@ -35,7 +35,7 @@ (defn- decoder "Returns a function which decodes an resource handle out of a key and a value - byte buffers from the resource-as-of index. + byte buffers from the SystemAsOf index. Closes over a shared byte array for id decoding, because the String constructor creates a copy of the id bytes anyway. Can only be used from one diff --git a/modules/db/src/blaze/db/node.clj b/modules/db/src/blaze/db/node.clj index 8bcc308bb..be4f3e796 100644 --- a/modules/db/src/blaze/db/node.clj +++ b/modules/db/src/blaze/db/node.clj @@ -6,6 +6,7 @@ [blaze.db.impl.batch-db :as batch-db] [blaze.db.impl.codec :as codec] [blaze.db.impl.db :as db] + [blaze.db.impl.index.patient-as-of :as pao] [blaze.db.impl.index.resource-handle :as rh] [blaze.db.impl.index.t-by-instant :as t-by-instant] [blaze.db.impl.index.tx-error :as tx-error] @@ -15,6 +16,7 @@ [blaze.db.impl.search-param.all :as search-param-all] [blaze.db.impl.search-param.chained :as spc] [blaze.db.kv :as kv] + [blaze.db.node.patient-as-of-index :as node-pao] [blaze.db.node.protocols :as np] [blaze.db.node.resource-indexer :as resource-indexer] [blaze.db.node.resource-indexer.spec] @@ -31,6 +33,7 @@ [blaze.fhir.spec :as fhir-spec] [blaze.fhir.spec.type :as type] [blaze.module :refer [reg-collector]] + [blaze.scheduler :as sched] [blaze.spec] [blaze.util :refer [conj-vec]] [clojure.spec.alpha :as s] @@ -167,9 +170,9 @@ future)) -(defn- index-tx [db-before tx-data] +(defn- index-tx [search-param-registry db-before tx-data] (with-open [_ (prom/timer duration-seconds "index-transactions")] - (tx-indexer/index-tx db-before tx-data))) + (tx-indexer/index-tx search-param-registry db-before tx-data))) (defn- advance-t! [state t] @@ -222,13 +225,13 @@ "This is the main transaction handling function. If indexes resources and transaction data and commits either success or error." - [{:keys [resource-indexer kv-store] :as node} + [{:keys [resource-indexer kv-store search-param-registry] :as node} {:keys [t instant tx-cmds] :as tx-data}] (log/trace "index transaction with t =" t "and" (count tx-cmds) "command(s)") (prom/observe! transaction-sizes (count tx-cmds)) (let [timer (prom/timer duration-seconds "index-resources") future (resource-indexer/index-resources resource-indexer tx-data) - result (index-tx (np/-db node) tx-data)] + result (index-tx search-param-registry (np/-db node) tx-data)] (if (ba/anomaly? result) (commit-error! node t result) (do @@ -242,7 +245,11 @@ (tx-log/poll! queue poll-timeout))) -(defn- poll-and-index! [node queue poll-timeout] +(defn- poll-and-index! + "Polls `queue` once and indexes the resulting transaction data. + + Waits up to `poll-timeout` for the transaction data to become available." + [node queue poll-timeout] (log/trace "poll transaction queue") (run! (partial index-tx-data! node) (poll-tx-queue! queue poll-timeout))) @@ -482,7 +489,8 @@ :blaze.db/kv-store ::resource-indexer :blaze.db/resource-store - :blaze.db/search-param-registry] + :blaze.db/search-param-registry + :blaze/scheduler] :opt-un [:blaze.db/enforce-referential-integrity])) @@ -530,9 +538,43 @@ (ac/completed-future (db/db node (:t @(.-state node))))))) +(defn- index-patient-as-of-index! + [{:keys [kv-store] :as node} current-t {:keys [t] :as tx-data}] + (log/debug "Build PatientAsOf index with t =" t) + (when-ok [entries (node-pao/index-entries node tx-data)] + (store-tx-entries! kv-store entries)) + (vreset! current-t t)) + + +(defn- poll-and-index-patient-as-of-index! [node queue current-t poll-timeout] + (run! (partial index-patient-as-of-index! node current-t) (poll-tx-queue! queue poll-timeout))) + + +(defn build-patient-as-of-index + [{:keys [tx-log kv-store run? state poll-timeout] :as node}] + (let [{:keys [type t]} (pao/state kv-store)] + (when (identical? :building type) + (let [start-t (inc t) + end-t (:t @state) + current-t (volatile! start-t)] + (log/info "Building PatientAsOf index starting at t =" start-t) + (with-open [queue (tx-log/new-queue tx-log start-t)] + (while (and @run? (< @current-t end-t)) + (try + (poll-and-index-patient-as-of-index! node queue current-t poll-timeout) + (catch Exception e + (log/error "Error while building the PatientAsOf index." e))))) + (if (= @current-t end-t) + (do + (store-tx-entries! kv-store [(pao/state-index-entry {:type :current})]) + (log/info "Finished building PatientAsOf index.")) + (log/info "Partially build PatientAsOf index up to t =" @current-t + "at a goal of t =" end-t "Will continue at next start.")))))) + + (defmethod ig/init-key :blaze.db/node [_ {:keys [storage tx-log tx-cache indexer-executor kv-store resource-indexer - resource-store search-param-registry poll-timeout] + resource-store search-param-registry scheduler poll-timeout] :or {poll-timeout (time/seconds 1)} :as config}] (init-msg config) @@ -543,6 +585,7 @@ (volatile! true) poll-timeout (ac/future))] + (sched/submit scheduler #(build-patient-as-of-index node)) (execute node indexer-executor) node)) diff --git a/modules/db/src/blaze/db/node/patient_as_of_index.clj b/modules/db/src/blaze/db/node/patient_as_of_index.clj new file mode 100644 index 000000000..2b2614fbb --- /dev/null +++ b/modules/db/src/blaze/db/node/patient_as_of_index.clj @@ -0,0 +1,14 @@ +(ns blaze.db.node.patient-as-of-index + (:require + [blaze.anomaly :refer [when-ok]] + [blaze.db.impl.db :as db] + [blaze.db.impl.index.patient-as-of :as pao] + [blaze.db.node.tx-indexer :as tx-indexer])) + + +(defn index-entries + {:arglists '([node tx-data])} + [{:keys [search-param-registry] :as node} {:keys [t] :as tx-data}] + (when-ok [entries (tx-indexer/index-tx search-param-registry (db/db node (dec t)) tx-data)] + (-> (filterv (comp #{:patient-as-of-index} first) entries) + (conj (pao/state-index-entry {:type :building :t t}))))) diff --git a/modules/db/src/blaze/db/node/tx_indexer.clj b/modules/db/src/blaze/db/node/tx_indexer.clj index c06510004..7c18d30f7 100644 --- a/modules/db/src/blaze/db/node/tx_indexer.clj +++ b/modules/db/src/blaze/db/node/tx_indexer.clj @@ -6,7 +6,7 @@ (defn index-tx - [db-before {:keys [t tx-cmds]}] + [search-param-registry db-before {:keys [t tx-cmds]}] (log/trace "verify transaction commands with t =" t "based on db with t =" (d/basis-t db-before)) - (verify/verify-tx-cmds db-before t tx-cmds)) + (verify/verify-tx-cmds search-param-registry db-before t tx-cmds)) diff --git a/modules/db/src/blaze/db/node/tx_indexer/verify.clj b/modules/db/src/blaze/db/node/tx_indexer/verify.clj index b3d72994a..c3d2e7fc9 100644 --- a/modules/db/src/blaze/db/node/tx_indexer/verify.clj +++ b/modules/db/src/blaze/db/node/tx_indexer/verify.clj @@ -3,11 +3,13 @@ [blaze.anomaly :as ba :refer [throw-anom]] [blaze.db.api :as d] [blaze.db.impl.codec :as codec] + [blaze.db.impl.index.patient-as-of :as pao] [blaze.db.impl.index.resource-handle :as rh] [blaze.db.impl.index.rts-as-of :as rts] [blaze.db.impl.index.system-stats :as system-stats] [blaze.db.impl.index.type-stats :as type-stats] [blaze.db.kv.spec] + [blaze.db.search-param-registry :as sr] [blaze.fhir.hash :as hash] [blaze.util :as u] [clojure.string :as str] @@ -115,8 +117,8 @@ statistics of the transaction outcome. Throws an anomaly on conflicts." - {:arglists '([db-before t res cmd])} - (fn [_db-before _t _res {:keys [op]}] op)) + {:arglists '([search-param-registry db-before t res cmd])} + (fn [_search-param-registry _db-before _t _res {:keys [op]}] op)) (defn- verify-tx-cmd-create-msg [type id] @@ -132,20 +134,27 @@ (throw-anom (ba/conflict (id-collision-msg type id))))) -(defn- index-entries [tid id t hash num-changes op] - (rts/index-entries tid (codec/id-byte-string id) t hash num-changes op)) +(defn- index-entries [tid id t hash num-changes op refs] + (let [id (codec/id-byte-string id)] + (into + (rts/index-entries tid id t hash num-changes op) + (keep (fn [[ref-type ref-id]] + (when (= "Patient" ref-type) + (pao/index-entry (codec/id-byte-string ref-id) tid id t hash + num-changes op)))) + refs))) (def ^:private inc-0 (fnil inc 0)) (defmethod verify-tx-cmd "create" - [db-before t res {:keys [type id hash]}] + [_search-param-registry db-before t res {:keys [type id hash refs]}] (log/trace (verify-tx-cmd-create-msg type id)) (with-open [_ (prom/timer duration-seconds "verify-create")] (check-id-collision! db-before type id) (let [tid (codec/tid type)] - (-> (update res :entries into (index-entries tid id t hash 1 :create)) + (-> (update res :entries into (index-entries tid id t hash 1 :create refs)) (update :new-resources conj [type id]) (update-in [:stats tid :num-changes] inc-0) (update-in [:stats tid :total] inc-0))))) @@ -191,7 +200,8 @@ (defmethod verify-tx-cmd "put" - [db-before t res {:keys [type id hash if-match if-none-match] :as tx-cmd}] + [_search-param-registry db-before t res + {:keys [type id hash if-match if-none-match refs] :as tx-cmd}] (log/trace (verify-tx-cmd-put-msg type id (u/to-seq if-match) if-none-match)) (with-open [_ (prom/timer duration-seconds "verify-put")] (let [tid (codec/tid type) @@ -213,7 +223,7 @@ :else (cond-> - (-> (update res :entries into (index-entries tid id t hash (inc num-changes) :put)) + (-> (update res :entries into (index-entries tid id t hash (inc num-changes) :put refs)) (update :new-resources conj [type id]) (update-in [:stats tid :num-changes] inc-0)) (or (nil? old-t) (identical? :delete op)) @@ -227,7 +237,7 @@ (defmethod verify-tx-cmd "keep" - [db-before _ res {:keys [type id hash if-match] :as tx-cmd}] + [_search-param-registry db-before _ res {:keys [type id hash if-match] :as tx-cmd}] (log/trace (verify-tx-cmd-keep-msg type id (u/to-seq if-match))) (with-open [_ (prom/timer duration-seconds "verify-keep")] (let [if-match (u/to-seq if-match) @@ -245,15 +255,24 @@ res)))) +(defn- patient-refs [search-param-registry db type resource-handle] + (into + [] + (comp (mapcat #(d/include db resource-handle % "Patient")) + (map (fn [{:keys [id]}] ["Patient" id]))) + (sr/compartment-resources search-param-registry "Patient" type))) + + (defmethod verify-tx-cmd "delete" - [db-before t res {:keys [type id]}] + [search-param-registry db-before t res {:keys [type id]}] (log/trace "verify-tx-cmd :delete" (str type "/" id)) (with-open [_ (prom/timer duration-seconds "verify-delete")] (let [tid (codec/tid type) - {:keys [num-changes op] :or {num-changes 0}} - (d/resource-handle db-before type id)] + {:keys [num-changes op] :or {num-changes 0} :as old-resource-handle} + (d/resource-handle db-before type id) + refs (some->> old-resource-handle (patient-refs search-param-registry db-before type))] (cond-> - (-> (update res :entries into (index-entries tid id t hash/deleted-hash (inc num-changes) :delete)) + (-> (update res :entries into (index-entries tid id t hash/deleted-hash (inc num-changes) :delete refs)) (update :del-resources conj [type id]) (update-in [:stats tid :num-changes] inc-0)) (and op (not (identical? :delete op))) @@ -261,13 +280,13 @@ (defmethod verify-tx-cmd :default - [_db-before _t res _tx-cmd] + [_search-param-registry _db-before _t res _tx-cmd] res) -(defn- verify-tx-cmds** [db-before t tx-cmds] +(defn- verify-tx-cmds** [search-param-registry db-before t tx-cmds] (reduce - (partial verify-tx-cmd db-before t) + (partial verify-tx-cmd search-param-registry db-before t) {:entries [] :new-resources #{} :del-resources #{}} @@ -346,11 +365,11 @@ cmds)) -(defn- verify-tx-cmds* [db-before t cmds] +(defn- verify-tx-cmds* [search-param-registry db-before t cmds] (ba/try-anomaly (let [cmds (resolve-ids db-before cmds)] (detect-duplicate-commands! cmds) - (let [res (verify-tx-cmds** db-before t cmds)] + (let [res (verify-tx-cmds** search-param-registry db-before t cmds)] (check-referential-integrity! db-before res cmds) (post-process-res db-before t res))))) @@ -360,7 +379,7 @@ outcome if it is successful or an anomaly if it fails. The `t` is for the new transaction to commit." - [db-before t cmds] + [search-param-registry db-before t cmds] (with-open [_ (prom/timer duration-seconds "verify-tx-cmds") batch-db-before (d/new-batch-db db-before)] - (verify-tx-cmds* batch-db-before t cmds))) + (verify-tx-cmds* search-param-registry batch-db-before t cmds))) diff --git a/modules/db/src/blaze/db/node/version.clj b/modules/db/src/blaze/db/node/version.clj index 001532381..93c7d9d32 100644 --- a/modules/db/src/blaze/db/node/version.clj +++ b/modules/db/src/blaze/db/node/version.clj @@ -1,8 +1,7 @@ (ns blaze.db.node.version (:refer-clojure :exclude [key]) - (:require - [blaze.byte-buffer :as bb]) (:import + [com.google.common.primitives Longs] [java.nio.charset StandardCharsets])) @@ -14,10 +13,8 @@ (defn encode-value [version] - (-> (bb/allocate Integer/BYTES) - (bb/put-int! version) - (bb/array))) + (Longs/toByteArray version)) (defn decode-value [bytes] - (bb/get-int! (bb/wrap bytes))) + (Longs/fromByteArray bytes)) diff --git a/modules/db/src/blaze/db/resource_cache.clj b/modules/db/src/blaze/db/resource_cache.clj index e9e2c1c6b..d6a580816 100644 --- a/modules/db/src/blaze/db/resource_cache.clj +++ b/modules/db/src/blaze/db/resource_cache.clj @@ -4,7 +4,7 @@ Caffeine is used because it have better performance characteristics as a ConcurrentHashMap." (:require - [blaze.db.cache-collector.protocols :as ccp] + [blaze.cache-collector.protocols :as ccp] [blaze.db.resource-cache.spec] [blaze.db.resource-store :as rs] [blaze.db.resource-store.spec] diff --git a/modules/db/src/blaze/db/search_param_registry.clj b/modules/db/src/blaze/db/search_param_registry.clj index 9bdebac11..a976ede0b 100644 --- a/modules/db/src/blaze/db/search_param_registry.clj +++ b/modules/db/src/blaze/db/search_param_registry.clj @@ -47,16 +47,21 @@ (defn compartment-resources - "Returns a seq of [type code] tuples of resources in compartment of `type`. + "Returns a seq of [type code] tuples of resources in compartment of + `compartment-type` or a list of codes if the optional `type` is given. Example: - * [\"Observation\" \"subject\"] and others for \"Patient\"" - [search-param-registry type] - (p/-compartment-resources search-param-registry type)) + * [\"Observation\" \"subject\"] and others for \"Patient\" + * [\"subject\"] and others for \"Patient\" and \"Observation\"" + ([search-param-registry compartment-type] + (p/-compartment-resources search-param-registry compartment-type)) + ([search-param-registry compartment-type type] + (p/-compartment-resources search-param-registry compartment-type type))) (deftype MemSearchParamRegistry [index target-index compartment-index - compartment-resource-index] + compartment-resource-index + compartment-resource-index-by-type] p/SearchParamRegistry (-get [_ code] (get-in index ["Resource" code])) @@ -87,8 +92,11 @@ #{} (compartment-index (name (fhir-spec/fhir-type resource))))) - (-compartment-resources [_ type] - (compartment-resource-index type []))) + (-compartment-resources [_ compartment-type] + (compartment-resource-index compartment-type [])) + + (-compartment-resources [_ compartment-type type] + (get-in compartment-resource-index-by-type [compartment-type type] []))) (def ^:private object-mapper @@ -161,6 +169,15 @@ resource-defs)}) +(defn- index-compartment-resources-by-type [{def-code :code resource-defs :resource}] + {def-code + (reduce + (fn [res {res-type :code param-codes :param}] + (cond-> res param-codes (assoc res-type param-codes))) + {} + resource-defs)}) + + (def ^:private list-search-param {:type "special" :name "_list"}) @@ -258,7 +275,9 @@ patient-compartment (read-classpath-json-resource "blaze/db/compartment/patient.json")] (when-ok [url-index (build-url-index entries) index (build-index url-index entries)] - (->MemSearchParamRegistry (add-special index) - (build-target-index url-index entries) - (index-compartment-def index patient-compartment) - (index-compartment-resources patient-compartment))))) + (->MemSearchParamRegistry + (add-special index) + (build-target-index url-index entries) + (index-compartment-def index patient-compartment) + (index-compartment-resources patient-compartment) + (index-compartment-resources-by-type patient-compartment))))) 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 859f19a2f..553a5cf8b 100644 --- a/modules/db/src/blaze/db/search_param_registry_spec.clj +++ b/modules/db/src/blaze/db/search_param_registry_spec.clj @@ -34,5 +34,6 @@ (s/fdef sr/compartment-resources :args (s/cat :search-param-registry :blaze.db/search-param-registry - :type :fhir.resource/type) + :compartment-type :fhir.resource/type + :type (s/? :fhir.resource/type)) :ret (s/coll-of (s/tuple :fhir.resource/type string?))) diff --git a/modules/db/src/blaze/db/tx_log/local.clj b/modules/db/src/blaze/db/tx_log/local.clj index 1a0a28f44..787a39952 100644 --- a/modules/db/src/blaze/db/tx_log/local.clj +++ b/modules/db/src/blaze/db/tx_log/local.clj @@ -127,7 +127,7 @@ (let [key (Object.) queue (ArrayBlockingQueue. 10) queue-start (inc (:t (swap! state update :queues assoc key queue)))] - (log/trace "new-queue offset =" offset ", queue-start =" queue-start) + (log/trace "new-queue offset =" offset "queue-start =" queue-start) (->LocalQueue kv-store (volatile! offset) queue queue-start #(swap! state update :queues dissoc key))))) diff --git a/modules/db/test-perf/blaze/db/api_test_perf.clj b/modules/db/test-perf/blaze/db/api_test_perf.clj index 7bed864b9..dd0f4fd63 100644 --- a/modules/db/test-perf/blaze/db/api_test_perf.clj +++ b/modules/db/test-perf/blaze/db/api_test_perf.clj @@ -60,6 +60,7 @@ :resource-as-of-index nil :type-as-of-index nil :system-as-of-index nil + :patient-as-of-index nil :type-stats-index nil :system-stats-index nil}} diff --git a/modules/db/test/blaze/db/api_test.clj b/modules/db/test/blaze/db/api_test.clj index a6bf08092..cca7cf046 100644 --- a/modules/db/test/blaze/db/api_test.clj +++ b/modules/db/test/blaze/db/api_test.clj @@ -591,6 +591,27 @@ ::x ::y))))) +(deftest as-of-test + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}]] + [[:put {:fhir/type :fhir/Patient :id "1"}]]] + + (let [db (d/db node)] + + (testing "the newest t is 2" + (is (= 2 (d/basis-t db)))) + + (testing "the effective t of a DB as of 1 if 1" + (is (= 1 (d/t (d/as-of db 1)))))))) + + +(deftest t-test + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}]]] + + (is (= 1 (d/t (d/db node)))))) + + (deftest tx-test (with-system-data [{:blaze.db/keys [node]} config] [[[:put {:fhir/type :fhir/Patient :id "id-142136"}]]] @@ -3137,7 +3158,7 @@ [5 :id] := "id-5"))) (testing "type number" - (testing "decimal" + (testing "Decimal" (with-system-data [{:blaze.db/keys [node]} config] [[[:put {:fhir/type :fhir/RiskAssessment :id "id-0" @@ -3195,7 +3216,7 @@ count := 1 [0 :id] := "id-2"))))) - (testing "integer" + (testing "Integer" (with-system-data [{:blaze.db/keys [node]} config] [[[:put {:fhir/type :fhir/MolecularSequence :id "id-0" @@ -4717,6 +4738,42 @@ [0 :id] := "0"))))) +(deftest patient-compartment-last-change-t-test + (testing "non-existing patient" + (with-system [{:blaze.db/keys [node]} config] + + (testing "just returns nil" + (is (nil? (d/patient-compartment-last-change-t (d/db node) "0")))))) + + (testing "single patient" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}]]] + + (testing "has no resources in its compartment" + (is (nil? (d/patient-compartment-last-change-t (d/db node) "0")))))) + + + (testing "observation created in same transaction as patient" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}] + [:put {:fhir/type :fhir/Observation :id "0" + :subject #fhir/Reference{:reference "Patient/0"}}]]] + + (is (= 1 (d/patient-compartment-last-change-t (d/db node) "0"))))) + + (testing "observation created after the patient" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}]] + [[:put {:fhir/type :fhir/Observation :id "0" + :subject #fhir/Reference{:reference "Patient/0"}}]]] + + (testing "the last change comes from the second transaction" + (is (= 2 (d/patient-compartment-last-change-t (d/db node) "0")))) + + (testing "at t=1 there was no change" + (is (nil? (d/patient-compartment-last-change-t (d/as-of (d/db node) 1) "0"))))))) + + (defmethod ig/init-key ::defective-resource-store [_ {:keys [hashes-to-store]}] (let [store (atom {})] (reify diff --git a/modules/db/test/blaze/db/impl/batch_db_spec.clj b/modules/db/test/blaze/db/impl/batch_db_spec.clj index dfef7c8a6..08100df1c 100644 --- a/modules/db/test/blaze/db/impl/batch_db_spec.clj +++ b/modules/db/test/blaze/db/impl/batch_db_spec.clj @@ -3,6 +3,7 @@ [blaze.byte-string-spec] [blaze.db.impl.batch-db :as batch-db] [blaze.db.impl.index.compartment.resource-spec] + [blaze.db.impl.index.patient-as-of-spec] [blaze.db.impl.index.resource-as-of-spec] [blaze.db.impl.index.system-as-of-spec] [blaze.db.impl.index.type-as-of-spec] diff --git a/modules/db/test/blaze/db/impl/codec_test.clj b/modules/db/test/blaze/db/impl/codec_test.clj index 3d614c489..476f2f094 100644 --- a/modules/db/test/blaze/db/impl/codec_test.clj +++ b/modules/db/test/blaze/db/impl/codec_test.clj @@ -66,7 +66,7 @@ (prop/for-all [i (s/gen int?)] (= i (codec/decode-number (codec/number i)))))) - (testing "long" + (testing "Long" (are [n hex] (= hex (bs/hex (codec/number n))) Long/MIN_VALUE "3F8000000000000000" (inc Long/MIN_VALUE) "3F8000000000000001" @@ -125,7 +125,7 @@ 576460752303423489 "C00800000000000001" Long/MAX_VALUE "C07FFFFFFFFFFFFFFF")) - (testing "integer" + (testing "Integer" (are [n hex] (= hex (bs/hex (codec/number n))) Integer/MIN_VALUE "5F80000000" (int -1) "7F" diff --git a/modules/db/test/blaze/db/impl/db_spec.clj b/modules/db/test/blaze/db/impl/db_spec.clj index 1efc82cd5..a4e5577c3 100644 --- a/modules/db/test/blaze/db/impl/db_spec.clj +++ b/modules/db/test/blaze/db/impl/db_spec.clj @@ -5,6 +5,7 @@ [blaze.db.impl.codec-spec] [blaze.db.impl.db :as db] [blaze.db.impl.index-spec] + [blaze.db.impl.index.patient-as-of-spec] [blaze.db.impl.index.system-stats-spec] [blaze.db.impl.index.type-stats-spec] [blaze.db.impl.search-param-spec] diff --git a/modules/db/test/blaze/db/impl/index/patient_as_of_spec.clj b/modules/db/test/blaze/db/impl/index/patient_as_of_spec.clj new file mode 100644 index 000000000..64c10ffe1 --- /dev/null +++ b/modules/db/test/blaze/db/impl/index/patient_as_of_spec.clj @@ -0,0 +1,26 @@ +(ns blaze.db.impl.index.patient-as-of-spec + (:require + [blaze.db.impl.codec-spec] + [blaze.db.impl.index.patient-as-of :as pao] + [blaze.db.kv-spec] + [blaze.db.tx-log.spec] + [blaze.fhir.hash.spec] + [clojure.spec.alpha :as s])) + + +(s/fdef pao/index-entry + :args (s/cat :patient-id :blaze.db/id-byte-string + :tid :blaze.db/tid + :id :blaze.db/id-byte-string + :t :blaze.db/t + :hash :blaze.resource/hash + :num-changes nat-int? + :op keyword?) + :ret :blaze.db.kv/put-entry-w-cf) + + +(s/fdef pao/last-change-t + :args (s/cat :paoi :blaze.db/kv-iterator + :patient-id :blaze.db/id-byte-string + :t :blaze.db/t) + :ret (s/nilable :blaze.db/t)) diff --git a/modules/db/test/blaze/db/impl/index/patient_as_of_test_util.clj b/modules/db/test/blaze/db/impl/index/patient_as_of_test_util.clj new file mode 100644 index 000000000..cc35f6710 --- /dev/null +++ b/modules/db/test/blaze/db/impl/index/patient_as_of_test_util.clj @@ -0,0 +1,16 @@ +(ns blaze.db.impl.index.patient-as-of-test-util + (:require + [blaze.byte-buffer :as bb] + [blaze.byte-string :as bs] + [blaze.db.impl.codec :as codec])) + + +(set! *unchecked-math* :warn-on-boxed) + + +(defn decode-key [patient-id-len byte-array] + (let [buf (bb/wrap byte-array)] + {:patient-id (codec/id-string (bs/from-byte-buffer! buf patient-id-len)) + :t (codec/descending-long (bb/get-long! buf)) + :type (codec/tid->type (bb/get-int! buf)) + :id (codec/id-string (bs/from-byte-buffer! buf (bb/remaining buf)))})) diff --git a/modules/db/test/blaze/db/impl/index/resource_as_of_test_util.clj b/modules/db/test/blaze/db/impl/index/resource_as_of_test_util.clj index 3afb8681e..cb671bb21 100644 --- a/modules/db/test/blaze/db/impl/index/resource_as_of_test_util.clj +++ b/modules/db/test/blaze/db/impl/index/resource_as_of_test_util.clj @@ -2,9 +2,7 @@ (:require [blaze.byte-buffer :as bb] [blaze.byte-string :as bs] - [blaze.db.impl.codec :as codec] - [blaze.db.impl.index.resource-handle :as rh] - [blaze.fhir.hash :as hash])) + [blaze.db.impl.codec :as codec])) (set! *unchecked-math* :warn-on-boxed) @@ -17,12 +15,3 @@ {:type (codec/tid->type tid) :id (codec/id-string (bs/from-byte-buffer! buf id-size)) :t (codec/descending-long (bb/get-long! buf))})) - - -(defn decode-val [byte-array] - (let [buf (bb/wrap byte-array) - hash (hash/from-byte-buffer! buf) - state (bb/get-long! buf)] - {:hash hash - :num-changes (rh/state->num-changes state) - :op (rh/state->op state)})) diff --git a/modules/db/test/blaze/db/impl/index/rts_as_of_spec.clj b/modules/db/test/blaze/db/impl/index/rts_as_of_spec.clj index 3ec8174a5..867c6e510 100644 --- a/modules/db/test/blaze/db/impl/index/rts_as_of_spec.clj +++ b/modules/db/test/blaze/db/impl/index/rts_as_of_spec.clj @@ -16,4 +16,4 @@ :hash :blaze.resource/hash :num-changes nat-int? :op keyword?) - :ret bytes?) + :ret (s/coll-of :blaze.db.kv/put-entry-w-cf)) diff --git a/modules/db/test/blaze/db/impl/index/rts_as_of_test_util.clj b/modules/db/test/blaze/db/impl/index/rts_as_of_test_util.clj new file mode 100644 index 000000000..907331860 --- /dev/null +++ b/modules/db/test/blaze/db/impl/index/rts_as_of_test_util.clj @@ -0,0 +1,17 @@ +(ns blaze.db.impl.index.rts-as-of-test-util + (:require + [blaze.byte-buffer :as bb] + [blaze.db.impl.index.resource-handle :as rh] + [blaze.fhir.hash :as hash])) + + +(set! *unchecked-math* :warn-on-boxed) + + +(defn decode-val [byte-array] + (let [buf (bb/wrap byte-array) + hash (hash/from-byte-buffer! buf) + state (bb/get-long! buf)] + {:hash hash + :num-changes (rh/state->num-changes state) + :op (rh/state->op state)})) diff --git a/modules/db/test/blaze/db/impl/index/system_as_of_test_util.clj b/modules/db/test/blaze/db/impl/index/system_as_of_test_util.clj index fd8db7ce8..53151b7bf 100644 --- a/modules/db/test/blaze/db/impl/index/system_as_of_test_util.clj +++ b/modules/db/test/blaze/db/impl/index/system_as_of_test_util.clj @@ -2,9 +2,7 @@ (:require [blaze.byte-buffer :as bb] [blaze.byte-string :as bs] - [blaze.db.impl.codec :as codec] - [blaze.db.impl.index.resource-handle :as rh] - [blaze.fhir.hash :as hash])) + [blaze.db.impl.codec :as codec])) (set! *unchecked-math* :warn-on-boxed) @@ -15,12 +13,3 @@ {:t (codec/descending-long (bb/get-long! buf)) :type (codec/tid->type (bb/get-int! buf)) :id (codec/id-string (bs/from-byte-buffer! buf (bb/remaining buf)))})) - - -(defn decode-val [byte-array] - (let [buf (bb/wrap byte-array) - hash (hash/from-byte-buffer! buf) - state (bb/get-long! buf)] - {:hash hash - :num-changes (rh/state->num-changes state) - :op (rh/state->op state)})) diff --git a/modules/db/test/blaze/db/impl/index/type_as_of_test_util.clj b/modules/db/test/blaze/db/impl/index/type_as_of_test_util.clj index bd8e7f89f..c8e6db49f 100644 --- a/modules/db/test/blaze/db/impl/index/type_as_of_test_util.clj +++ b/modules/db/test/blaze/db/impl/index/type_as_of_test_util.clj @@ -2,9 +2,7 @@ (:require [blaze.byte-buffer :as bb] [blaze.byte-string :as bs] - [blaze.db.impl.codec :as codec] - [blaze.db.impl.index.resource-handle :as rh] - [blaze.fhir.hash :as hash])) + [blaze.db.impl.codec :as codec])) (set! *unchecked-math* :warn-on-boxed) @@ -15,12 +13,3 @@ {:type (codec/tid->type (bb/get-int! buf)) :t (codec/descending-long (bb/get-long! buf)) :id (codec/id-string (bs/from-byte-buffer! buf (bb/remaining buf)))})) - - -(defn decode-val [byte-array] - (let [buf (bb/wrap byte-array) - hash (hash/from-byte-buffer! buf) - state (bb/get-long! buf)] - {:hash hash - :num-changes (rh/state->num-changes state) - :op (rh/state->op state)})) diff --git a/modules/db/test/blaze/db/node/patient_as_of_index_spec.clj b/modules/db/test/blaze/db/node/patient_as_of_index_spec.clj new file mode 100644 index 000000000..9b3595a1f --- /dev/null +++ b/modules/db/test/blaze/db/node/patient_as_of_index_spec.clj @@ -0,0 +1,15 @@ +(ns blaze.db.node.patient-as-of-index-spec + (:require + [blaze.db.kv.spec] + [blaze.db.node.patient-as-of-index :as node-pao] + [blaze.db.node.tx-indexer-spec] + [blaze.db.spec] + [blaze.db.tx-log.spec] + [clojure.spec.alpha :as s] + [cognitect.anomalies :as anom])) + + +(s/fdef node-pao/index-entries + :args (s/cat :node :blaze.db/node + :tx-data :blaze.db/tx-data) + :ret (s/or :entries (s/coll-of :blaze.db.kv/put-entry) :anomaly ::anom/anomaly)) diff --git a/modules/db/test/blaze/db/node/patient_as_of_index_test.clj b/modules/db/test/blaze/db/node/patient_as_of_index_test.clj new file mode 100644 index 000000000..c39a8ab67 --- /dev/null +++ b/modules/db/test/blaze/db/node/patient_as_of_index_test.clj @@ -0,0 +1,49 @@ +(ns blaze.db.node.patient-as-of-index-test + (:require + [blaze.db.impl.index.patient-as-of :as pao] + [blaze.db.impl.index.patient-as-of-test-util :as pao-tu] + [blaze.db.impl.index.rts-as-of-test-util :as rts-tu] + [blaze.db.node.patient-as-of-index :as node-pao] + [blaze.db.node.patient-as-of-index-spec] + [blaze.db.test-util :refer [config with-system-data]] + [blaze.fhir.hash :as hash] + [blaze.test-util :as tu] + [clojure.spec.test.alpha :as st] + [clojure.test :as test :refer [deftest]] + [juxt.iota :refer [given]] + [taoensso.timbre :as log]) + (:import + [java.nio.charset StandardCharsets] + [java.time Instant])) + + +(st/instrument) +(log/set-level! :trace) + + +(test/use-fixtures :each tu/fixture) + + +(def patient-0 {:fhir/type :fhir/Patient :id "0"}) +(def observation-0 {:fhir/type :fhir/Observation :id "0" + :subject #fhir/Reference{:reference "Patient/0"}}) +(def hash-observation-0 (hash/generate observation-0)) + + +(deftest patient-as-of-index-entries-test + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]]] + + (given (node-pao/index-entries + node + {:t 2 + :instant Instant/EPOCH + :tx-cmds [{:op "put" :type "Observation" :id "0" + :hash hash-observation-0 :refs [["Patient" "0"]]}]}) + count := 2 + [0 0] := :patient-as-of-index + [0 1 (partial pao-tu/decode-key 1)] := {:patient-id "0" :t 2 :type "Observation" :id "0"} + [0 2 rts-tu/decode-val] := {:hash hash-observation-0 :num-changes 1 :op :put} + + [1 0 #(String. ^bytes % StandardCharsets/ISO_8859_1)] := "patient-as-of-state" + [1 1 pao/decode-state] := {:type :building :t 2}))) diff --git a/modules/db/test/blaze/db/node/tx_indexer/verify_spec.clj b/modules/db/test/blaze/db/node/tx_indexer/verify_spec.clj index 6e1bc81f4..78d026428 100644 --- a/modules/db/test/blaze/db/node/tx_indexer/verify_spec.clj +++ b/modules/db/test/blaze/db/node/tx_indexer/verify_spec.clj @@ -8,6 +8,7 @@ [blaze.db.impl.index.type-stats-spec] [blaze.db.kv.spec] [blaze.db.node.tx-indexer.verify :as verify] + [blaze.db.search-param-registry.spec] [blaze.db.spec] [blaze.db.tx-log.spec] [clojure.spec.alpha :as s] @@ -15,6 +16,9 @@ (s/fdef verify/verify-tx-cmds - :args (s/cat :db-before :blaze.db/db :t :blaze.db/t :cmds :blaze.db/tx-cmds) + :args (s/cat :search-param-registry :blaze.db/search-param-registry + :db-before :blaze.db/db + :t :blaze.db/t + :cmds :blaze.db/tx-cmds) :ret (s/or :entries (s/coll-of :blaze.db.kv/put-entry) :anomaly ::anom/anomaly)) diff --git a/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj b/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj index 2ffc2ef09..4e89e05d7 100644 --- a/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj +++ b/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj @@ -2,7 +2,9 @@ (:require [blaze.db.api :as d] [blaze.db.impl.codec :as codec] + [blaze.db.impl.index.patient-as-of-test-util :as pao-tu] [blaze.db.impl.index.resource-as-of-test-util :as rao-tu] + [blaze.db.impl.index.rts-as-of-test-util :as rts-tu] [blaze.db.impl.index.system-as-of-test-util :as sao-tu] [blaze.db.impl.index.system-stats-test-util :as ss-tu] [blaze.db.impl.index.type-as-of-test-util :as tao-tu] @@ -13,7 +15,7 @@ [blaze.db.node.tx-indexer.verify :as verify] [blaze.db.node.tx-indexer.verify-spec] [blaze.db.search-param-registry] - [blaze.db.test-util :refer [config with-system-data]] + [blaze.db.test-util :refer [config search-param-registry with-system-data]] [blaze.db.tx-cache] [blaze.db.tx-log.local] [blaze.fhir.hash :as hash] @@ -43,30 +45,38 @@ (def patient-1 {:fhir/type :fhir/Patient :id "1"}) (def patient-2 {:fhir/type :fhir/Patient :id "2" :identifier [#fhir/Identifier{:value "120426"}]}) +(def observation-0 {:fhir/type :fhir/Observation :id "0" + :subject #fhir/Reference{:reference "Patient/0"}}) +(def allergy-intolerance-0 {:fhir/type :fhir/AllergyIntolerance :id "0" + :patient #fhir/Reference{:reference "Patient/0"}}) (deftest verify-tx-cmds-test - (testing "adding one patient to an empty store" + (testing "adding one Patient to an empty store" (let [hash (hash/generate patient-0)] (doseq [op [:create :put] if-none-match [nil "*"]] (with-system [{:blaze.db/keys [node]} config] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 1 [(cond-> {:op (name op) :type "Patient" :id "0" :hash hash} if-none-match (assoc :if-none-match if-none-match))]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 1} - [0 2 rao-tu/decode-val] := {:hash hash :num-changes 1 :op op} + [0 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 1 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash :num-changes 1 :op op} + [1 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 1 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash :num-changes 1 :op op} + [2 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 1} @@ -76,28 +86,73 @@ [4 1 ss-tu/decode-key] := {:t 1} [4 2 ss-tu/decode-val] := {:total 1 :num-changes 1}))))) - (testing "adding a second version of a patient to a store containing it already" + (testing "adding one observation to a store containing its Patient already" + (let [hash (hash/generate observation-0)] + (doseq [op [:create :put] + if-none-match [nil "*"]] + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]]] + + (given (verify/verify-tx-cmds + search-param-registry + (d/db node) 2 + [(cond-> {:op (name op) :type "Observation" :id "0" + :hash hash :refs [["Patient" "0"]]} + if-none-match + (assoc :if-none-match if-none-match))]) + + count := 6 + + [0 0] := :resource-as-of-index + [0 1 rao-tu/decode-key] := {:type "Observation" :id "0" :t 2} + [0 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} + + [1 0] := :type-as-of-index + [1 1 tao-tu/decode-key] := {:type "Observation" :t 2 :id "0"} + [1 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} + + [2 0] := :system-as-of-index + [2 1 sao-tu/decode-key] := {:t 2 :type "Observation" :id "0"} + [2 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} + + [3 0] := :patient-as-of-index + [3 1 (partial pao-tu/decode-key 1)] := {:patient-id "0" :t 2 :type "Observation" :id "0"} + [3 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op op} + + [4 0] := :type-stats-index + [4 1 ts-tu/decode-key] := {:type "Observation" :t 2} + [4 2 ts-tu/decode-val] := {:total 1 :num-changes 1} + + [5 0] := :system-stats-index + [5 1 ss-tu/decode-key] := {:t 2} + [5 2 ss-tu/decode-val] := {:total 2 :num-changes 2}))))) + + (testing "adding a second version of a Patient to a store containing it already" (let [hash (hash/generate patient-0-v2)] (doseq [if-match [nil 1 [1] [1 2]]] (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [(cond-> {:op "put" :type "Patient" :id "0" :hash hash} if-match (assoc :if-match if-match))]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 2} - [0 2 rao-tu/decode-val] := {:hash hash :num-changes 2 :op :put} + [0 2 rts-tu/decode-val] := {:hash hash :num-changes 2 :op :put} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 2 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash :num-changes 2 :op :put} + [1 2 rts-tu/decode-val] := {:hash hash :num-changes 2 :op :put} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 2 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash :num-changes 2 :op :put} + [2 2 rts-tu/decode-val] := {:hash hash :num-changes 2 :op :put} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 2} @@ -107,7 +162,7 @@ [4 1 ss-tu/decode-key] := {:t 2} [4 2 ss-tu/decode-val] := {:total 1 :num-changes 2}))))) - (testing "adding a second version of an already deleted patient" + (testing "adding a second version of an already deleted Patient" (let [hash (hash/generate patient-0-v2)] (doseq [if-match [nil 2 [2] [1 2]]] (with-system-data [{:blaze.db/keys [node]} config] @@ -115,21 +170,25 @@ [[:delete "Patient" "0"]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 3 [(cond-> {:op "put" :type "Patient" :id "0" :hash hash} if-match (assoc :if-match if-match))]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 3} - [0 2 rao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + [0 2 rts-tu/decode-val] := {:hash hash :num-changes 3 :op :put} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 3 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + [1 2 rts-tu/decode-val] := {:hash hash :num-changes 3 :op :put} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 3 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + [2 2 rts-tu/decode-val] := {:hash hash :num-changes 3 :op :put} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 3} @@ -139,36 +198,43 @@ [4 1 ss-tu/decode-key] := {:t 3} [4 2 ss-tu/decode-val] := {:total 1 :num-changes 3}))))) - (testing "adding a patient with identical content" + (testing "adding a Patient with identical content" (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]]] (is (empty? (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "put" :type "Patient" :id "0" :hash (hash/generate patient-0)}]))))) - (testing "keeping a non-existing patient fails" + (testing "keeping a non-existing Patient fails" (with-system [{:blaze.db/keys [node]} config] (let [tx-cmd {:op "keep" :type "Patient" :id "0" :hash (hash/generate patient-0)}] - (given (verify/verify-tx-cmds (d/db node) 1 [tx-cmd]) + (given (verify/verify-tx-cmds + search-param-registry + (d/db node) 1 + [tx-cmd]) ::anom/category := ::anom/conflict ::anom/message := "Keep failed on `Patient/0`." :blaze.db/tx-cmd := tx-cmd)))) - (testing "keeping a non-matching patient fails" + (testing "keeping a non-matching Patient fails" (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]] [[:put patient-0-v2]]] (let [tx-cmd {:op "keep" :type "Patient" :id "0" :hash (hash/generate patient-0)}] - (given (verify/verify-tx-cmds (d/db node) 1 [tx-cmd]) + (given (verify/verify-tx-cmds + search-param-registry + (d/db node) 1 + [tx-cmd]) ::anom/category := ::anom/conflict ::anom/message := "Keep failed on `Patient/0`." :blaze.db/tx-cmd := tx-cmd)))) - (testing "keeping a hash matching but non-matching if-match patient fails" + (testing "keeping a hash matching but non-matching if-match Patient fails" (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]] [[:put patient-0-v2]]] @@ -179,6 +245,7 @@ :hash (hash/generate patient-0-v2) :if-match if-match}] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 1 [tx-cmd]) ::anom/category := ::anom/conflict @@ -186,7 +253,7 @@ :http/status := 412 :blaze.db/tx-cmd := tx-cmd)))))) - (testing "keeping a non-matching hash and non-matching if-match patient fails" + (testing "keeping a non-matching hash and non-matching if-match Patient fails" (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]] [[:put patient-0-v2]]] @@ -196,19 +263,23 @@ (let [tx-cmd {:op "keep" :type "Patient" :id "0" :hash (hash/generate patient-0) :if-match if-match}] - (given (verify/verify-tx-cmds (d/db node) 1 [tx-cmd]) + (given (verify/verify-tx-cmds + search-param-registry + (d/db node) 1 + [tx-cmd]) ::anom/category := ::anom/conflict ::anom/message := "Precondition `W/\"3\"` failed on `Patient/0`." :http/status := 412 :blaze.db/tx-cmd := tx-cmd)))))) - (testing "keeping a matching patient" + (testing "keeping a matching Patient" (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]]] (testing "with different if-matches" (doseq [if-match [nil 1 [1] [1 2]]] (is (empty? (verify/verify-tx-cmds + search-param-registry (d/db node) 1 [(cond-> {:op "keep" :type "Patient" :id "0" @@ -216,22 +287,26 @@ if-match (assoc :if-match if-match))]))))))) - (testing "deleting a patient from an empty store" + (testing "deleting a Patient from an empty store" (with-system [{:blaze.db/keys [node]} config] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 1 [{:op "delete" :type "Patient" :id "0"}]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 1} - [0 2 rao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 1 :op :delete} + [0 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 1 :op :delete} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 1 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 1 :op :delete} + [1 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 1 :op :delete} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 1 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 1 :op :delete} + [2 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 1 :op :delete} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 1} @@ -241,24 +316,28 @@ [4 1 ss-tu/decode-key] := {:t 1} [4 2 ss-tu/decode-val] := {:total 0 :num-changes 1}))) - (testing "deleting an already deleted patient" + (testing "deleting an already deleted Patient" (with-system-data [{:blaze.db/keys [node]} config] [[[:delete "Patient" "0"]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "delete" :type "Patient" :id "0"}]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 2} - [0 2 rao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + [0 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 2 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + [1 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 2 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + [2 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 2} @@ -268,24 +347,28 @@ [4 1 ss-tu/decode-key] := {:t 2} [4 2 ss-tu/decode-val] := {:total 0 :num-changes 2}))) - (testing "deleting an existing patient" + (testing "deleting an existing Patient" (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "delete" :type "Patient" :id "0"}]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 2} - [0 2 rao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + [0 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 2 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + [1 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 2 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + [2 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 2} @@ -295,25 +378,101 @@ [4 1 ss-tu/decode-key] := {:t 2} [4 2 ss-tu/decode-val] := {:total 0 :num-changes 2}))) - (testing "adding a second patient to a store containing already one" + (testing "deleting an existing Observation" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0] + [:put observation-0]]] + + (given (verify/verify-tx-cmds + search-param-registry + (d/db node) 2 + [{:op "delete" :type "Observation" :id "0"}]) + + count := 6 + + [0 0] := :resource-as-of-index + [0 1 rao-tu/decode-key] := {:type "Observation" :id "0" :t 2} + [0 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [1 0] := :type-as-of-index + [1 1 tao-tu/decode-key] := {:type "Observation" :t 2 :id "0"} + [1 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [2 0] := :system-as-of-index + [2 1 sao-tu/decode-key] := {:t 2 :type "Observation" :id "0"} + [2 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [3 0] := :patient-as-of-index + [3 1 (partial pao-tu/decode-key 1)] := {:patient-id "0" :t 2 :type "Observation" :id "0"} + [3 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [4 0] := :type-stats-index + [4 1 ts-tu/decode-key] := {:type "Observation" :t 2} + [4 2 ts-tu/decode-val] := {:total 0 :num-changes 2} + + [5 0] := :system-stats-index + [5 1 ss-tu/decode-key] := {:t 2} + [5 2 ss-tu/decode-val] := {:total 1 :num-changes 3}))) + + (testing "deleting an existing AllergyIntolerance" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0] + [:put allergy-intolerance-0]]] + + (given (verify/verify-tx-cmds + search-param-registry + (d/db node) 2 + [{:op "delete" :type "AllergyIntolerance" :id "0"}]) + + count := 6 + + [0 0] := :resource-as-of-index + [0 1 rao-tu/decode-key] := {:type "AllergyIntolerance" :id "0" :t 2} + [0 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [1 0] := :type-as-of-index + [1 1 tao-tu/decode-key] := {:type "AllergyIntolerance" :t 2 :id "0"} + [1 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [2 0] := :system-as-of-index + [2 1 sao-tu/decode-key] := {:t 2 :type "AllergyIntolerance" :id "0"} + [2 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [3 0] := :patient-as-of-index + [3 1 (partial pao-tu/decode-key 1)] := {:patient-id "0" :t 2 :type "AllergyIntolerance" :id "0"} + [3 2 rts-tu/decode-val] := {:hash hash/deleted-hash :num-changes 2 :op :delete} + + [4 0] := :type-stats-index + [4 1 ts-tu/decode-key] := {:type "AllergyIntolerance" :t 2} + [4 2 ts-tu/decode-val] := {:total 0 :num-changes 2} + + [5 0] := :system-stats-index + [5 1 ss-tu/decode-key] := {:t 2} + [5 2 ss-tu/decode-val] := {:total 1 :num-changes 3}))) + + (testing "adding a second Patient to a store containing already one" (let [hash (hash/generate patient-1)] (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "put" :type "Patient" :id "1" :hash hash}]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "1" :t 2} - [0 2 rao-tu/decode-val] := {:hash hash :num-changes 1 :op :put} + [0 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op :put} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 2 :id "1"} - [1 2 tao-tu/decode-val] := {:hash hash :num-changes 1 :op :put} + [1 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op :put} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 2 :type "Patient" :id "1"} - [2 2 sao-tu/decode-val] := {:hash hash :num-changes 1 :op :put} + [2 2 rts-tu/decode-val] := {:hash hash :num-changes 1 :op :put} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 2} @@ -329,6 +488,7 @@ [[[:put patient-0]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "put" :type "Patient" :id "0" :hash (hash/generate patient-0) @@ -342,6 +502,7 @@ [[[:put patient-0]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "put" :type "Patient" :id "0" :hash (hash/generate patient-0) @@ -355,6 +516,7 @@ [[[:put patient-0]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "put" :type "Patient" :id "0" :hash (hash/generate patient-0) @@ -372,6 +534,7 @@ :birthDate #fhir/date"2020"}]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "create" :type "Patient" :id "foo" :hash (hash/generate patient-0) @@ -387,6 +550,7 @@ (is (empty? (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "create" :type "Patient" :id "0" :hash (hash/generate patient-0) @@ -398,6 +562,7 @@ (given (verify/verify-tx-cmds + search-param-registry (d/db node) 2 [{:op "delete" :type "Patient" :id "2"} {:op "create" :type "Patient" :id "0" @@ -413,19 +578,23 @@ [[:delete "Patient" "0"]]] (given (verify/verify-tx-cmds + search-param-registry (d/db node) 3 [{:op "put" :type "Patient" :id "0" :hash hash}]) + + count := 5 + [0 0] := :resource-as-of-index [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 3} - [0 2 rao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + [0 2 rts-tu/decode-val] := {:hash hash :num-changes 3 :op :put} [1 0] := :type-as-of-index [1 1 tao-tu/decode-key] := {:type "Patient" :t 3 :id "0"} - [1 2 tao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + [1 2 rts-tu/decode-val] := {:hash hash :num-changes 3 :op :put} [2 0] := :system-as-of-index [2 1 sao-tu/decode-key] := {:t 3 :type "Patient" :id "0"} - [2 2 sao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + [2 2 rts-tu/decode-val] := {:hash hash :num-changes 3 :op :put} [3 0] := :type-stats-index [3 1 ts-tu/decode-key] := {:type "Patient" :t 3} diff --git a/modules/db/test/blaze/db/node/tx_indexer_spec.clj b/modules/db/test/blaze/db/node/tx_indexer_spec.clj index 923a95260..f68083076 100644 --- a/modules/db/test/blaze/db/node/tx_indexer_spec.clj +++ b/modules/db/test/blaze/db/node/tx_indexer_spec.clj @@ -3,6 +3,7 @@ [blaze.db.kv.spec] [blaze.db.node.tx-indexer :as tx-indexer] [blaze.db.node.tx-indexer.verify-spec] + [blaze.db.search-param-registry.spec] [blaze.db.spec] [blaze.db.tx-log.spec] [clojure.spec.alpha :as s] @@ -10,5 +11,7 @@ (s/fdef tx-indexer/index-tx - :args (s/cat :db-before :blaze.db/db :tx-data :blaze.db/tx-data) + :args (s/cat :search-param-registry :blaze.db/search-param-registry + :db-before :blaze.db/db + :tx-data :blaze.db/tx-data) :ret (s/or :entries (s/coll-of :blaze.db.kv/put-entry) :anomaly ::anom/anomaly)) diff --git a/modules/db/test/blaze/db/node_test.clj b/modules/db/test/blaze/db/node_test.clj index 0ff5da515..58a98e6fa 100644 --- a/modules/db/test/blaze/db/node_test.clj +++ b/modules/db/test/blaze/db/node_test.clj @@ -11,6 +11,7 @@ [blaze.db.kv.mem-spec] [blaze.db.node :as node] [blaze.db.node-spec] + [blaze.db.node.patient-as-of-index-spec] [blaze.db.node.resource-indexer :as resource-indexer] [blaze.db.node.tx-indexer :as-alias tx-indexer] [blaze.db.node.version :as version] diff --git a/modules/db/test/blaze/db/resource_cache_test.clj b/modules/db/test/blaze/db/resource_cache_test.clj index 821e9da6e..08a868aab 100644 --- a/modules/db/test/blaze/db/resource_cache_test.clj +++ b/modules/db/test/blaze/db/resource_cache_test.clj @@ -1,6 +1,6 @@ (ns blaze.db.resource-cache-test (:require - [blaze.db.cache-collector.protocols :as ccp] + [blaze.cache-collector.protocols :as ccp] [blaze.db.kv :as kv] [blaze.db.kv.mem] [blaze.db.resource-cache :as resource-cache] diff --git a/modules/db/test/blaze/db/search_param_registry_test.clj b/modules/db/test/blaze/db/search_param_registry_test.clj index 59dfa68b6..fb8bc8031 100644 --- a/modules/db/test/blaze/db/search_param_registry_test.clj +++ b/modules/db/test/blaze/db/search_param_registry_test.clj @@ -194,12 +194,17 @@ (deftest compartment-resources-test (testing "Patient" (with-system [{:blaze.db/keys [search-param-registry]} config] - (given (sr/compartment-resources search-param-registry "Patient") - count := 100 - [0] := ["Account" "subject"] - [1] := ["AdverseEvent" "subject"] - [2] := ["AllergyIntolerance" "patient"] - [3] := ["AllergyIntolerance" "recorder"] - [4] := ["AllergyIntolerance" "asserter"] - [5] := ["Appointment" "actor"] - [99] := ["VisionPrescription" "patient"])))) + (testing "all resource types" + (given (sr/compartment-resources search-param-registry "Patient") + count := 100 + [0] := ["Account" "subject"] + [1] := ["AdverseEvent" "subject"] + [2] := ["AllergyIntolerance" "patient"] + [3] := ["AllergyIntolerance" "recorder"] + [4] := ["AllergyIntolerance" "asserter"] + [5] := ["Appointment" "actor"] + [99] := ["VisionPrescription" "patient"])) + + (testing "only Observation codes" + (is (= (sr/compartment-resources search-param-registry "Patient" "Observation") + ["subject" "performer"])))))) diff --git a/modules/db/test/blaze/db/test_util.clj b/modules/db/test/blaze/db/test_util.clj index ea7ca5516..38f383087 100644 --- a/modules/db/test/blaze/db/test_util.clj +++ b/modules/db/test/blaze/db/test_util.clj @@ -30,6 +30,7 @@ :kv-store (ig/ref :blaze.db/index-kv-store) :resource-indexer (ig/ref :blaze.db.node/resource-indexer) :search-param-registry search-param-registry + :scheduler (ig/ref :blaze/scheduler) :poll-timeout (time/millis 10)} ::tx-log/local @@ -60,6 +61,7 @@ :resource-as-of-index nil :type-as-of-index nil :system-as-of-index nil + :patient-as-of-index nil :type-stats-index nil :system-stats-index nil}} @@ -78,7 +80,9 @@ :search-param-registry search-param-registry :executor (ig/ref :blaze.db.node.resource-indexer/executor)} - :blaze.db.node.resource-indexer/executor {}}) + :blaze.db.node.resource-indexer/executor {} + + :blaze/scheduler {}}) (defmacro with-system-data diff --git a/modules/executor/src/blaze/executors.clj b/modules/executor/src/blaze/executors.clj index f8c4695f9..63c943834 100644 --- a/modules/executor/src/blaze/executors.clj +++ b/modules/executor/src/blaze/executors.clj @@ -50,6 +50,12 @@ (format name-template (swap! thread-counter inc))) +(defn- thread-factory [counter name-template] + (reify ThreadFactory + (newThread [_ r] + (Thread. ^Runnable r ^String (thread-name! counter name-template))))) + + (defn cpu-bound-pool "Returns a thread pool with a fixed number of threads which is the number of available processors." @@ -57,10 +63,7 @@ (let [thread-counter (atom 0)] (Executors/newFixedThreadPool (.availableProcessors (Runtime/getRuntime)) - (reify ThreadFactory - (newThread [_ r] - (Thread. ^Runnable r ^String (thread-name! thread-counter - name-template))))))) + (thread-factory thread-counter name-template)))) (defn io-pool @@ -70,10 +73,14 @@ (let [thread-counter (atom 0)] (Executors/newFixedThreadPool n - (reify ThreadFactory - (newThread [_ r] - (Thread. ^Runnable r ^String (thread-name! thread-counter - name-template))))))) + (thread-factory thread-counter name-template)))) + + +(defn scheduled-pool [n name-template] + (let [thread-counter (atom 0)] + (Executors/newScheduledThreadPool + n + (thread-factory thread-counter name-template)))) (defn single-thread-executor diff --git a/modules/fhir-client/.clj-kondo/config.edn b/modules/fhir-client/.clj-kondo/config.edn index 935e82c01..d7758a294 100644 --- a/modules/fhir-client/.clj-kondo/config.edn +++ b/modules/fhir-client/.clj-kondo/config.edn @@ -15,6 +15,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/fhir-path/.clj-kondo/config.edn b/modules/fhir-path/.clj-kondo/config.edn index e3b746ad7..97e80c930 100644 --- a/modules/fhir-path/.clj-kondo/config.edn +++ b/modules/fhir-path/.clj-kondo/config.edn @@ -12,6 +12,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/fhir-structure/.clj-kondo/config.edn b/modules/fhir-structure/.clj-kondo/config.edn index 20bcca667..d4b4796be 100644 --- a/modules/fhir-structure/.clj-kondo/config.edn +++ b/modules/fhir-structure/.clj-kondo/config.edn @@ -30,6 +30,10 @@ {:level :warning :warn-only-on-interop true} :unused-private-var - {:exclude [blaze.fhir.spec.type/at-utc]}} + {:exclude [blaze.fhir.spec.type/at-utc]} + + :consistent-alias + {:aliases + {cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/fhir-structure/test/blaze/fhir/spec/impl_test.clj b/modules/fhir-structure/test/blaze/fhir/spec/impl_test.clj index 0b7bdcc1b..5502a8529 100644 --- a/modules/fhir-structure/test/blaze/fhir/spec/impl_test.clj +++ b/modules/fhir-structure/test/blaze/fhir/spec/impl_test.clj @@ -45,7 +45,7 @@ (deftest primitive-type->spec-defs-test - (testing "boolean" + (testing "Boolean" (is (= (-> (primitive-type "boolean") impl/primitive-type->spec-defs regexes->str) @@ -64,7 +64,7 @@ {:key :fhir.cbor/boolean :spec-form `(specs/cbor-primitive type/boolean)}]))) - (testing "integer" + (testing "Integer" (is (= (-> (primitive-type "integer") impl/primitive-type->spec-defs regexes->str) @@ -102,7 +102,7 @@ {:key :fhir.cbor/string :spec-form `(specs/cbor-primitive type/string)}]))) - (testing "decimal" + (testing "Decimal" (is (= (-> (primitive-type "decimal") impl/primitive-type->spec-defs regexes->str) diff --git a/modules/fhir-structure/test/blaze/fhir/spec/type_test.clj b/modules/fhir-structure/test/blaze/fhir/spec/type_test.clj index b0f91564b..759bf8304 100644 --- a/modules/fhir-structure/test/blaze/fhir/spec/type_test.clj +++ b/modules/fhir-structure/test/blaze/fhir/spec/type_test.clj @@ -122,7 +122,7 @@ #fhir/boolean true #fhir/boolean{:id "foo"})) - (testing "boolean" + (testing "Boolean" (is (= #fhir/boolean{:value true} #fhir/boolean true))) (testing "interned" @@ -197,7 +197,7 @@ #fhir/integer 1 #fhir/integer{:id "foo"})) - (testing "integer" + (testing "Integer" (is (= #fhir/integer{:value 1} #fhir/integer 1))) (testing "interned" @@ -253,7 +253,7 @@ #fhir/long 1 #fhir/long{:id "foo"})) - (testing "long" + (testing "Long" (is (= #fhir/long{:value 1} #fhir/long 1))) (testing "interned" @@ -372,7 +372,7 @@ #fhir/decimal 1M #fhir/decimal{:id "foo"})) - (testing "decimal" + (testing "Decimal" (is (= #fhir/decimal{:value 1M} #fhir/decimal 1M))) (testing "interned" diff --git a/modules/interaction/.clj-kondo/config.edn b/modules/interaction/.clj-kondo/config.edn index 9a4eec37d..ce581c460 100644 --- a/modules/interaction/.clj-kondo/config.edn +++ b/modules/interaction/.clj-kondo/config.edn @@ -39,6 +39,7 @@ blaze.db.kv kv blaze.test-util tu blaze.util u + cognitect.anomalies anom cuerdas.core c-str ring.util.response ring}}} diff --git a/modules/interaction/src/blaze/interaction/history/util.clj b/modules/interaction/src/blaze/interaction/history/util.clj index e6d7faf74..cf78e8c6a 100644 --- a/modules/interaction/src/blaze/interaction/history/util.clj +++ b/modules/interaction/src/blaze/interaction/history/util.clj @@ -1,8 +1,8 @@ (ns blaze.interaction.history.util (:require + [blaze.db.api :as d] [blaze.fhir.spec.type :as type] [blaze.handler.fhir.util :as fhir-util] - [blaze.interaction.util :as iu] [blaze.util :as u] [reitit.core :as reitit]) (:import @@ -48,7 +48,7 @@ [{:blaze/keys [base-url db] ::reitit/keys [match]} query-params page-t & more] (let [path (reitit/match->path match - (cond-> (assoc query-params "__t" (iu/t db) "__page-t" page-t) + (cond-> (assoc query-params "__t" (d/t db) "__page-t" page-t) (= 1 (count more)) (assoc "__page-id" (first more)) (= 2 (count more)) diff --git a/modules/interaction/src/blaze/interaction/search_compartment.clj b/modules/interaction/src/blaze/interaction/search_compartment.clj index 21e18677d..45bd3b07e 100644 --- a/modules/interaction/src/blaze/interaction/search_compartment.clj +++ b/modules/interaction/src/blaze/interaction/search_compartment.clj @@ -54,7 +54,7 @@ {:keys [page-offset] :as params} :params} clauses] {:fhir/type :fhir.Bundle/link :relation "self" - :url (nav/url base-url match params clauses (iu/t db) + :url (nav/url base-url match params clauses (d/t db) {"__page-offset" page-offset})}) @@ -65,7 +65,7 @@ (defn- next-link [{:keys [page-store match params] :blaze/keys [base-url db]} clauses entries] (do-sync [url (nav/token-url! page-store base-url match params clauses - (iu/t db) (next-link-offset params entries))] + (d/t db) (next-link-offset params entries))] {:fhir/type :fhir.Bundle/link :relation "next" :url url})) diff --git a/modules/interaction/src/blaze/interaction/search_system.clj b/modules/interaction/src/blaze/interaction/search_system.clj index 8214793f0..608713e0c 100644 --- a/modules/interaction/src/blaze/interaction/search_system.clj +++ b/modules/interaction/src/blaze/interaction/search_system.clj @@ -50,7 +50,7 @@ (defn- self-link [{:keys [match params] :blaze/keys [base-url db]} entries] {:fhir/type :fhir.Bundle/link :relation "self" - :url (nav/url base-url match params [] (iu/t db) (self-link-offset entries))}) + :url (nav/url base-url match params [] (d/t db) (self-link-offset entries))}) (defn- next-link-offset [entries] @@ -61,7 +61,7 @@ (defn- next-link [{:keys [page-store page-match params] :blaze/keys [base-url db]} entries] (do-sync [url (nav/token-url! page-store base-url page-match params [] - (iu/t db) (next-link-offset entries))] + (d/t db) (next-link-offset entries))] {:fhir/type :fhir.Bundle/link :relation "next" :url url})) diff --git a/modules/interaction/src/blaze/interaction/search_type.clj b/modules/interaction/src/blaze/interaction/search_type.clj index 495798e4c..728802a2e 100644 --- a/modules/interaction/src/blaze/interaction/search_type.clj +++ b/modules/interaction/src/blaze/interaction/search_type.clj @@ -267,7 +267,7 @@ (defn- self-link-url-fn [{:blaze/keys [base-url db] :as request} params] (fn [clauses offset] - (nav/url base-url (match request "type") params clauses (iu/t db) offset))) + (nav/url base-url (match request "type") params clauses (d/t db) offset))) (defn- gen-token-fn @@ -287,7 +287,7 @@ [{:blaze/keys [base-url db] :as request} params] (fn [token clauses] (nav/token-url base-url (match request "page") params token clauses - (iu/t db) nil))) + (d/t db) nil))) (defn- next-link-url-fn @@ -296,7 +296,7 @@ [{:blaze/keys [base-url db] :as request} params] (fn [token clauses offset] (nav/token-url base-url (match request "page") params token clauses - (iu/t db) offset))) + (d/t db) offset))) (defn- search-context diff --git a/modules/interaction/src/blaze/interaction/util.clj b/modules/interaction/src/blaze/interaction/util.clj index 2413cd7f3..e8cbe0d15 100644 --- a/modules/interaction/src/blaze/interaction/util.clj +++ b/modules/interaction/src/blaze/interaction/util.clj @@ -61,12 +61,6 @@ (luid/successive-luids clock (rng-fn))) -(defn t - "Returns the effective `t` of `db`." - [db] - (or (d/as-of-t db) (d/basis-t db))) - - (defn- prep-if-none-match [if-none-match] (if (= "*" if-none-match) :any diff --git a/modules/interaction/test/blaze/interaction/util_spec.clj b/modules/interaction/test/blaze/interaction/util_spec.clj index 6489ed7a8..16875bab8 100644 --- a/modules/interaction/test/blaze/interaction/util_spec.clj +++ b/modules/interaction/test/blaze/interaction/util_spec.clj @@ -23,11 +23,6 @@ :ret :blaze.db.query/search-clauses) -(s/fdef iu/t - :args (s/cat :db :blaze.db/db) - :ret :blaze.db/t) - - (s/fdef iu/update-tx-op :args (s/cat :db :blaze.db/db :resource :blaze/resource :if-match (s/nilable string?) diff --git a/modules/openid-auth/.clj-kondo/config.edn b/modules/openid-auth/.clj-kondo/config.edn index a25d19101..e2271fd78 100644 --- a/modules/openid-auth/.clj-kondo/config.edn +++ b/modules/openid-auth/.clj-kondo/config.edn @@ -15,6 +15,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {blaze.scheduler sched}}} :skip-comments true} diff --git a/modules/operation-graphql/.clj-kondo/config.edn b/modules/operation-graphql/.clj-kondo/config.edn index 77aae4ea6..67cf86049 100644 --- a/modules/operation-graphql/.clj-kondo/config.edn +++ b/modules/operation-graphql/.clj-kondo/config.edn @@ -22,6 +22,7 @@ :consistent-alias {:aliases {blaze.db.api d + cognitect.anomalies anom ring.util.response ring}}} :skip-comments true} diff --git a/modules/operation-measure-evaluate-measure/.clj-kondo/config.edn b/modules/operation-measure-evaluate-measure/.clj-kondo/config.edn index fc1e27936..2acbb21c8 100644 --- a/modules/operation-measure-evaluate-measure/.clj-kondo/config.edn +++ b/modules/operation-measure-evaluate-measure/.clj-kondo/config.edn @@ -28,6 +28,7 @@ {blaze.db.api d blaze.elm.compiler.external-data ed blaze.elm.expression expr + cognitect.anomalies anom ring.util.response ring}}} :skip-comments true} diff --git a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj index f10a60281..eac484a58 100644 --- a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj +++ b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj @@ -5,6 +5,8 @@ [blaze.async.comp :as ac] [blaze.coll.core :as coll] [blaze.db.api :as d] + [blaze.elm.expression :as-alias expr] + [blaze.elm.expression.spec] [blaze.executors :as ex] [blaze.fhir.operation.evaluate-measure.measure :as measure] [blaze.fhir.operation.evaluate-measure.measure.spec] @@ -24,6 +26,7 @@ [ring.util.response :as ring] [taoensso.timbre :as log]) (:import + [com.github.benmanes.caffeine.cache Caffeine] [java.util.concurrent TimeUnit])) @@ -129,7 +132,8 @@ (defmethod ig/pre-init-spec ::handler [_] - (s/keys :req-un [:blaze.db/node ::executor :blaze/clock :blaze/rng-fn] + (s/keys :req [::expr/cache] + :req-un [:blaze.db/node ::executor :blaze/clock :blaze/rng-fn] :opt-un [::timeout])) @@ -138,6 +142,19 @@ (wrap-coerce-params (handler context))) +(defmethod ig/pre-init-spec ::expr-cache [_] + (s/keys :opt-un [::max-size])) + + +(defmethod ig/init-key ::expr-cache + [_ {:keys [max-size] :or {max-size 0}}] + (log/info "Create CQL expression cache with a size of" max-size "expressions") + (-> (Caffeine/newBuilder) + (.maximumSize max-size) + (.recordStats) + (.build))) + + (defmethod ig/pre-init-spec ::timeout [_] (s/keys :req-un [:blaze.fhir.operation.evaluate-measure.timeout/millis])) diff --git a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj index d936cd8e0..2030bbc84 100644 --- a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj +++ b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/cql.clj @@ -41,9 +41,9 @@ (ex-message e))) -(defn- evaluate-expression-1* [context subject-handle name expression] +(defn- evaluate-expression-1* [context subject name expression] (try - (expr/eval context expression subject-handle) + (expr/eval context expression subject) (catch Exception e (let [ex-data (ex-data e)] ;; only log if the exception hasn't ex-data because exception with @@ -68,12 +68,12 @@ (defn- evaluate-expression-1 - [{:keys [timeout-eclipsed?] :as context} subject-handle name expression] + [{:keys [timeout-eclipsed?] :as context} subject name expression] (if (timeout-eclipsed?) {::anom/category ::anom/interrupted ::anom/message (timeout-eclipsed-msg context) :timeout (:timeout context)} - (evaluate-expression-1* context subject-handle name expression))) + (evaluate-expression-1* context subject name expression))) (defn- close-batch-db! [{:keys [db]}] @@ -141,43 +141,47 @@ (expression-combine-sum-op context))) -(defn- handle [subject-handle] - {:population-handle subject-handle :subject-handle subject-handle}) +(defn- handle [subject] + {:population-handle subject :subject-handle subject}) -(defn- conj-all! [handles subject-handle population-handles] +(defn- conj-all! [resources subject population-resources] (reduce - (fn [handles population-handle] - (conj! handles {:population-handle population-handle - :subject-handle subject-handle})) - handles - population-handles)) + (fn [resources population-resource] + (conj! resources {:population-handle population-resource + :subject-handle subject})) + resources + population-resources)) (defn- expression-reduce-subject-based-conj-op [{:keys [name expression]}] - (fn [context subject-handle] - (if-ok [res (evaluate-expression-1 context subject-handle name expression)] - (cond-> context res (update ::result conj! (handle subject-handle))) - #(reduced (assoc context ::result %))))) + (fn [{:keys [db] :as context} subject-handle] + (let [subject (ed/mk-resource db subject-handle)] + (if-ok [res (evaluate-expression-1 context subject name expression)] + (cond-> context res (update ::result conj! (handle subject))) + #(reduced (assoc context ::result %)))))) (defn- expression-reduce-conj-op [{:keys [name expression]}] - (fn [context subject-handle] - (if-ok [res (evaluate-expression-1 context subject-handle name expression)] - (update context ::result conj-all! subject-handle res) - #(reduced (assoc context ::result %))))) + (fn [{:keys [db] :as context} subject-handle] + (let [subject (ed/mk-resource db subject-handle)] + (if-ok [res (evaluate-expression-1 context subject name expression)] + (update context ::result conj-all! subject res) + #(reduced (assoc context ::result %)))))) (defn- expression-reduce-subject-based-sum-op [{:keys [name expression]}] - (fn [context subject-handle] - (if-ok [res (evaluate-expression-1 context subject-handle name expression)] + (fn [{:keys [db] :as context} subject-handle] + (if-ok [res (evaluate-expression-1 context (ed/mk-resource db subject-handle) + name expression)] (cond-> context res (update ::result inc)) #(reduced (assoc context ::result %))))) (defn- expression-reduce-sum-op [{:keys [name expression]}] - (fn [context subject-handle] - (if-ok [res (evaluate-expression-1 context subject-handle name expression)] + (fn [{:keys [db] :as context} subject-handle] + (if-ok [res (evaluate-expression-1 context (ed/mk-resource db subject-handle) + name expression)] (update context ::result + (count res)) #(reduced (assoc context ::result %))))) @@ -209,7 +213,6 @@ [{:keys [db] :as context} expression-def subject-type population-basis] (transduce (comp - (ed/resource-mapper db) (partition-all eval-parallel-chunk-size) (map #(evaluate-expression** context expression-def % population-basis))) (expression-combine-op context) @@ -296,13 +299,12 @@ (defn evaluate-individual-expression - "Evaluates the expression with `name` on `subject-handle` according to - `context`. + "Evaluates the expression with `name` on `subject` according to `context`. Returns an anomaly in case of errors." - [context subject-handle name] + [context subject name] (when-ok [{:keys [name expression]} (expression-def context name)] - (evaluate-expression-1 context subject-handle name expression))) + (evaluate-expression-1 context subject name expression))) (defn- stratum-result-reduce-op [result stratum subject-handle] diff --git a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/spec.clj b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/spec.clj index d8f3c7a3f..09e536443 100644 --- a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/spec.clj +++ b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure/spec.clj @@ -14,6 +14,10 @@ pos-int?) +(s/def ::measure/max-size + nat-int?) + + (s/def ::measure/timeout time/duration?) diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql/spec.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql/spec.clj index 8f7561a60..3a459c190 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql/spec.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql/spec.clj @@ -1,15 +1,12 @@ (ns blaze.fhir.operation.evaluate-measure.cql.spec (:require [blaze.elm.compiler :as-alias compiler] + [blaze.elm.expression :as-alias expr] [blaze.fhir.operation.evaluate-measure.cql :as-alias cql] [clojure.spec.alpha :as s] [java-time.api :as time])) -(s/def ::cql/now - time/offset-date-time?) - - (s/def ::cql/timeout-eclipsed? ifn?) @@ -19,8 +16,10 @@ (s/def ::cql/context - (s/keys :req-un [:blaze.db/db ::cql/now ::cql/timeout-eclipsed? ::cql/timeout - ::compiler/expression-defs])) + (s/merge + ::expr/context + (s/keys :req-un [::cql/timeout-eclipsed? ::cql/timeout + ::compiler/expression-defs]))) (s/def ::cql/return-handles? @@ -31,9 +30,5 @@ (s/merge ::cql/context (s/keys :opt-un [::cql/return-handles?]))) -(s/def ::cql/parameters - (s/map-of string? any?)) - - (s/def ::cql/evaluate-individual-expression-context - (s/merge ::cql/context (s/keys :opt-un [::cql/parameters]))) + ::cql/context) diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_spec.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_spec.clj index 7ec8ddaaa..6ea9e2fed 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_spec.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_spec.clj @@ -25,7 +25,7 @@ (s/fdef cql/evaluate-individual-expression :args (s/cat :context ::cql/evaluate-individual-expression-context - :subject-handle ed/resource? + :subject ed/resource? :name string?) :ret (s/or :value any? :anomaly ::anom/anomaly)) diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_test.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_test.clj index ab863a052..674590ba5 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_test.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/cql_test.clj @@ -21,6 +21,7 @@ [juxt.iota :refer [given]] [taoensso.timbre :as log]) (:import + [com.github.benmanes.caffeine.cache Caffeine] [java.time Clock OffsetDateTime])) @@ -104,6 +105,7 @@ (let [{:keys [expression-defs function-defs]} (compile-library node library)] {:db (d/db node) :now (now fixed-clock) + ::expr/cache (.build (Caffeine/newBuilder)) :timeout-eclipsed? (constantly false) :timeout (time/seconds 42) :expression-defs expression-defs @@ -185,7 +187,7 @@ :expression-context := "Patient"))))) (testing "population basis doesn't match the expression return type" - (testing "boolean" + (testing "Boolean" (with-system [system mem-node-config] (let [context (context system library-encounter)] (doseq [return-handles? [true false] diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/population/spec.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/population/spec.clj index 4ad815d9a..8c749ed31 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/population/spec.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/population/spec.clj @@ -18,5 +18,6 @@ (s/def ::population/context - (s/merge ::cql/context - (s/keys :req-un [(or ::population/subject-type ::population/subject-handle)]))) + (s/merge + ::cql/context + (s/keys :req-un [(or ::population/subject-type ::population/subject-handle)]))) diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/stratifier_test.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/stratifier_test.clj index bedf1dc60..c56e67f2a 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/stratifier_test.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure/stratifier_test.clj @@ -6,6 +6,7 @@ [blaze.db.api :as d] [blaze.db.api-stub :refer [mem-node-config with-system-data]] [blaze.elm.compiler.library :as library] + [blaze.elm.expression :as-alias expr] [blaze.fhir.operation.evaluate-measure.measure.stratifier :as stratifier] [blaze.fhir.operation.evaluate-measure.measure.stratifier-spec] [blaze.fhir.operation.evaluate-measure.test-util :as em-tu] @@ -17,6 +18,7 @@ [java-time.api :as time] [juxt.iota :refer [given]]) (:import + [com.github.benmanes.caffeine.cache Caffeine] [java.time Clock OffsetDateTime])) @@ -175,6 +177,7 @@ (defn- context [{:blaze.db/keys [node] :blaze.test/keys [fixed-clock]} library] (let [{:keys [expression-defs function-defs]} (compile-library node library)] {:db (d/db node) + ::expr/cache (.build (Caffeine/newBuilder)) :now (now fixed-clock) :timeout-eclipsed? (constantly false) :timeout (time/seconds 42) diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_spec.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_spec.clj index f048a0485..84f45d6cd 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_spec.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_spec.clj @@ -2,6 +2,8 @@ (:require [blaze.cql-translator-spec] [blaze.db.spec] + [blaze.elm.expression :as-alias expr] + [blaze.elm.expression.spec] [blaze.fhir.operation.evaluate-measure.cql-spec] [blaze.fhir.operation.evaluate-measure.measure :as measure] [blaze.fhir.operation.evaluate-measure.measure.spec] @@ -15,6 +17,11 @@ [java.time.temporal Temporal])) +(s/def ::context + (s/keys :req [:blaze/base-url ::reitit/router ::expr/cache] + :req-un [:blaze/clock :blaze/rng-fn :blaze.db/db])) + + (defn- temporal? [x] (instance? Temporal x)) @@ -33,12 +40,7 @@ (s/fdef measure/evaluate-measure - :args - (s/cat - :context (s/keys :req [:blaze/base-url ::reitit/router] - :req-un [:blaze/clock :blaze/rng-fn :blaze.db/db]) - :measure :blaze/resource - :params ::params) + :args (s/cat :context ::context :measure :blaze/resource :params ::params) :ret (s/or :result (s/keys :req-un [:blaze/resource] :opt-un [:blaze.db/tx-ops]) :anomaly ::anom/anomaly)) diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj index b8e6490c5..5067ecc6c 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure/measure_test.clj @@ -3,6 +3,7 @@ [blaze.anomaly :as ba] [blaze.db.api :as d] [blaze.db.api-stub :refer [mem-node-config with-system-data]] + [blaze.elm.expression :as-alias expr] [blaze.fhir.operation.evaluate-measure.measure :as measure] [blaze.fhir.operation.evaluate-measure.measure-spec] [blaze.fhir.operation.evaluate-measure.measure.population-spec] @@ -22,6 +23,7 @@ [reitit.core :as reitit] [taoensso.timbre :as log]) (:import + [com.github.benmanes.caffeine.cache Caffeine] [java.nio.charset StandardCharsets] [java.util Base64])) @@ -97,6 +99,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} period [#system/date"2000" #system/date"2020"]] (measure/evaluate-measure context @@ -216,6 +219,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :library [#fhir/canonical"0"] @@ -274,6 +278,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :library [#fhir/canonical"0"] @@ -369,6 +374,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure-id "measure-id-133021" measure {:fhir/type :fhir/Measure :id measure-id @@ -396,6 +402,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn + ::expr/cache (.build (Caffeine/newBuilder)) :db db :timeout (time/seconds 0) :blaze/base-url "" ::reitit/router router} measure-id "measure-id-132321" @@ -425,6 +432,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :url #fhir/uri"measure-155437" @@ -460,6 +468,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :url #fhir/uri"measure-155502" @@ -500,6 +509,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :library [#fhir/canonical"0"] @@ -524,6 +534,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :library [#fhir/canonical"0"] @@ -550,6 +561,7 @@ (let [db (d/db node) context {:clock fixed-clock :rng-fn fixed-rng-fn :db db + ::expr/cache (.build (Caffeine/newBuilder)) :blaze/base-url "" ::reitit/router router} measure {:fhir/type :fhir/Measure :id "0" :library [#fhir/canonical"0"] diff --git a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure_test.clj b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure_test.clj index 30b741b5b..5c0df6e45 100644 --- a/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure_test.clj +++ b/modules/operation-measure-evaluate-measure/test/blaze/fhir/operation/evaluate_measure_test.clj @@ -4,6 +4,7 @@ [blaze.async.comp :as ac] [blaze.db.api-stub :as api-stub :refer [with-system-data]] [blaze.db.resource-store :as rs] + [blaze.elm.expression :as-alias expr] [blaze.executors :as ex] [blaze.fhir.operation.evaluate-measure :as evaluate-measure] [blaze.fhir.operation.evaluate-measure.test-util :refer [wrap-error]] @@ -20,7 +21,9 @@ [java-time.api :as time] [juxt.iota :refer [given]] [reitit.core :as reitit] - [taoensso.timbre :as log])) + [taoensso.timbre :as log]) + (:import + [com.github.benmanes.caffeine.cache Cache])) (set! *warn-on-reflection* true) @@ -83,20 +86,42 @@ (given-thrown (ig/init {::evaluate-measure/handler {}}) :key := ::evaluate-measure/handler :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :executor)) - [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :clock)) - [:explain ::s/problems 3 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)))) + [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% ::expr/cache)) + [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :node)) + [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :executor)) + [:explain ::s/problems 3 :pred] := `(fn ~'[%] (contains? ~'% :clock)) + [:explain ::s/problems 4 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)))) (testing "invalid executor" (given-thrown (ig/init {::evaluate-measure/handler {:executor ::invalid}}) :key := ::evaluate-measure/handler :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :clock)) - [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)) - [:explain ::s/problems 3 :pred] := `ex/executor? - [:explain ::s/problems 3 :val] := ::invalid))) + [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% ::expr/cache)) + [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :node)) + [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :clock)) + [:explain ::s/problems 3 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)) + [:explain ::s/problems 4 :pred] := `ex/executor? + [:explain ::s/problems 4 :val] := ::invalid))) + + +(deftest expr-cache-init-test + (testing "nil config" + (given-thrown (ig/init {::evaluate-measure/expr-cache nil}) + :key := ::evaluate-measure/expr-cache + :reason := ::ig/build-failed-spec + [:explain ::s/problems 0 :pred] := `map?)) + + (testing "invalid millis" + (given-thrown (ig/init {::evaluate-measure/expr-cache {:max-size ::invalid}}) + :key := ::evaluate-measure/expr-cache + :reason := ::ig/build-failed-spec + [:explain ::s/problems 0 :pred] := `nat-int? + [:explain ::s/problems 0 :val] := ::invalid)) + + (testing "init" + (with-system [{::evaluate-measure/keys [expr-cache]} + {::evaluate-measure/expr-cache {:max-size 125509}}] + (is (instance? Cache expr-cache))))) (deftest timeout-init-test @@ -161,9 +186,11 @@ (assoc api-stub/mem-node-config ::evaluate-measure/handler {:node (ig/ref :blaze.db/node) + ::expr/cache (ig/ref ::evaluate-measure/expr-cache) :executor (ig/ref :blaze.test/executor) :clock (ig/ref :blaze.test/fixed-clock) :rng-fn (ig/ref :blaze.test/fixed-rng-fn)} + ::evaluate-measure/expr-cache {} :blaze.test/executor {} :blaze.test/fixed-rng-fn {})) diff --git a/modules/page-store-cassandra/.clj-kondo/config.edn b/modules/page-store-cassandra/.clj-kondo/config.edn index c84cd562b..d6d5d9157 100644 --- a/modules/page-store-cassandra/.clj-kondo/config.edn +++ b/modules/page-store-cassandra/.clj-kondo/config.edn @@ -17,6 +17,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/page-store/Makefile b/modules/page-store/Makefile index 8eb60f27a..7510b665c 100644 --- a/modules/page-store/Makefile +++ b/modules/page-store/Makefile @@ -10,7 +10,13 @@ test: prep test-coverage: prep clojure -M:test:coverage +deps-tree: + clojure -X:deps tree + +deps-list: + clojure -X:deps list + clean: rm -rf .clj-kondo/.cache .cpcache target -.PHONY: lint prep test test-coverage clean +.PHONY: lint prep test test-coverage deps-tree deps-list clean diff --git a/modules/page-store/deps.edn b/modules/page-store/deps.edn index 600230b0d..640a37d08 100644 --- a/modules/page-store/deps.edn +++ b/modules/page-store/deps.edn @@ -8,10 +8,7 @@ {:local/root "../db"} blaze/module-base - {:local/root "../module-base"} - - com.github.ben-manes.caffeine/caffeine - {:mvn/version "3.1.7"}} + {:local/root "../module-base"}} :aliases {:test diff --git a/modules/rest-api/src/blaze/rest_api/routes.clj b/modules/rest-api/src/blaze/rest_api/routes.clj index 02b0f1865..48de0298f 100644 --- a/modules/rest-api/src/blaze/rest_api/routes.clj +++ b/modules/rest-api/src/blaze/rest_api/routes.clj @@ -291,45 +291,45 @@ (cond-> (-> ["" {:middleware - (cond-> [wrap-observe-request-duration wrap-params wrap-output - wrap-error [wrap-forwarded base-url] wrap-sync] + (cond-> [wrap-observe-request-duration wrap-params wrap-output + wrap-error [wrap-forwarded base-url] wrap-sync] (seq auth-backends) (conj wrap-auth-guard)) :blaze/context-path context-path} ["" (cond-> {} (some? search-system-handler) - (assoc :get {:interaction "search-system" - :middleware [[wrap-search-db node db-sync-timeout] - wrap-link-headers] + (assoc :get {:interaction "search-system" + :middleware [[wrap-search-db node db-sync-timeout] + wrap-link-headers] :handler search-system-handler}) (some? transaction-handler) - (assoc :post {:interaction "transaction" - :middleware + (assoc :post {:interaction "transaction" + :middleware [wrap-resource [wrap-batch-handler batch-handler-promise]] :handler transaction-handler}))] ["/metadata" - {:interaction "capabilities" - :get capabilities-handler}] + {:interaction "capabilities" + :get capabilities-handler}] ["/_history" (cond-> {} (some? history-system-handler) - (assoc :get {:interaction "history-system" - :middleware [[wrap-db node db-sync-timeout] - wrap-link-headers] + (assoc :get {:interaction "history-system" + :middleware [[wrap-db node db-sync-timeout] + wrap-link-headers] :handler history-system-handler}))] ["/__page" (cond-> {:name :page} (some? search-system-handler) (assoc - :get {:interaction "search-system" - :middleware [[wrap-snapshot-db node db-sync-timeout] - wrap-link-headers] + :get {:interaction "search-system" + :middleware [[wrap-snapshot-db node db-sync-timeout] + wrap-link-headers] :handler search-system-handler} - :post {:interaction "search-system" - :middleware [[wrap-snapshot-db node db-sync-timeout] - wrap-link-headers] + :post {:interaction "search-system" + :middleware [[wrap-snapshot-db node db-sync-timeout] + wrap-link-headers] :handler search-system-handler}))]] (into (mapcat (partial operation-system-handler-route context)) diff --git a/modules/rest-util/.clj-kondo/config.edn b/modules/rest-util/.clj-kondo/config.edn index c80ee0a13..3e43d873d 100644 --- a/modules/rest-util/.clj-kondo/config.edn +++ b/modules/rest-util/.clj-kondo/config.edn @@ -21,6 +21,7 @@ :consistent-alias {:aliases - {blaze.db.api d}}} + {blaze.db.api d + cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/rest-util/deps.edn b/modules/rest-util/deps.edn index 515ad9e9d..cfad6570b 100644 --- a/modules/rest-util/deps.edn +++ b/modules/rest-util/deps.edn @@ -12,7 +12,7 @@ {:mvn/version "5.2.2"} metosin/reitit-ring - {:mvn/version "0.6.0"} + {:mvn/version "0.7.0-alpha5"} ring/ring-core {:mvn/version "1.10.0" diff --git a/modules/rocksdb/.clj-kondo/config.edn b/modules/rocksdb/.clj-kondo/config.edn index 00955120f..599a81c77 100644 --- a/modules/rocksdb/.clj-kondo/config.edn +++ b/modules/rocksdb/.clj-kondo/config.edn @@ -1,5 +1,6 @@ {:lint-as - {blaze.db.kv.rocksdb-test/with-system-data clojure.core/with-open + {blaze.anomaly/when-ok clojure.core/let + blaze.db.kv.rocksdb-test/with-system-data clojure.core/with-open blaze.module.test-util/with-system clojure.core/with-open} :linters @@ -20,6 +21,7 @@ :consistent-alias {:aliases - {blaze.db.kv.rocksdb.protocols p}}} + {blaze.db.kv.rocksdb.protocols p + cognitect.anomalies anom}}} :skip-comments true} diff --git a/modules/rocksdb/src/blaze/db/kv/rocksdb.clj b/modules/rocksdb/src/blaze/db/kv/rocksdb.clj index ae40bab2f..1e08f8218 100644 --- a/modules/rocksdb/src/blaze/db/kv/rocksdb.clj +++ b/modules/rocksdb/src/blaze/db/kv/rocksdb.clj @@ -1,5 +1,6 @@ (ns blaze.db.kv.rocksdb (:require + [blaze.anomaly :as ba :refer [when-ok]] [blaze.db.kv :as kv] [blaze.db.kv.rocksdb.impl :as impl] [blaze.db.kv.rocksdb.metrics :as metrics] @@ -184,7 +185,7 @@ (impl/datafy-tables (.getPropertiesOfAllTables db))) (-table-properties [_ column-family] - (let [cfh (impl/get-cfh cfhs column-family)] + (when-ok [cfh (ba/try-anomaly (impl/get-cfh cfhs column-family))] (impl/datafy-tables (.getPropertiesOfAllTables db cfh)))) AutoCloseable diff --git a/modules/rocksdb/src/blaze/db/kv/rocksdb/spec.clj b/modules/rocksdb/src/blaze/db/kv/rocksdb/spec.clj index ad9174aa2..ee84dc32c 100644 --- a/modules/rocksdb/src/blaze/db/kv/rocksdb/spec.clj +++ b/modules/rocksdb/src/blaze/db/kv/rocksdb/spec.clj @@ -4,6 +4,7 @@ [blaze.db.kv.rocksdb :as-alias rocksdb] [blaze.db.kv.rocksdb.db-options :as-alias db-options] [blaze.db.kv.rocksdb.protocols :as p] + [blaze.db.kv.rocksdb.table :as-alias table] [blaze.db.kv.rocksdb.write-options :as-alias write-options] [blaze.db.kv.spec] [clojure.spec.alpha :as s]) @@ -63,3 +64,15 @@ (s/def ::rocksdb/opts (s/merge ::rocksdb/db-options ::rocksdb/write-options)) + + +(s/def ::table/data-size + int?) + + +(s/def ::table/index-size + int?) + + +(s/def ::rocksdb/table + (s/keys :req-un [::table/data-size ::table/index-size])) diff --git a/modules/rocksdb/src/blaze/db/kv/rocksdb_spec.clj b/modules/rocksdb/src/blaze/db/kv/rocksdb_spec.clj index 84c295418..22f3dd540 100644 --- a/modules/rocksdb/src/blaze/db/kv/rocksdb_spec.clj +++ b/modules/rocksdb/src/blaze/db/kv/rocksdb_spec.clj @@ -3,7 +3,8 @@ [blaze.db.kv :as-alias kv] [blaze.db.kv.rocksdb :as rocksdb] [blaze.db.kv.rocksdb.spec] - [clojure.spec.alpha :as s])) + [clojure.spec.alpha :as s] + [cognitect.anomalies :as anom])) (s/fdef rocksdb/column-families @@ -27,4 +28,4 @@ (s/fdef rocksdb/table-properties :args (s/cat :store ::kv/rocksdb :column-family (s/? simple-keyword?)) - :ret int?) + :ret (s/or :properties ::rocksdb/table :anomaly ::anom/anomaly)) diff --git a/modules/rocksdb/test/blaze/db/kv/rocksdb_test.clj b/modules/rocksdb/test/blaze/db/kv/rocksdb_test.clj index 47bba605f..9a14e593d 100644 --- a/modules/rocksdb/test/blaze/db/kv/rocksdb_test.clj +++ b/modules/rocksdb/test/blaze/db/kv/rocksdb_test.clj @@ -735,26 +735,27 @@ (deftest table-properties-test - (with-system [{db ::kv/rocksdb} (config (new-temp-dir!))] - (run! - (fn [i] - (kv/put! - db - (bs/to-byte-array (bs/from-hex (str/upper-case (Long/toHexString i)))) - (apply ba (range 10000)))) - (range 10000 20000)) - - (given (rocksdb/table-properties db) - count := 1 - [0 :comparator-name] := "leveldb.BytewiseComparator" - [0 :compression-name] := "LZ4" - [0 :data-size] := 2168082 - [0 :index-size] := 86351 - [0 :num-data-blocks] := 6631 - [0 :num-entries] := 6631 - [0 :top-level-index-size] := 0 - [0 :total-raw-key-size] := 66310 - [0 :total-raw-value-size] := 66310000)) + (testing "default column-family" + (with-system [{db ::kv/rocksdb} (config (new-temp-dir!))] + (run! + (fn [i] + (kv/put! + db + (bs/to-byte-array (bs/from-hex (str/upper-case (Long/toHexString i)))) + (apply ba (range 10000)))) + (range 10000 20000)) + + (given (rocksdb/table-properties db) + count := 1 + [0 :comparator-name] := "leveldb.BytewiseComparator" + [0 :compression-name] := "LZ4" + [0 :data-size] := 2168082 + [0 :index-size] := 86351 + [0 :num-data-blocks] := 6631 + [0 :num-entries] := 6631 + [0 :top-level-index-size] := 0 + [0 :total-raw-key-size] := 66310 + [0 :total-raw-value-size] := 66310000))) (testing "with column-family" (with-system [{db ::kv/rocksdb} (a-config (new-temp-dir!))] @@ -777,7 +778,13 @@ [0 :num-entries] := 6631 [0 :top-level-index-size] := 0 [0 :total-raw-key-size] := 66310 - [0 :total-raw-value-size] := 66310000)))) + [0 :total-raw-value-size] := 66310000))) + + (testing "with unknown column-family" + (with-system [{db ::kv/rocksdb} (config (new-temp-dir!))] + (given (rocksdb/table-properties db :column-family-143119) + ::anom/category := ::anom/not-found + ::anom/message := "column family `column-family-143119` not found")))) (deftest compact-range-test diff --git a/modules/scheduler/.clj-kondo/config.edn b/modules/scheduler/.clj-kondo/config.edn index a25d19101..e2271fd78 100644 --- a/modules/scheduler/.clj-kondo/config.edn +++ b/modules/scheduler/.clj-kondo/config.edn @@ -15,6 +15,10 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {blaze.scheduler sched}}} :skip-comments true} diff --git a/modules/scheduler/README.md b/modules/scheduler/README.md new file mode 100644 index 000000000..9d65e4158 --- /dev/null +++ b/modules/scheduler/README.md @@ -0,0 +1,3 @@ +# Scheduler + +A scheduler that can run functions at fixed intervals. diff --git a/modules/scheduler/src/blaze/scheduler.clj b/modules/scheduler/src/blaze/scheduler.clj index 0a5aa8fae..7497856fd 100644 --- a/modules/scheduler/src/blaze/scheduler.clj +++ b/modules/scheduler/src/blaze/scheduler.clj @@ -7,13 +7,20 @@ [java-time.api :as time] [taoensso.timbre :as log]) (:import - [java.util.concurrent Executors Future ScheduledExecutorService TimeUnit])) + [java.util.concurrent Future ScheduledExecutorService TimeUnit])) (set! *warn-on-reflection* true) -(defn schedule-at-fixed-rate [scheduler f initial-delay period] +(defn submit [scheduler f] + (p/-submit scheduler f)) + + +(defn schedule-at-fixed-rate + "Schedules the function `f` to be called at a rate of `period` with an + `initial-delay`." + [scheduler f initial-delay period] (p/-schedule-at-fixed-rate scheduler f initial-delay period)) @@ -23,6 +30,9 @@ (extend-protocol p/Scheduler ScheduledExecutorService + (-submit [scheduler f] + (.submit scheduler ^Runnable f)) + (-schedule-at-fixed-rate [scheduler f initial-delay period] (.scheduleAtFixedRate scheduler @@ -35,7 +45,7 @@ (defmethod ig/init-key :blaze/scheduler [_ _] (log/info "Start scheduler") - (Executors/newSingleThreadScheduledExecutor)) + (ex/scheduled-pool 4 "scheduler-%d")) (defmethod ig/halt-key! :blaze/scheduler @@ -45,3 +55,6 @@ (if (ex/await-termination scheduler 10 TimeUnit/SECONDS) (log/info "Scheduler was stopped successfully") (log/warn "Got timeout while stopping the scheduler"))) + + +(derive :blaze/scheduler :blaze.metrics/thread-pool-executor) diff --git a/modules/scheduler/src/blaze/scheduler/protocol.clj b/modules/scheduler/src/blaze/scheduler/protocol.clj index 108dd768f..7a25c46ad 100644 --- a/modules/scheduler/src/blaze/scheduler/protocol.clj +++ b/modules/scheduler/src/blaze/scheduler/protocol.clj @@ -2,4 +2,5 @@ (defprotocol Scheduler + (-submit [scheduler f]) (-schedule-at-fixed-rate [scheduler f initial-delay period])) diff --git a/profiling/blaze/profiling.clj b/profiling/blaze/profiling.clj index 241b8305e..b39b1f3e8 100644 --- a/profiling/blaze/profiling.clj +++ b/profiling/blaze/profiling.clj @@ -1,10 +1,10 @@ (ns blaze.profiling "Profiling namespace without test dependencies." (:require - [blaze.system :as system] - [blaze.db.cache-collector :as cc] + [blaze.cache-collector.protocols :as ccp] [blaze.db.kv.rocksdb :as rocksdb] [blaze.db.resource-cache :as resource-cache] + [blaze.system :as system] [clojure.tools.namespace.repl :refer [refresh]] [taoensso.timbre :as log])) @@ -43,16 +43,21 @@ ;; Transaction Cache (comment - (str (cc/-stats (:blaze.db/tx-cache system))) + (str (ccp/-stats (:blaze.db/tx-cache system))) (resource-cache/invalidate-all! (:blaze.db/tx-cache system)) ) ;; Resource Cache (comment - (str (cc/-stats (:blaze.db/resource-cache system))) + (str (ccp/-stats (:blaze.db/resource-cache system))) (resource-cache/invalidate-all! (:blaze.db/resource-cache system)) ) +;; CQL Expression Cache +(comment + (str (ccp/-stats (:blaze.fhir.operation.evaluate-measure/expr-cache system))) + ) + ;; DB (comment (str (system [:blaze.db.kv.rocksdb/stats :blaze.db.index-kv-store/stats])) @@ -69,6 +74,7 @@ (rocksdb/get-property index-db :resource-as-of-index "rocksdb.stats") (rocksdb/get-property index-db :type-as-of-index "rocksdb.stats") (rocksdb/get-property index-db :system-as-of-index "rocksdb.stats") + (rocksdb/get-property index-db :patient-as-of-index "rocksdb.stats") (rocksdb/get-property index-db :type-stats-index "rocksdb.stats") (rocksdb/get-property index-db :system-stats-index "rocksdb.stats") diff --git a/resources/blaze.edn b/resources/blaze.edn index 112e895f9..afcb7c72b 100644 --- a/resources/blaze.edn +++ b/resources/blaze.edn @@ -149,11 +149,15 @@ ;; :blaze.fhir.operation.evaluate-measure/handler {:node #blaze/ref :blaze.db/node + :blaze.elm.expression/cache #blaze/ref :blaze.fhir.operation.evaluate-measure/expr-cache :executor #blaze/ref :blaze.fhir.operation.evaluate-measure/executor :clock #blaze/ref :blaze/clock :rng-fn #blaze/ref :blaze/rng-fn :timeout #blaze/ref :blaze.fhir.operation.evaluate-measure/timeout} + :blaze.fhir.operation.evaluate-measure/expr-cache + {:max-size #blaze/cfg ["FHIR_OPERATION_EVALUATE_MEASURE_EXPR_CACHE_SIZE" nat-int? 100000]} + :blaze.fhir.operation.evaluate-measure/timeout {:millis #blaze/cfg ["FHIR_OPERATION_EVALUATE_MEASURE_TIMEOUT" nat-int? 3600000]} @@ -211,6 +215,7 @@ :kv-store #blaze/ref :blaze.db/index-kv-store :resource-indexer #blaze/ref :blaze.db.node/resource-indexer :search-param-registry #blaze/ref :blaze.db/search-param-registry + :scheduler #blaze/ref :blaze/scheduler :enforce-referential-integrity #blaze/cfg ["ENFORCE_REFERENTIAL_INTEGRITY" boolean? true]} :blaze.db.node/indexer-executor {} @@ -232,10 +237,11 @@ :blaze.db.node.tx-indexer/duration-seconds {} - :blaze.db/cache-collector + :blaze/cache-collector {:caches {"tx-cache" #blaze/ref :blaze.db/tx-cache - "resource-cache" #blaze/ref :blaze.db/resource-cache}} + "resource-cache" #blaze/ref :blaze.db/resource-cache + "cql-expr-cache" #blaze/ref :blaze.fhir.operation.evaluate-measure/expr-cache}} ;; ;; Transaction Cache @@ -274,7 +280,9 @@ ;; :blaze.db/search-param-registry {:structure-definition-repo #blaze/ref :blaze.fhir/structure-definition-repo - :extra-bundle-file #blaze/cfg ["DB_SEARCH_PARAM_BUNDLE" string?]}} + :extra-bundle-file #blaze/cfg ["DB_SEARCH_PARAM_BUNDLE" string?]} + + :blaze/scheduler {}} :storage {:in-memory @@ -299,6 +307,7 @@ :resource-as-of-index nil :type-as-of-index nil :system-as-of-index nil + :patient-as-of-index nil :type-stats-index nil :system-stats-index nil}} @@ -441,6 +450,12 @@ :target-file-size-base-in-mb 8 :block-size #blaze/cfg ["DB_BLOCK_SIZE" int? 16384]} + :patient-as-of-index + {:write-buffer-size-in-mb 8 + :max-bytes-for-level-base-in-mb 32 + :target-file-size-base-in-mb 8 + :block-size #blaze/cfg ["DB_BLOCK_SIZE" int? 16384]} + :type-stats-index {:write-buffer-size-in-mb 2 :max-bytes-for-level-base-in-mb 8 @@ -644,6 +659,12 @@ :target-file-size-base-in-mb 8 :block-size #blaze/cfg ["DB_BLOCK_SIZE" int? 16384]} + :patient-as-of-index + {:write-buffer-size-in-mb 8 + :max-bytes-for-level-base-in-mb 32 + :target-file-size-base-in-mb 8 + :block-size #blaze/cfg ["DB_BLOCK_SIZE" int? 16384]} + :type-stats-index {:write-buffer-size-in-mb 2 :max-bytes-for-level-base-in-mb 8 @@ -770,6 +791,4 @@ :scheduler #blaze/ref :blaze/scheduler :provider-url #blaze/cfg ["OPENID_PROVIDER_URL" string?]} - :blaze/http-client {} - - :blaze/scheduler {}}}]} + :blaze/http-client {}}}]}