6327 vd improvements

Makefile

@@ -25,3 +25,9 @@ server-repl:
 
 up:
 	docker compose --profile local up -d
+
+down:
+	docker compose --profile local down
+
+down-v:
+	docker compose --profile local down -v

package.json

@@ -5,6 +5,7 @@
     "@monaco-editor/react": "^4.5.0",
     "@sooro-io/react-gtm-module": "^3.0.0",
     "antd": "^5.18.3",
+    "comment-json": "^4.2.5",
     "fhirpath-autocomplete-ts": "git@github.com:Aidbox/fhirpath-autocomplete-ts.git",
     "react": "^18.2.0",
     "react-dom": "^18.3.1",

src/clj/vd_designer/aidbox.clj

@@ -60,15 +60,25 @@
                            :view-definition-run
                            (merge {:body {:resourceType "Parameters"
                                           :parameter [{:name "_format" :valueCode "json"}
-                                                      {:name "viewResource" :resource vd}]}}
+                                                      {:name "viewResource" :resource (assoc vd :resourceType "ViewDefinition")}]}}
+                                  fhir-server-headers))))
+
+(defn get-view-definition-sql
+  [{:keys [box-url request fhir-server-headers]}]
+  (let [{:keys [vd]} (:body-params request)]
+    @(martian/response-for (aidbox-client/aidbox-client box-url)
+                           :get-view-definition-sql
+                           (merge {:body {:resourceType "Parameters"
+                                          :parameter [{:name "_format" :valueCode "json"}
+                                                      {:name "viewResource" :resource (assoc vd :resourceType "ViewDefinition")}]}}
                                   fhir-server-headers))))
 
 (defn save-view-definition
   [{:keys [box-url request fhir-server-headers]}]
   (let [{:keys [vd vd-id]} (:body-params request)]
     @(martian/response-for (aidbox-client/aidbox-client box-url)
                            (if vd-id :update-view-definition :create-view-definition)
-                           (merge {:body  vd
+                           (merge {:body  (assoc vd :resourceType "ViewDefinition")
                                    :vd-id vd-id}
                                   fhir-server-headers))))
 

src/clj/vd_designer/clients/aidbox.clj

@@ -61,6 +61,15 @@
     :method         :post
     :body-schema    {:body s/Any}}
 
+   {:route-name     :get-view-definition-sql
+    :path-parts     ["/fhir/ViewDefinition/$sql"]
+    :headers-schema {(s/optional-key :Cookie)        s/Str
+                     (s/optional-key :Authorization) s/Str}
+    :produces       ["application/json"]
+    :consumes       ["application/json"]
+    :method         :post
+    :body-schema    {:body s/Any}}
+
    {:route-name     :rpc
     :path-parts     ["/rpc"]
     :method         :post

src/clj/vd_designer/web/routes/router.clj

@@ -81,7 +81,12 @@
         {:post
          {:parameters {:body {:box-url string?
                               :vd      string?}}
-          :handler    #'aidbox/eval-view-definition}}]]
+          :handler    #'aidbox/eval-view-definition}}]
+       ["/sql"
+        {:post
+         {:parameters {:body {:box-url string?
+                              :vd      string?}}
+          :handler    #'aidbox/get-view-definition-sql}}]]
       ["/Resource"
        {:get
         {:parameters {:query {:vd-id   string?
@@ -117,4 +122,4 @@
                         coercion/coerce-request-middleware
                         coercion/coerce-response-middleware
                         (app-context-middleware ctx)
-                        (observability-middleware)]}}))
+                        (observability-middleware)]}}))

src/cljs/vd_designer/http/fhir_server.cljs

@@ -39,14 +39,25 @@
    :params           {:box-url box-url :vd view-definition}
    :headers          (authorization-header authentication-token)})
 
