simon/squirrel-parse
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

#7 It works, but it isn't actually useful

Browse source 
The problem is that bouncer doesn't seem really to support the idea that an object may satisfy one of a set of validations, and that's OK; and it doesn't seem to support collecting nested errors through custom validators.

So although this will now tell you *that* an adl structure is invalid, it won't tell you *where* the document is invalid.
This commit is contained in:
Simon Brooke 2018-03-20 13:22:08 +00:00
parent d5d26db037
commit 8e63f4b6c9
2 changed files with 151 additions and 75 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/squirrel_parse/to_adl.clj
View file

@ -115,7 +115,7 @@
{:tag :prompt {:tag :prompt
:attrs :attrs
{:prompt name {:prompt name
:local "en-GB"}}}}}}))) :locale "en-GB"}}}}}})))
(defn make-entity-map [table-decl] (defn make-entity-map [table-decl]

224
src/squirrel_parse/validator.clj
View file

@ -2,7 +2,6 @@
:author "Simon Brooke"} :author "Simon Brooke"}
squirrel-parse.validator squirrel-parse.validator
(:require [clojure.set :refer [union]] (:require [clojure.set :refer [union]]
[clojure.string :as s]
[bouncer.core :as b] [bouncer.core :as b]
[bouncer.validators :as v])) [bouncer.validators :as v]))
@ -30,7 +29,37 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; this is a fairly straight translation of the ADL 1.4 DTD into Clojure (defn disjunct-validate
;; OK, so: most of the validators will (usually) fail, and that's OK. How
;; do we identify the one which ought not to have failed?
[o & validations]
(let
[rs (map
#(b/validate o %)
validations)]
;; if *any* succeeded, we succeeded
;; otherwise, one of these is the valid error - but which? The answer, in my case
;; is that if there is any which did not fail on the :tag check, then that is the
;; interesting one. But generally?
(empty? (remove :tag (map first rs)))))
(v/defvalidator disjunct-validator
;; OK, so: most of the validators will (usually) fail, and that's OK. How
;; do we identify the one which ought not to have failed?
{:optional false}
[value & validations]
(let
[rs (map
#(b/validate value %)
validations)]
;; if *any* succeeded, we succeeded
;; otherwise, one of these is the valid error - but which? The answer, in my case
;; is that if there is any which did not fail on the :tag check, then that is the
;; interesting one. But generally?
(empty? (remove :tag (map first rs)))))
;;; the remainder of this file is a fairly straight translation of the ADL 1.4 DTD into Clojure
(declare fieldgroup-validations) (declare fieldgroup-validations)
@ -241,9 +270,9 @@
{:tag [v/required [#(= % :generator)]] {:tag [v/required [#(= % :generator)]]
[:attrs :action] [v/string v/required [v/member generator-actions]] [:attrs :action] [v/string v/required [v/member generator-actions]]
[:attrs :class] v/string [:attrs :class] v/string
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % documentation-validations) documentation-validations
(b/valid? % param-validations))]]}) param-validations)]]})
(def in-implementation-validations (def in-implementation-validations
@ -354,23 +383,26 @@
[:attrs :distinct] [v/string [v/member #{"none", "all", "user", "system"}]] [:attrs :distinct] [v/string [v/member #{"none", "all", "user", "system"}]]
[:attrs :entity] v/string [:attrs :entity] v/string
[:attrs :farkey] v/string [:attrs :farkey] v/string
[:attrs :required] v/boolean [:attrs :required] [[v/member #{"true", "false"}]]
[:attrs :immutable] v/boolean [:attrs :immutable] [[v/member #{"true", "false"}]]
[:attrs :size] [[#(if [:attrs :size] [[#(cond
(empty? %) ;; it's allowed to be missing
true
(string? %) (string? %)
(integer? (read-string %)) (integer? (read-string %))
true
(integer? %))]] (integer? %))]]
[:attrs :column] v/string [:attrs :column] v/string
[:attrs :concrete] v/boolean [:attrs :concrete] [[v/member #{"true", "false"}]]
[:attrs :cascade] [[v/member cascade-actions]] [:attrs :cascade] [[v/member cascade-actions]]
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % documentation-validations) documentation-validations
(b/valid? % generator-validations) generator-validations
(b/valid? % permission-validations) permission-validations
(b/valid? % option-validations) option-validations
(b/valid? % prompt-validations) prompt-validations
(b/valid? % help-validations) help-validations
(b/valid? % ifmissing-validations))]]}) ifmissing-validations)]]})
(def permission-validations (def permission-validations
@ -418,7 +450,7 @@
* `dangerous` true if this verb causes a destructive change." * `dangerous` true if this verb causes a destructive change."
{:tag [v/required [#(= % :verb)]] {:tag [v/required [#(= % :verb)]]
[:attrs :verb] [v/string v/required] [:attrs :verb] [v/string v/required]
[:attrs :dangerous] [v/boolean v/required]}) [:attrs :dangerous] [[v/member #{"true", "false"}] v/required]})
(def order-validations (def order-validations
"an ordering or records in a list "an ordering or records in a list
@ -472,36 +504,35 @@
{:tag [v/required [#(= % :form)]] {:tag [v/required [#(= % :form)]]
[:attrs :name] [v/required v/string] [:attrs :name] [v/required v/string]
[:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]] [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
[:attrs :canadd] v/boolean [:attrs :canadd] [[v/member #{"true", "false"}]]
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % documentation-validations) documentation-validations
(b/valid? % head-validations) head-validations
(b/valid? % top-validations) top-validations
(b/valid? % foot-validations) foot-validations
(b/valid? % field-validations) field-validations
(b/valid? % fieldgroup-validations) fieldgroup-validations
(b/valid? % auxlist-validations) auxlist-validations
(b/valid? % verb-validations) verb-validations
(b/valid? % permission-validations) permission-validations
(b/valid? % pragma-validations))]]}) pragma-validations)]]})
(def page-validations (def page-validations
"a page on which an entity may be displayed" "a page on which an entity may be displayed"
{:tag [v/required [#(= % :page)]] {:tag [v/required [#(= % :page)]]
[:attrs :name] [v/required v/string] [:attrs :name] [v/required v/string]
[:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]] [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % documentation-validations) documentation-validations
(b/valid? % head-validations) head-validations
(b/valid? % top-validations) top-validations
(b/valid? % foot-validations) foot-validations
(b/valid? % field-validations) field-validations
(b/valid? % fieldgroup-validations) fieldgroup-validations
(b/valid? % auxlist-validations) auxlist-validations
(b/valid? % verb-validations) verb-validations
(b/valid? % permission-validations) permission-validations
(b/valid? % pragma-validations) pragma-validations)]]})
)]]})
(def list-validations (def list-validations
"a list on which entities of a given type are listed "a list on which entities of a given type are listed
@ -512,19 +543,18 @@
[:attrs :name] [v/required v/string] [:attrs :name] [v/required v/string]
[:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]] [:attrs :properties] [v/required [v/member #{"all", "user-distinct", "listed"}]]
[:attrs :onselect] v/string [:attrs :onselect] v/string
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % documentation-validations) documentation-validations
(b/valid? % head-validations) head-validations
(b/valid? % top-validations) top-validations
(b/valid? % foot-validations) foot-validations
(b/valid? % field-validations) field-validations
(b/valid? % fieldgroup-validations) fieldgroup-validations
(b/valid? % auxlist-validations) auxlist-validations
(b/valid? % verb-validations) verb-validations
(b/valid? % permission-validations) permission-validations
(b/valid? % pragma-validations) pragma-validations
(b/valid? % order-validations) order-validations)]]})
)]]})
(def key-validations (def key-validations
{:tag [v/required [#(= % :key)]] {:tag [v/required [#(= % :key)]]
@ -550,18 +580,17 @@
[:attrs :name] [v/required v/string] [:attrs :name] [v/required v/string]
[:attrs :natural-key] v/string [:attrs :natural-key] v/string
[:attrs :table] v/string [:attrs :table] v/string
[:attrs :foreign] v/boolean [:attrs :foreign] [[v/member #{"true", "false"}]]
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % documentation-validations) documentation-validations
(b/valid? % prompt-validations) prompt-validations
(b/valid? % content-validations) content-validations
(b/valid? % key-validations) key-validations
(b/valid? % property-validations) property-validations
(b/valid? % permission-validations) permission-validations
(b/valid? % form-validations) form-validations
(b/valid? % page-validations) page-validations
(b/valid? % list-validations) list-validations)]]})
)]]})
(def application-validations (def application-validations
{:tag [v/required [#(= % :application)]] {:tag [v/required [#(= % :application)]]
@ -569,15 +598,62 @@
[:attrs :version] v/string [:attrs :version] v/string
[:attrs :revision] v/string [:attrs :revision] v/string
[:attrs :currency] v/string [:attrs :currency] v/string
:content [[v/every #(or :content [[v/every #(disjunct-validate %
(b/valid? % specification-validations) specification-validations
(b/valid? % documentation-validations) documentation-validations
(b/valid? % content-validations) content-validations
(b/valid? % typedef-validations) typedef-validations
(b/valid? % group-validations) group-validations
(b/valid? % entity-validations))]]}) entity-validations)]]})
;; the good news: it's complete. ;; the good news: it's complete.
;; the bad news: it doesn't yet work. ;; the bad news: it doesn't yet work.
;; TODO: write a function which takes the output of bouncer.core.validate and filters out the paths to those bits which failed. ;; TODO: write a function which takes the output of bouncer.core.validate and filters out the paths to those bits which failed.
(defn find-keys
[o p]
(cond
(map? o)
(reduce
merge
{}
(map
(fn [k]
(let [tail (find-keys (o k) p)] ;; error is here
(cond
(not (empty? tail))
{k tail}
(p k)
{k (o k)}
true
{})))
(keys o)))
(coll? o)
(remove empty? (map #(find-keys % p) o))))
(defn walk-find-keys
[o p]
(walk
#(do %)
#(cond
(map? %)
(reduce
{}
(remove
empty?
(map
(fn [k]
(cond
(p k)
{k (% k)}
(walk-find-keys (% k) p)
{k (walk-find-keys (% k) p)}))
(keys %))))
(coll? %)
(remove
empty?
(map
(fn [e]
(walk-find-keys e p))
%)))
o))