Add validator for writing sam.

src/cljam/io/sam/util/validator.clj

@@ -0,0 +1,191 @@
+(ns cljam.io.sam.util.validator)
+
+(defn- error [path msg & args]
+  {:errors {path [(apply format msg args)]}})
+
+(defn- merge-validation-results
+  ([] nil)
+  ([res] res)
+  ([res1 res2]
+   (letfn [(rec [x y]
+             (cond (nil? x) y
+                   (nil? y) x
+                   (map? x) (merge-with rec x y)
+                   :else (into x y)))]
+     (rec res1 res2)))
+  ([res1 res2 res3 & more]
+   (reduce (fn [res res']
+             (merge-validation-results res res'))
+           res1
+           (list* res2 res3 more))))
+
+(defn- validate-pos* [rname pos refmap]
+  (let [max-len (get-in refmap [rname :LN])]
+    (cond
+      (not (integer? pos)) ["Must be integer."]
+      (not (<= 0 (int pos) Integer/MAX_VALUE))
+      ["Must be in the [0, 2147483647]."]
+
+      (and max-len
+           (> (int pos) (int max-len)))
+      [(format "Must be less than or equal %d." max-len)])))
+
+(defn- validate-pos [{:keys [refmap]} {:keys [pos rname]}]
+  (when-let [err (validate-pos* rname pos refmap)]
+    (apply error :pos err)))
+
+(defn- validate-pnext [{:keys [refmap]} {:keys [pnext rname]}]
+  (when-let [err (validate-pos* rname pnext refmap)]
+    (apply error :pnext err)))
+
+(defn- validate-rname* [rname refmap]
+  (cond
+    (not (string? rname)) ["Must be string."]
+    (and (not (= rname "*"))
+         (not (get refmap rname)))
+    [(format "Must be not in header.(%s)" rname)]))
+
+(defn- validate-rname [{:keys [refmap]} {:keys [rname]}]
+  (when-let [err (validate-rname* rname refmap)]
+    (apply error :rname err)))
+
+(defn- validate-rnext [{:keys [refmap]} {:keys [rnext]}]
+  (when-let [err (validate-rname* rnext refmap)]
+    (error :rnext err)))
+
+(defn- validate-qname [_ {:keys [qname]}]
+  (if (not (string? qname))
+    (error :qname "Must be string.")
+    (when-let [res
+               (cond-> nil
+                 (not (<= (count qname) 254))
+                 (conj "Must be less than or equal to 254 characters.")
+
+                 (not (re-matches #"^[!-?A-~]+$" qname))
+                 (conj "Must not contain illegal characters."))]
+      {:errors {:qname res}})))
+
+(defn- validate-mapq [_ {:keys [mapq]}]
+  (cond
+    (not (integer? mapq)) (error :mapq "Must be integer.")
+    (not (<= 0 (int mapq) 255))
+    (error :mapq "Must be in the [0-255].")))
+
+(defn- validate-cigar [_ {:keys [cigar]}]
+  (cond
+    (not (string? cigar)) (error :cigar "Must be string.")
+    (not (re-matches #"^\*|([0-9]+[MIDNSHPX=])+$" cigar))
+    (error :cigar "Invalid format.")))
+
+(defn- validate-tlen [_ {:keys [tlen]}]
+  (cond
+    (not (integer? tlen)) (error :tlen "Must be integer.")
+    (not (<= (- Integer/MAX_VALUE) tlen Integer/MAX_VALUE))
+    (error :tlen "Must be in the [-2147483647,2147483647].")))
+
+(defn- validate-qual [_ {:keys [qual]}]
+  (cond
+    (not (string? qual)) (error :qual "Must be string.")
+    (not (re-matches #"[!-~]+" qual)) (error :qual "Must not contain bad character.")))
+
+(defn- validate-seq [_ {:keys [seq]}]
+  (cond
+    (not (string? seq)) (error :seq "Must be string.")
+    (not (re-matches #"\*|[A-Za-z=.]+" seq)) (error :seq "Must not contain bad character.")))
+
+(defn- validate-option [{:keys [type value]}]
+  (case type
+    "A" (when-not (and (char? value) (<= (int \!) (int value) (int \~)))
+          ["Must be char [!-~]."])
+    "i" (when-not (and (integer? value) (<= -32767 value 32767))
+          ["Must be 16 bit signed integer."])
+    "f" (when-not (or (float? value) (integer? value))
+          ["Must be float."])
+    "Z" (when-not (and (string? value) (re-matches #"[ !-~]*" value))
+          ["Must be printing string [ !-~]*"])
+    "H" (when-not (and (sequential? value)
+                       (every? (every-pred integer?  #(<= -255 (int %) 255))
+                               value))
+          ["Must be byte array."])
+    "B" (when-not (and (string? value)
+                       (re-matches #"[cCsSiIf](,[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?)*"
+                                   value))
+          ["Must be Integer or numeric array string."])
+    [(format "Type %s is invalid" (str type))]))
+
+(defn- validate-options [_ {:keys [options]}]
+  (map-indexed #(when-let [err (validate-option %2)]
+                  (apply error [:options %1] err))
+               options))
+
+(defn- validate-data-record [validator alignment]
+  (if (map? alignment)
+    (let [f (juxt validate-qname
+                  validate-rname
+                  validate-rnext
+                  validate-pos
+                  validate-pnext
+                  validate-mapq
+                  validate-cigar
+                  validate-qual
+                  validate-tlen
+                  validate-seq)]
+      (apply  merge-validation-results
+              (concat (f validator alignment)
+                      (validate-options validator alignment))))
+    (error [] (str "Variant must be a map, but got " (pr-str alignment)))))
+
+(defn make-validator
+  ([header] (make-validator header {}))
+  ([header {:keys [file-type] :or {file-type :sam}}]
+   {:file-type file-type
+    :refmap (into {} (map (juxt :SN identity) (:SQ header)))}))
+
+(defn validate-alignment
+  [validator alignment]
+  (let [res (validate-data-record validator alignment)]
+    (when (seq res)
+      (assoc res :alignment alignment))))
+
+(defn validate-alignments
+  ([validator]
+   (keep (partial validate-alignment validator)))
+  ([validator alignments]
+   (sequence (validate-alignments validator) alignments)))
+
+(defn- stringify-validation-result-messages [m]
+  (with-out-str
+    (doseq [[i [path msgs]] (map-indexed vector m)
+            :let [path' (str path)
+                  indent (apply str (repeat (+ (count path') 4) \space))]]
+      (when (not= i 0) (newline))
+      (printf " - %s: %s" path (first msgs))
+      (doseq [msg (rest msgs)]
+        (newline)
+        (printf "%s %s" indent msg)))))
+
+(defn check-alignment
+  [validator alignment]
+  (let [{:keys [warnings errors] v :alignment :as res} (validate-alignment validator alignment)]
+    (when warnings
+      (binding [*out* *err*]
+        (printf "Variant validation warning at %s\n%s"
+                (pr-str (cond-> v
+                          (map? v)
+                          (select-keys [:chr :pos :id :ref :alt])))
+                (stringify-validation-result-messages warnings))
+        (newline)))
+    (when errors
+      (let [msg (format "Variant validation error at %s\n%s"
+                        (pr-str (cond-> v
+                                  (map? v)
+                                  (select-keys [:chr :pos :id :ref :alt])))
+                        (stringify-validation-result-messages errors))]
+        (throw (ex-info msg res))))
+    alignment))
+
+(defn check-alignments
+  ([validator]
+   (map (partial check-alignment validator)))
+  ([validator alignments]
+   (sequence (check-alignments validator) alignments)))

test/cljam/io/sam/util/validator_test.clj

@@ -0,0 +1,96 @@
+(ns cljam.io.sam.util.validator-test
+  (:require [clojure.test :refer [deftest is are testing]]
+            [cljam.io.sam.util.validator :as validator]))
+
+(deftest validate-option-test
+  (testing "bad type"
+    (is (= (#'validator/validate-option {:type "!" :value \!})
+           ["Type ! is invalid"])))
+  (testing "type A"
+    (is (nil? (#'validator/validate-option {:type "A" :value \!})))
+    (is (= (#'validator/validate-option {:type "A" :value 100})
+           ["Must be char [!-~]."])))
+  (testing "type i"
+    (is (nil? (#'validator/validate-option {:type "i" :value 10})))
+    (is (= (#'validator/validate-option {:type "i" :value "10"})
+           ["Must be 16 bit signed integer."]))
+    (is (= (#'validator/validate-option {:type "i" :value 100000000})
+           ["Must be 16 bit signed integer."])))
+  (testing "type f"
+    (is (nil? (#'validator/validate-option {:type "f" :value 10})))
+    (is (nil? (#'validator/validate-option {:type "f" :value 10.1})))
+    (is (= (#'validator/validate-option {:type "f" :value "A"})
+           ["Must be float."])))
+  (testing "type Z"
+    (is (nil? (#'validator/validate-option {:type "Z" :value "!@abc"})))
+    (is (= (#'validator/validate-option {:type "Z" :value 10})
+           ["Must be printing string [ !-~]*"])))
+  (testing "type H"
+    (is (nil? (#'validator/validate-option {:type "H" :value [1,2]})))
+    (is (= (#'validator/validate-option {:type "H" :value "A"})
+           ["Must be byte array."])))
+  (testing "type B"
+    (is (nil? (#'validator/validate-option
+               {:type "B" :value "f,-0.3,0.0,0.3"})))
+    (is (= (#'validator/validate-option {:type "B" :value "W"})
+           ["Must be Integer or numeric array string."]))))
+
+(deftest validate-data-record-test
+  (let [validator (validator/make-validator {:SQ [{:SN "ref", :LN 45}]})
+        valid-align
+        {:rname "ref" :pos 10 :qname "a" :mapq 10 :cigar "16M"
+         :rnext "*" :tlen 0 :pnext 0 :seq "ATGC" :qual "*"
+         :options {}}]
+    (are [k v ans]
+         (= (get-in (#'validator/validate-data-record validator (assoc valid-align k v))
+                    [:errors k])
+            ans)
+      :qname 100  ["Must be string."]
+      :qname (apply str (repeat 255 \a))
+      ["Must be less than or equal to 254 characters."]
+
+      :qname "@@" ["Must not contain illegal characters."]
+
+      :qname (apply str (repeat 255 \@))
+      ["Must not contain illegal characters."
+       "Must be less than or equal to 254 characters."]
+
+      :rname 10 ["Must be string."]
+      :rname "NOT-FOUND" ["Must be not in header.(NOT-FOUND)"]
+      :pos "ABC" ["Must be integer."]
+      :pos 100000000 ["Must be less than or equal 45."]
+      :pos 46 ["Must be less than or equal 45."]
+      :pos -100 ["Must be in the [0, 2147483647]."]
+      :mapq "A" ["Must be integer."]
+      :mapq 300 ["Must be in the [0-255]."]
+      :cigar 10 ["Must be string."]
+      :cigar "3Y" ["Invalid format."]
+      :rname 10 ["Must be string."]
+      :pnext 100000000 ["Must be less than or equal 45."]
+      :pnext "A" ["Must be integer."]
+      :tlen -9900000000 ["Must be in the [-2147483647,2147483647]."]
+      :qual 10 ["Must be string."]
+      :qual "bad qual" ["Must not contain bad character."]
+      :seq 100 ["Must be string."]
+      :seq [\A \B] ["Must be string."]
+      :seq "A!TGC" ["Must not contain bad character."])
+    (is (= (get-in (#'validator/validate-data-record
+                    validator
+                    (assoc valid-align :options [{:type "!" :value \!}]))
+                   [:errors [:options 0]])
+           ["Type ! is invalid"]))))
+
+(deftest check-alignment-test
+  (is (thrown? clojure.lang.ExceptionInfo
+               (doall (validator/check-alignments
+                       (validator/make-validator {:SQ [{:SN "ref", :LN 45}]})
+                       [{:rname "ref" :pos 10000000
+                         :qname "a"
+                         :mapq 10 :cigar "16M" :rnext "*"
+                         :tlen 0 :pnext 0 :seq "ATGC"
+                         :qual "*" :options {}}]))))
+  (let [input [{:rname "ref" :pos 10 :qname "a" :mapq 10 :cigar "16M"
+                :rnext "*" :tlen 0 :pnext 0 :seq "ATGC" :qual "*"
+                :options {}}]]
+    (is (= (validator/check-alignments (validator/make-validator {:SQ [{:SN "ref", :LN 45}]}) input)
+           input))))