modify merge-activity for improved upsert

yetanalytics · Nov 18, 2024 · 9bcf1aa · 9bcf1aa
1 parent 05bc67e
commit 9bcf1aa
Show file tree

Hide file tree

Showing 2 changed files with 88 additions and 14 deletions.
diff --git a/src/main/com/yetanalytics/lrs/xapi/activities.cljc b/src/main/com/yetanalytics/lrs/xapi/activities.cljc
@@ -2,6 +2,21 @@
   (:require [clojure.spec.alpha :as s :include-macros true]
             [xapi-schema.spec :as xs]))
 
+(s/fdef merge-activity
+  :args (s/cat :a-1 (s/alt :nil nil?
+                           :activity ::xs/activity)
+               :a-2 ::xs/activity)
+  :ret ::xs/activity)
+
+(def interaction-keys
+  ["interactionType"
+   "correctResponsesPattern"
+   "choices"
+   "scale"
+   "source"
+   "target"
+   "steps"])
+
 (defn merge-activity
   [{?id-1  "id"
     ?def-1 "definition"
@@ -12,18 +27,19 @@
     ;; merge!
     (cond-> {"id" ?id-1 "objectType" "Activity"}
       (or ?def-1 ?def-2)
-      (assoc "definition"
-             (merge-with
-              merge
-              ?def-1
-              (select-keys ?def-2
-                           ["name"
-                            "description"]))))
+      (assoc
+       "definition"
+       (let [?def-2-interaction (select-keys ?def-2 interaction-keys)]
+         (merge-with
+          ;; merge maps, overwrite all else
+          (fn [val-1 val-2]
+            (if (map? val-1)
+              (merge val-1 val-2)
+              val-2))
+          ;; clear def-1 interaction fields if def-2 has one
+          (if (not-empty ?def-2-interaction)
+            (apply dissoc ?def-1 interaction-keys)
+            ?def-1)
+          ?def-2))))
     ;; no merge
     a-2))
-
-(s/fdef merge-activity
-        :args (s/cat :a-1 (s/alt :nil nil?
-                                 :activity ::xs/activity)
-                     :a-2 ::xs/activity)
-        :ret ::xs/activity)
diff --git a/src/test/com/yetanalytics/lrs/xapi/activities_test.cljc b/src/test/com/yetanalytics/lrs/xapi/activities_test.cljc
@@ -5,8 +5,66 @@
    [com.yetanalytics.test-support :refer [failures stc-opts]]
    [com.yetanalytics.lrs.xapi.activities :as ac]))
 
+(def act-id-only
+  {"id" "http://www.example.com/tincan/activities/multipart"})
+
+(def act-full
+  {"id"         "http://www.example.com/tincan/activities/multipart"
+   "objectType" "Activity"
+   "definition" {"type"        "http://www.example.com/activity-types/test"
+                 "name"        {"en-US" "Multi Part Activity"
+                                "zh-CN" "多元部分Activity"}
+                 "description" {"en-US" "Multi Part Activity Description"
+                                "zh-CN" "多元部分Activity的简述"}}})
+
+(def act-en
+  {"id"         "http://www.example.com/tincan/activities/multipart"
+   "objectType" "Activity"
+   "definition" {"type"        "http://www.example.com/activity-types/test"
+                 "name"        {"en-US" "Multi Part Activity"}
+                 "description" {"en-US" "Multi Part Activity Description"}}})
+
+(def act-zh
+  {"id"         "http://www.example.com/tincan/activities/multipart"
+   "objectType" "Activity"
+   "definition" {"type"        "http://www.example.com/activity-types/test"
+                 "name"        {"zh-CN" "多元部分Activity"}
+                 "description" {"zh-CN" "多元部分Activity的简述"}}})
+
+(def act-matching
+  {"id" "aaa://aaa.aaa.aaa/aaa"
+   "objectType" "Activity"
+   "definition"
+   {"interactionType" "matching"
+    "source"          [{"id" "0"}]
+    "target"          [{"id" "A"}]}})
+
+(def act-numeric
+  {"id" "aaa://aaa.aaa.aaa/aaa"
+   "objectType" "Activity"
+   "definition"
+   {"interactionType" "numeric"}})
+
 (deftest merge-activity-test
-  (testing "merging activities"
+  (testing "merging activities with differing detail levels"
+    (is (= (ac/merge-activity act-id-only act-full)
+           (ac/merge-activity act-full act-id-only)
+           act-full)))
+  (testing "merging activities with disjoint languages"
+    (is (= (ac/merge-activity act-en act-zh)
+           (ac/merge-activity act-zh act-en)
+           act-full)))
+  (testing "can change type"
+    (let [act-new-type (assoc-in act-full ["definition" "type"]
+                                 "http://www.example.com/activity-types/test2")]
+      (is (= (ac/merge-activity act-full act-new-type)
+             act-new-type))))
+  (testing "interaction activity atomic updates"
+    (is (= (ac/merge-activity act-matching act-numeric)
+           act-numeric)
+        (= (ac/merge-activity act-numeric act-matching)
+           act-matching)))
+  (testing "merging activities (generative)"
     (is (empty? (failures
                  (stest/check `ac/merge-activity
                               {stc-opts