Skip to content

Commit

Permalink
SQL-211 use shared lib
Browse files Browse the repository at this point in the history
  • Loading branch information
milt committed Dec 7, 2023
1 parent eebd735 commit d43b455
Show file tree
Hide file tree
Showing 7 changed files with 54 additions and 512 deletions.
5 changes: 4 additions & 1 deletion deps.edn
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,10 @@
:exclusions
[org.clojure/clojurescript
reagent/reagent
cljsjs/codemirror]}}
cljsjs/codemirror]}
com.yetanalytics/lrs-reactions {:mvn/version "0.0.1-SNAPSHOT"
:exclusions
[org.clojure/clojure]}}
:paths ["src" "resources"]
:aliases {:fig {:extra-deps
{com.bhauman/rebel-readline-cljs {:mvn/version "0.1.4"}
Expand Down
190 changes: 0 additions & 190 deletions src/com/yetanalytics/lrs_admin_ui/functions/reaction.cljs
Original file line number Diff line number Diff line change
Expand Up @@ -24,196 +24,6 @@
:segment seg}))))
s)))

;; (def types #{'string 'number 'boolean 'null 'lmap 'extensions})

(def pathmap-agent
{"account" {"homePage" 'string,
"name" 'string},
"name" 'string,
"mbox" 'string,
"openid" 'string,
"mbox_sha1sum" 'string,
"objectType" 'string})

(def pathmap-group
{"objectType" 'string,
"member" [pathmap-agent],
"account" {"homePage" 'string, "name" 'string},
"mbox" 'string,
"name" 'string,
"mbox_sha1sum" 'string})

(def pathmap-actor
(merge pathmap-agent
pathmap-group))

(def pathmap-interaction-component
{"id" 'string,
"description" 'lmap})

(def pathmap-activity
{"definition"
{"source" [pathmap-interaction-component],
"extensions" 'extensions,
"description" 'lmap,
"steps" [pathmap-interaction-component],
"target" [pathmap-interaction-component],
"moreInfo" 'string,
"correctResponsesPattern" ['string],
"interactionType" 'string,
"choices" [pathmap-interaction-component],
"scale" [pathmap-interaction-component],
"name" 'lmap,
"type" 'string},
"id" 'string,
"objectType" 'string})

(def pathmap-statement-ref
{"id" 'string, "objectType" 'string})

(def pathmap-verb
{"display" 'lmap, "id" 'string})

(def pathmap-attachment
{"description" 'lmap,
"display" 'lmap,
"usageType" 'string,
"contentType" 'string,
"length" 'number,
"fileUrl" 'string,
"sha2" 'string})

(def pathmap-context
{"language" 'string,
"extensions" 'extensions,
"team" pathmap-group,
"contextActivities"
{"category" [pathmap-activity],
"grouping" [pathmap-activity],
"other" [pathmap-activity],
"parent" [pathmap-activity]},
"instructor" pathmap-actor,
"registration" 'string,
"platform" 'string,
"statement" pathmap-statement-ref,
"revision" 'string})

(def pathmap-result
{"score"
{"raw" 'number, "max" 'number, "min" 'number, "scaled" 'number},
"extensions" 'extensions,
"response" 'string,
"duration" 'string,
"completion" 'boolean,
"success" 'boolean})

(def pathmap-sub-statement
{"verb" pathmap-verb,
"objectType" 'string,
"attachments" [pathmap-attachment],
"context" pathmap-context,
"result" pathmap-result,
"timestamp" 'string,
"object" (merge pathmap-activity
pathmap-actor
pathmap-statement-ref),
"actor" pathmap-actor})

(def pathmap-statement
(merge pathmap-sub-statement
{"id" 'string,
"version" 'string,
"object" (merge
pathmap-activity
pathmap-actor
pathmap-sub-statement
pathmap-statement-ref),
"stored" 'string,
"authority" pathmap-actor}))

(defn parent-paths
"Given a path vector, return a seq of parent paths in reverse order.
Does not return the root path []."
[path]
(lazy-seq
(when-let [ppath (not-empty
(-> path
butlast
vec))]
(cons
ppath
(parent-paths ppath)))))

(defn- zero-indices
"Replace index integers with 0 in path"
[path]
(mapv (fn [seg]
(if (number? seg)
0
seg))
path))

(defn analyze-path*
[path]
(let [ret (get-in pathmap-statement
(zero-indices path))
;; lmaps and extensions
[?p-idx ?p-leaf-type]
(or (some
(fn [[idx ppath]]
(let [ret (get-in pathmap-statement
(zero-indices ppath))]
(when (symbol? ret)
[idx ret])))
(map-indexed vector (parent-paths path)))
[])
next-keys (cond
(map? ret) (into [] (keys ret))
(vector? ret) ['idx]
:else [])
leaf-type (if (symbol? ret)
(when-not (contains? #{'lmap 'extensions} ret)
ret)
(when ?p-leaf-type
(cond
(and (= 'lmap ?p-leaf-type)
(= 0 ?p-idx)) 'string
(= 'extensions ?p-leaf-type) 'json)))
valid? (or
(some? ret)
(= 'extensions ?p-leaf-type)
(and (= 'lmap ?p-leaf-type)
(= 0 ?p-idx)))]
{:next-keys next-keys
:leaf-type leaf-type
:valid? valid?
:complete?
(cond
;; Invalid paths are always complete
(not valid?) true
;; extensions are never complete
(or (= 'extensions ret)
(= 'extensions ?p-leaf-type)) false
;; lmaps w/o ltag are not complete
(= 'lmap ret) false
:else (empty? next-keys))}))

(def analyze-path
"Given a (possibly) partial xapi path:
Return a map with keys:
:valid? Is the path valid per xapi?
:next-keys - Coll of possible further keys. May contain the special key
`'idx` to denote that the current structure is an array.
:leaf-type - One of the following symbols:
'string
'number
'boolean
'null
'json - In the case of extensions, might be any JSON scalar!
:complete? - For the purposes of UI, is the path complete (ie. no further
segments should be offered)? Will be false for extension paths."
(memoize analyze-path*))

(defn val-type
"Get a value type as a string"
[val]
Expand Down
9 changes: 5 additions & 4 deletions src/com/yetanalytics/lrs_admin_ui/handlers.cljs
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,8 @@
[goog.string :refer [format]]
goog.string.format
[clojure.walk :as w]
[com.yetanalytics.lrs-admin-ui.spec.reaction :as rs]))
[com.yetanalytics.lrs-admin-ui.spec.reaction :as rs]
[com.yetanalytics.lrs-reactions.path :as rpath]))

(def global-interceptors
[db/check-spec-interceptor])
Expand Down Expand Up @@ -1157,7 +1158,7 @@
ref] :as c}]
(if ref
c
(let [{:keys [leaf-type]} (rfns/analyze-path path)]
(let [{:keys [leaf-type]} (rpath/analyze-path path)]
(if leaf-type
(let [vtype (val-type val)]
(assoc c :val (if (= leaf-type vtype)
Expand All @@ -1172,7 +1173,7 @@
(let [full-path (into [::db/editing-reaction]
path-path)
path-before (get-in db full-path)
{:keys [next-keys]} (rfns/analyze-path
{:keys [next-keys]} (rpath/analyze-path
path-before)
parent-path (butlast full-path)]
(-> db
Expand Down Expand Up @@ -1263,7 +1264,7 @@
keys
(->> (map name)))
{:keys [path] :as clause} (get-in db full-path)
{:keys [leaf-type]} (rfns/analyze-path path)]
{:keys [leaf-type]} (rpath/analyze-path path)]
(case set-to
"val"
(assoc-in db
Expand Down
130 changes: 5 additions & 125 deletions src/com/yetanalytics/lrs_admin_ui/spec/reaction.cljs
Original file line number Diff line number Diff line change
@@ -1,145 +1,25 @@
(ns com.yetanalytics.lrs-admin-ui.spec.reaction
"Duplicates lrsql.spec.reaction" ;; TODO: Use a common cljc source
(:require [cljs.spec.alpha :as s :include-macros true]
[xapi-schema.spec :as xs]
[com.yetanalytics.lrs-admin-ui.functions.reaction :as rfns]))

(s/def ::condition-name
string?)

(s/def ::path
(s/every
(s/or :string string?
:index nat-int?)
:gen-max 4))

(s/def ::val (s/or :string string?
:number number?
:null nil?
:boolean boolean?))

(s/def :ref/condition ::condition-name)

(s/def ::ref
(s/keys :req-un [:ref/condition
::path]))

(s/def ::op
#{"gt"
"lt"
"gte"
"lte"
"eq"
"noteq"
"like"
"contains"})

(defn- valid-like-val?
[{:keys [op
ref
;; note that val is conformed here
val]}]
(if (= op "like")
(if-let [{ref-path :path} ref]
(let [{:keys [leaf-type]} (rfns/analyze-path ref-path)]
(= 'string leaf-type))
(= :string
(first val)))
true))

(defn- valid-clause-path?
[{:keys [path
op
val
ref] :as clause}]
(if path
(let [{:keys [valid?
leaf-type
next-keys]} (rfns/analyze-path path)]
(and valid?
(if (= "contains" op)
(= '[idx] next-keys)
(and leaf-type
(or
(= 'json leaf-type) ;; anything goes
(if-let [{ref-path :path} ref]
(let [{ref-leaf-type :leaf-type}
(rfns/analyze-path ref-path)]
(= leaf-type ref-leaf-type))
(= (name leaf-type)
(name (first val)))))))))
true))

(s/def ::condition
(s/and
(s/keys :req-un
[(or
(and ::path ::op
(or ::val ::ref))
(or ::and ::or ::not))])
valid-like-val?
valid-clause-path?))

(s/def ::and (s/every ::condition
:min-count 1
:gen-max 3))
(s/def ::or (s/every ::condition
:min-count 1
:gen-max 3))
(s/def ::not ::condition)

(s/def ::conditions
(s/map-of simple-keyword?
::condition
:min-count 1
:gen-max 3))

(defn- valid-identity-path?
[path]
(some? (:leaf-type (rfns/analyze-path path))))

(s/def ::identityPaths
(s/every (s/and ::path
valid-identity-path?)))

;; A JSON structure resembling a statement, but with path refs to cond results
(s/def ::template ::xs/any-json)

(s/def ::ruleset
(s/keys :req-un [::identityPaths
::conditions
::template]))
[com.yetanalytics.lrs-reactions.spec :as rs]))

;; Representation
(s/def ::id string?)
(s/def ::active boolean?)
(s/def ::created string?)
(s/def ::modified string?)

(s/def :lrsql.spec.reaction.error/type
#{"ReactionQueryError"
"ReactionTemplateError"
"ReactionInvalidStatementError"})

(s/def :lrsql.spec.reaction.error/message string?)

(s/def ::error
(s/nilable
(s/keys :req-un [:lrsql.spec.reaction.error/type
:lrsql.spec.reaction.error/message])))

(s/def ::title string?)

(s/def ::reaction
(s/keys :req-un [::id
::title
::ruleset
::active
::rs/ruleset
::rs/error
::created
::modified
::error]))
::modified]))

(s/def ::new-reaction
(s/keys :req-un [::title
::ruleset
::rs/ruleset
::active]))
Loading

0 comments on commit d43b455

Please sign in to comment.