+(defn get-view-definition-sql-user-server [authentication-token {:keys [box-url]} view-definition]
+  {:uri              "/api/aidbox/ViewDefinition/sql"
+   :timeout          8000
+   :format           (ajax/json-request-format)
+   :response-format  (ajax/json-response-format
+                      {:keywords? true})
+   :with-credentials true
+   :method           :post
+   :params           {:box-url box-url :vd view-definition}
+   :headers          (authorization-header authentication-token)})
+
 (defn get-metadata [{:keys [box-url]}]
- {:uri              "/api/metadata"
-  :timeout          8000
-  :format           (ajax/json-request-format)
-  :response-format  (ajax/json-response-format {:keywords? true})
-  :with-credentials false
-  :method           :get
-  :params           {:box-url box-url}})
+  {:uri              "/api/metadata"
+   :timeout          8000
+   :format           (ajax/json-request-format)
+   :response-format  (ajax/json-response-format {:keywords? true})
+   :with-credentials false
+   :method           :get
+   :params           {:box-url box-url}})
 
 (defn delete-view-definition [authentication-token {:keys [box-url]} vd-id]
   {:uri              "/api/aidbox/ViewDefinition"

src/cljs/vd_designer/index.cljs

@@ -44,11 +44,16 @@
  (fn [{:keys [db authentication-token chosen-server]} _]
    (if (seq db)
      {:db db}
-     {:db {:view-definitions    []
-           :onboarding          {:sandbox 0
-                                 :aidbox  0}
-           :authorized?         (boolean authentication-token)
-           :cfg/fhir-servers    {:chosen-server chosen-server}}})))
+     {:db {:view-definitions []
+           :onboarding       {:sandbox 0
+                              :aidbox  0}
+           :authorized?      (boolean authentication-token)
+           :cfg/fhir-servers {:chosen-server (or chosen-server
+                                                 {:server-name "Aidbox Sandbox"
+                                                  :box-url     "https://dfiudgkdea.edge.aidbox.app"
+                                                  :type        :public-servers
+                                                  :sandbox     true
+                                                  :headers     {:Authorization "Basic YmFzaWM6c2VjcmV0"}})}}})))
 
 (defn wrap-view-layout [route view]
   (let [breadcrumbs {:breadcrumbs (breadcrumbs route)}]

src/cljs/vd_designer/pages/form/controller.cljs

@@ -67,7 +67,7 @@
                    {:uri "/viewdefinition_jsonschema.json"
                     :fileMatch ["*"]
                     :schema vd-jsonschema/schema}))
-      :fx (cond-> (if (-> db :cfg/fhir-servers  empty?)
+      :fx (cond-> (if (-> db :cfg/fhir-servers (dissoc :chosen-server) empty?)
                     [[:dispatch [::fetch-user-servers vd-id]]]
                     (ready-server-event-fx vd-id))
 
@@ -89,11 +89,7 @@
  ::got-server-list
   ;; TODO: decide what if expected server is not in the list?
  (fn [{:keys [db]} [_ vd-id user-server-list]]
-    ;; TODO: remove code duplication
-   {:db (->> user-server-list
-             (group-by :server-name)
-             (medley/map-vals first)
-             (assoc-in db [:cfg/fhir-servers ]))
+   {:db (update db :cfg/fhir-servers merge user-server-list)
     :fx (ready-server-event-fx vd-id)}))
 
 (reg-event-fx
@@ -422,14 +418,15 @@
        {:db         (-> (assoc db ::m/eval-loading true)
                         (dissoc ::m/empty-inputs?))
 
-        :dispatch   [::auth/with-authentication
-                     (fn [authentication-token]
-                       (-> (http.fhir-server/eval-view-definition-user-server
-                            authentication-token
-                            (http.fhir-server/active-server db)
-                            view-definition)
-                           (assoc :on-success [::on-eval-view-definition-success]
-                                  :on-failure [::on-eval-view-definition-error])))]}))))
+        :dispatch-n   [[::auth/with-authentication
+                        (fn [authentication-token]
+                          (-> (http.fhir-server/eval-view-definition-user-server
+                               authentication-token
+                               (http.fhir-server/active-server db)
+                               view-definition)
+                              (assoc :on-success [::on-eval-view-definition-success]
+                                     :on-failure [::on-eval-view-definition-error])))]
+                       [::on-sql-tab-clicked]]}))))
 
 (reg-event-fx
  ::eval-view-definition-code
@@ -438,8 +435,11 @@
     {:dataLayer {:event         "vd_run"
                  :resource-type (get (:current-vd db) :resource "")}})
    (let [sandbox? (settings-model/in-sandbox? db)
+         parse (if (= :language/json (::m/language db))
+                 yaml/json-parse
+                 yaml/try-parse)
          view-definition (-> (::m/view-definition-code db)
-                             yaml/try-parse
+                             parse
                              (js->clj :keywordize-keys true)
                              strip-empty-select-nodes
                              strip-empty-where-nodes)
@@ -485,7 +485,10 @@
  ::on-eval-view-definition-error
  (fn [{:keys [db]} [_ result]]
    {:db (assoc db ::m/eval-loading false)
-    :notification-error (str "Error on run: " (u/response->error result))}))
+    :notification-error (str (u/response->error result) ": "
+                             (->> (get-in result [:response :issue])
+                                  (keep :diagnostics)
+                                  (str/join ", ")))}))
 
 (reg-event-db
  ::change-input-value
@@ -701,7 +704,7 @@
 
 (defn format-vd-code [code lang]
   (case lang
-    :language/yaml (-> code js/JSON.parse yaml/stringify)
+    :language/yaml (-> code yaml/json-parse yaml/stringify)
     :language/json (-> code yaml/str->yaml (js/JSON.stringify nil 2))
     ""))
 
@@ -936,10 +939,40 @@
                       (input-references/replace-inputs-with-values (::m/tree-inputs db))
                       (format-code language))))))))
 
