Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
201 lines (157 sloc) 6.62 KB
(ns xstandard.core
"A really simple abstraction on top of saxon.
xstandard works with assertions lists that are applyied against a XML.
An assertion is set with a message to show if it fails, a path to select the node(s) (an xpath expression) and a
validate function that receives the current node as argument to be validated."
(:use [hiccup.core :only [html]]
[clojure.contrib.def :only [name-with-attributes]]
[clojure.java.io :only [file]])
(:require [saxon :as xml]))
(xml/set-config-property! :line-numbering true)
(defonce ^{:doc "Default prefix/namespace used by xstandard"}
*nss* {:xsd "http://www.w3.org/2001/XMLSchema"})
(defn get-attr
"Return the `attr` value of `n`. Uses the xpath `data(./name)`.
Usage: `(get-attr n \"name\")`. Returns the attribute name if present."
[n attr]
(xml/query (str "data(./@" attr ")") n))
(defn attr-present
"`true` if the `attr` is present on `n`.
Usage: `(attr-present \"targetNamespace\")`."
[attr]
(fn [n]
(xml/query (str "exists(./@" attr ")") n)))
(defn attr-eq
"`true` if the `attr` of `n` is equal to `v`"
[attr v]
(fn [n]
(= (get-attr n attr) v)))
(defn attr-matches
"Validates the format of a given node `n` against `regex`."
[attr regex]
(fn [n]
(not (nil? (re-matches regex (get-attr n attr))))))
(defn make-xml
"Utility to help build xml from file path. For file only.
`p` is the xml absolute path."
[p]
(xml/compile-xml (file p)))
(defn- line
"Wrapps the call to `.getLineNumber` in the current node `n`."
[n]
(.getLineNumber n))
(defn make-assertion
"# Actually builds an assertion as fn.
fn get the namespaces and a single node selected by any other part of the code. The result is:
{:assertion assertion name as symbol
:status true or false ;true the node passed, false otherwise.
:display-name resunting name
:details {:result-msg formated result message.
:line the node line
:path to the node}}.
Note however, that details will be returned for failed nodes."
[aname p & {:keys [validator msg display-name]}]
(fn [nss n]
(let [display-name-exp (xml/compile-xpath (or display-name "data(./@name)") nss)
p-exp (xml/compile-xpath p nss)
result-msg (cond (empty? msg) "Assertion failed."
:else (format msg (display-name-exp n)))
line-number (line n)
result-status (validator n)]
{:assertion aname
:status result-status
:display-name (or (display-name-exp n) (.toString (xml/node-name n)))
:details
{:result-msg (if result-status "" result-msg)
:line line-number
:path (xml/node-path n)}})))
(defmacro defassertion
"# An assertion is supposed to be created. See *default-assertions*
A name should be passed to label the assertion as Var.
Assertions becomes Vars in the namespace.
`p` is the string path (in xpath) to the node(s).
`options` can be:
`:msg` message to be formated. Can take only one parameter (the node name) - mandatory
`:validator` a function that takes the current node - mandatory
`:display-name` a valid xpath or string to format msg with the right valie - optional"
[name p & options]
(let [[name options] (name-with-attributes name options)]
`(do
(def ~name {:path ~p :assertion (make-assertion ~(keyword name) ~p ~@options)})
~name)))
(defn make-assertions
"# Actually builds a set of assertions.
To optimize the performance, all assertions are grouped by path. That is,
defassertions should produce something like:
{:set-name myAssertions
:assertions {/xsd:schema (a b),
//xsd:element (c)}
Where `a`, `b` and `c` are assertions defined by `defassertion` macro."
[n assertions]
(loop [as assertions
fs {:set-name n}]
(if (empty? as)
fs
(let [[c & rest] as
p (:path c)
a (:assertion c)]
(recur rest (update-in fs [:assertions p] #(cons a %)))))))
(defmacro defassertions
"A macro to prepare the definition of a set of assertions.
name is the name of the set and a* the assertions. i.e.:
(defassertions my-set (defassertion ...) (defassertion ...))"
[name & a]
(let [[name a] (name-with-attributes name a)
sname (str name)]
`(do
(def ~name (make-assertions ~sname (list ~@a)))
~name)))
(defn run
"Run every assertion path againts the xmldocument and applies every found node to every
assertion set for that path.
`aset` is generated by `defassertions`, `nss` is a map of prefix/namespace uri and `xmldoc` is the loaded xml. "
[aset nss xmldoc]
(flatten
(for [[p a] (:assertions aset)]
(for [i a]
(for [n (flatten (list (xml/query p nss xmldoc)))]
(i nss n))))))
;# Default assertions provided by xstandard.
(defassertions *default-assertions*
;; - `element-name`: any element with `name` attribute should respect `[a-z].*`.
(defassertion element-name "//xsd:element[@name]"
:msg "element %s does not match [a-z].*."
:validator (attr-matches "name" #"[a-z].*")
:display-name "data(./@name)")
;; - `type-name`: any complexType with `name` attribute should respect `[A-Z].*Type`.
(defassertion type-name "//xsd:complexType[@name]"
:msg "type %s does not match [A-Z].*Type."
:validator (attr-matches "name" #"[A-Z].*Type")
:display-name "data(./@name)")
;; - `element-form-default`: the `elementFormDefault` attribute should be `qualified`.
(defassertion element-form-default "/xsd:schema"
:msg "schema hasn't attr elementFormDefault=\"qualified\""
:validator (attr-eq "elementFormDefault" "qualified"))
;; - `target-ns`: `targetNamespace` attribute should be present.
(defassertion target-ns "/xsd:schema"
:msg "schema hasn't targetNamespace attr"
:validator (attr-present "targetNamespace")))
(defmacro as-html
"Simply wrapps the execution of run with html output."
[file-name & f]
`(spit ~file-name (html [:html
[:head
[:title "xstandard assertion result."]]
[:body
[:h2 {:class "header"} "Assertion result."]
[:table {:class "result-table" :border 1}
[:tr {:class "result-head"}
[:th "Assertion"] [:th "Status"] [:th "Node"] [:td "Message"] [:td "Line"] [:td "Path"]]
(for [r# ~@f]
[:tr
[:td (:assertion r#)]
[:td (if (:status r#) "Passed" "Failed")]
[:td (:display-name r#)]
[:td (:result-msg (:details r#))]
[:td (:line (:details r#))]
[:td (:path (:details r#))]])]]])))