Skip to content

Commit

Permalink
Merge pull request #405 from yetanalytics/empty-lang-maps
Browse files Browse the repository at this point in the history
Empty language maps
  • Loading branch information
kelvinqian00 committed May 21, 2024
2 parents b5ccdf7 + 61e8c09 commit d70e6ad
Show file tree
Hide file tree
Showing 3 changed files with 146 additions and 35 deletions.
4 changes: 2 additions & 2 deletions deps.edn
Original file line number Diff line number Diff line change
Expand Up @@ -40,12 +40,12 @@
xyz.capybara/clamav-client {:mvn/version "2.1.2"}
;; Yet Analytics deps
com.yetanalytics/lrs
{:mvn/version "1.2.17"
{:mvn/version "1.2.18"
:exclusions [org.clojure/clojure
org.clojure/clojurescript
com.yetanalytics/xapi-schema]}
com.yetanalytics/xapi-schema
{:mvn/version "1.2.2"
{:mvn/version "1.3.0"
:exclusions [org.clojure/clojure
org.clojure/clojurescript]}
com.yetanalytics/colossal-squuid
Expand Down
87 changes: 64 additions & 23 deletions src/main/lrsql/util/statement.clj
Original file line number Diff line number Diff line change
Expand Up @@ -9,16 +9,54 @@

;; If a Statement lacks a version, the version MUST be set to 1.0.0
;; TODO: Change for version 2.0.0
;; FIXME: Why is this not version 1.0.3?
(def xapi-version "1.0.0")

;; NOTE: SQL LRS overwrites any pre-existing authority object in a statement, as
;; suggested by the spec:
;; https://github.com/adlnet/xAPI-Spec/blob/master/xAPI-Data.md#requirements-14

(defn- dissoc-empty-lang-maps*
[{:strs [display name description] :as m}]
(cond-> m
(empty? display) (dissoc "display")
(empty? name) (dissoc "name")
(empty? description) (dissoc "description")))

(defn- dissoc-empty-lang-maps
[statement]
(cond-> statement
;; Dissoc empty verb display
true
(update "verb" dissoc-empty-lang-maps*)
;; Dissoc empty object activity name + description
(= "Activity" (get-in statement ["object" "objectType"]))
(update-in ["object" "definition"]
(fn [{:strs [choices scale source target steps] :as obj-def}]
(cond-> (dissoc-empty-lang-maps* obj-def)
choices (update "choices" #(mapv dissoc-empty-lang-maps* %))
scale (update "scale" #(mapv dissoc-empty-lang-maps* %))
source (update "source" #(mapv dissoc-empty-lang-maps* %))
target (update "target" #(mapv dissoc-empty-lang-maps* %))
steps (update "steps" #(mapv dissoc-empty-lang-maps* %)))))
;; Dissoc empty attachemnt name + description
(contains? statement "attachments")
(update "attachments" #(mapv dissoc-empty-lang-maps* %))))

(defn- assoc-to-statement
"Assoc while also changing the meta of `statement`."
[statement k v]
(-> statement
(assoc k v)
(vary-meta update
:assigned-vals
conj
(keyword k))))

(defn prepare-statement
"Prepare `statement` for LRS storage by coll-ifying context activities
and setting missing id, timestamp, authority, version, and stored
properties."
properties. In addition, removes empty maps from `statement`."
[authority statement]
(let [{?id "id"
?timestamp "timestamp"
Expand All @@ -28,31 +66,34 @@
squuid-ts :timestamp
squuid-base :base-uuid}
(u/generate-squuid*)
assoc-to-stmt (fn [stmt k v] ; Assoc while also changing the meta
(-> stmt
(assoc k v)
(vary-meta update
:assigned-vals
conj
(keyword k))))
squuid-ts-str (u/time->str squuid-ts)]
(cond-> statement
true
ss/fix-statement-context-activities
true
(vary-meta assoc :assigned-vals #{})
true
(vary-meta assoc :primary-key squuid)
true
(assoc-to-stmt "stored" squuid-ts-str)
true
(assoc-to-stmt "authority" authority)
squuid-ts-str
(u/time->str squuid-ts)
{{activity-def* "definition"} "object"
context* "context"
result* "result"
:as statement*}
(-> statement
dissoc-empty-lang-maps
ss/fix-statement-context-activities
(vary-meta assoc :assigned-vals #{})
(vary-meta assoc :primary-key squuid)
(assoc-to-statement "stored" squuid-ts-str)
(assoc-to-statement "authority" authority))]
(cond-> statement*
;; Dissoc empty properties
(empty? activity-def*)
(update "object" dissoc "definition")
(empty? context*)
(dissoc "context")
(empty? result*)
(dissoc "result")
;; Assoc missing properties
(not ?id)
(assoc-to-stmt "id" (u/uuid->str squuid-base))
(assoc-to-statement "id" (u/uuid->str squuid-base))
(not ?timestamp)
(assoc-to-stmt "timestamp" squuid-ts-str)
(assoc-to-statement "timestamp" squuid-ts-str)
(not ?version)
(assoc-to-stmt "version" xapi-version))))
(assoc-to-statement "version" xapi-version))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Statement Equality
Expand Down
90 changes: 80 additions & 10 deletions src/test/lrsql/util/statement_test.clj
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
(ns lrsql.util.statement-test
(:require [clojure.test :refer [deftest testing is]]
[lrsql.util.statement :as su]))
[lrsql.util.statement :as su]
[lrsql.util :as u]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Fixtures
Expand Down Expand Up @@ -46,6 +47,14 @@
{"id" "http://www.example.com/tincan/activities/multipart"
"objectType" "Activity"})

(def sample-attachment
{"usageType" "http://example.com/attachment-usage/test"
"display" {"en-US" "A test attachment"}
"description" {"en-US" "A test attachment (description)"}
"contentType" "text/plain"
"length" 27
"sha2" "495395e777cd98da653df9615d09c0fd6bb2f8d4788394cd53c56a3bfdcd848a"})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Expand All @@ -54,17 +63,78 @@
(let [lrs-authority {"mbox" "mailto:a@example.com"
"objectType" "Agent"}
foreign-authority {"mbox" "mailto:b@example.com"
"objectType" "Agent"}]
"objectType" "Agent"}
;; Statements
statement-1 {"id" sample-id
"actor" sample-group
"verb" sample-verb
"object" sample-activity}
statement-2 {"id" sample-id
"actor" sample-group
"verb" sample-verb
"object" sample-activity
"authority" foreign-authority}
statement-3 {"id" sample-id
"actor" sample-group
"verb" (assoc sample-verb "display" {})
"object" (assoc sample-activity
"definition"
{"name" {}
"description" {}})
"attachments" [(-> sample-attachment
(assoc "display" {})
(assoc "description" {}))]
"context" {}
"result" {}}
statement-4 {"id" sample-id
"actor" sample-group
"verb" sample-verb
"object" (assoc sample-activity
"definition"
{;; Doesn't form a valid statement but
;; we need to test these lang maps
"choices" [{"id" "Choice"
"description" {}}]
"scale" [{"id" "Scale"
"description" {}}]
"source" [{"id" "Source"
"description" {}}]
"target" [{"id" "Target"
"description" {}}]
"steps" [{"id" "Step"
"description" {}}]})}]
(testing "adds timestamp, stored, version, and authority"
(let [statement* (su/prepare-statement lrs-authority statement-1)]
(is (inst? (u/str->time (get statement* "timestamp"))))
(is (inst? (u/str->time (get statement* "stored"))))
(is (= su/xapi-version (get statement* "version")))
(is (= lrs-authority (get statement* "authority")))))
(testing "overwrites authority"
(is (= lrs-authority
(-> (su/prepare-statement
lrs-authority
{"id" sample-id
"actor" sample-group
"verb" sample-verb
"object" sample-activity
"authority" foreign-authority})
(get "authority")))))))
(-> (su/prepare-statement lrs-authority statement-2)
(get "authority")))))
(testing "dissocs empty maps"
(is (= {"id" sample-id
"actor" sample-group
"verb" sample-verb-dissoc
"object" sample-activity-dissoc
"attachments" [(dissoc sample-attachment
"display"
"description")]}
(-> (su/prepare-statement lrs-authority statement-3)
(dissoc "timestamp" "stored" "authority" "version"))))
(is (= {"id" sample-id
"actor" sample-group
"verb" sample-verb
"object" (assoc sample-activity
"definition"
{"choices" [{"id" "Choice"}]
"scale" [{"id" "Scale"}]
"source" [{"id" "Source"}]
"target" [{"id" "Target"}]
"steps" [{"id" "Step"}]})}
(-> (su/prepare-statement lrs-authority statement-4)
(dissoc "timestamp" "stored" "authority" "version")))))))

(deftest statements-equal-test
(testing "statement equality"
Expand Down

0 comments on commit d70e6ad

Please sign in to comment.