-(reg-event-db
+(reg-event-fx
+ ::get-vd-sql-success
+ (fn [{:keys [db]} [_ response]]
+   {:db (assoc-in db
+                  [::m/vd-sql :sql]
+                  (->> response
+                       :parameter
+                       (filter #(= (:name %) "sql"))
+                       first
+                       :valueString))}))
+
+(reg-event-fx
+ ::get-vd-sql-failure
+ (fn [{:keys [_db]} [_ _response]]
+   nil))
+
+(reg-event-fx
  ::on-sql-tab-clicked
- (fn [db _]
-   (assoc db ::m/left-panel-active-tab :left-panel-tab/sql)))
+ (fn [{:keys [db]} _]
+   {:fx [[:dispatch [::auth/with-authentication
+                     (fn [authentication-token]
+                       (assoc (http.fhir-server/get-view-definition-sql-user-server
+                               authentication-token
+                               (http.fhir-server/active-server db)
+                               (-> (:current-vd db)
+                                   decoration/remove-decoration
+                                   (input-references/replace-inputs-with-values (::m/tree-inputs db))
+                                   strip-empty-collections
+                                   remove-meta
+                                   strip-empty-select-nodes
+                                   strip-empty-where-nodes))
+                              :on-success [::get-vd-sql-success]
+                              :on-failure [::get-vd-sql-failure]))]]]
+    :db (assoc db ::m/left-panel-active-tab :left-panel-tab/sql)}))
 
 (reg-event-db
  ::set-code-dirty

src/cljs/vd_designer/pages/form/model.cljs

@@ -49,7 +49,7 @@
 (reg-sub
  ::sql
  (fn [db _]
-   (-> db ::resource-data :sql)))
+   (-> db ::vd-sql :sql)))
 
 (reg-sub
  ::eval-loading
@@ -131,7 +131,7 @@
        (get input-id)
        (get :type))))
 
-(reg-sub 
+(reg-sub
  ::view-definition-code
  :-> ::view-definition-code)
 
@@ -179,4 +179,4 @@
 
 (reg-sub
  ::resource-loading?
- :-> ::resource-loading?)
+ :-> ::resource-loading?)

src/cljs/vd_designer/pages/form/sql.cljs

@@ -8,7 +8,7 @@
 
 (defn sql []
   (let [sql @(subscribe [::m/sql])
-        formatted-sql (sqlf/format sql (clj->js {:language "postgresql"}))]
+        formatted-sql (if sql (sqlf/format sql (clj->js {:language "postgresql"})) "")]
     [:div {:style {:height        "100%"
                    :padding-right "8px"}}
      [monaco {:id       "vd-sql"