Query update, demo.

src/anseml/dom/query.clj

@@ -6,6 +6,13 @@
 
 (declare ^:dynamic *pred-elem*)
 
+(defn- supported-primitive?
+  "Checks whether the value type is supported.
+  Currently supported types: string, integer, float."
+  [value]
+  (let [supported-primitives (list string? integer? float?)]
+    ((apply some-fn supported-primitives) value)))
+
 (defn- element-zipper [elem]
   (z/zipper
     element?
@@ -151,19 +158,61 @@
         path (z/next (z/seq-zip path))]
     (iter path elem)))
 
-(def root (create-element `(:root
-                             {:attr1 "attr1-val"
-                              :attr2 "attr2-val"}
-                             "value"
-                             (:inner1
-                               {:tag "tag1"}
-                               (:root "inner-root1"))
-                             (:inner1
-                               {:tag "tag2"
-                                :width 1}
-                               (:root "inner-root2"))
-                             (:inner2)
-                             "after-inner")))
+(defn update-doc
+  "The `loc` must be a zipper obtained by a previous call to `query`.
+  `action` is one of the following keywords:
+  :insert-child      -- xs must be an inserted child
+  :insert-after      -- xs must be an inserted child
+  :insert-before     -- xs must be an inserted child
+  :update-value      -- xs must be a function :: value -> value
+  :update-attributes -- xs must be a function :: attrs -> attrs"
+  [loc action & xs]
+  {:pre [(keyword? action)]}
+  (let [arg (first xs)]
+    (case action
+      :insert-child (if (or (supported-primitive? arg)
+                            (element? arg))
+                      (z/insert-child loc arg)
+                      (throw (IllegalArgumentException. (str "Unsupported value type " arg "."))))
+      :insert-after (if (or (supported-primitive? arg)
+                            (element? arg))
+                      (z/insert-right loc arg)
+                      (throw (IllegalArgumentException. (str "Unsupported value type " arg "."))))
+      :insert-before (if (or (supported-primitive? arg)
+                             (element? arg))
+                       (z/insert-left loc arg)
+                       (throw (IllegalArgumentException. (str "Unsupported value type " arg "."))))
+      :update-value (z/edit loc #(set-value % (arg (get-value %))))
+      :update-attributes (z/edit loc #(set-attrs % (arg (get-attrs %)))))))
+
+(defn apply-update
+  "The `loc` must be a zipper obtained by a previous call to `query`."
+  [loc]
+  (z/root loc))
+
+;(def root (create-element `(:root
+;                             {:attr1 "attr1-val"
+;                              :attr2 "attr2-val"}
+;                             "value"
+;                             (:inner1
+;                               {:tag "tag1"}
+;                               (:root "inner-root1"))
+;                             (:inner1
+;                               {:tag "tag2"
+;                                :width 1}
+;                               (:root "inner-root2"))
+;                             (:inner2)
+;                             "after-inner")))
+;
+;(doall (map println (-> root
+;                        (query "./:inner1 @(= :width 1)/")
+;                        first
+;                        (update-doc :insert-child "inserted-child")
+;                        (update-doc :insert-before "inserted-before")
+;                        (update-doc :insert-after "inserted-after")
+;                        (update-doc :update-value (fn [x] '()))
+;                        (update-doc :update-attributes (fn [x] {}))
+;                        z/root)))
 
 ;(doall (map println (-> root
 ;                        (query "./:inner1 @(= :width 1)/")

src/anseml/sax/transformation.clj

@@ -1,5 +1,6 @@
 (ns anseml.sax.transformation
-  (:require [anseml.sax.parser :as sax]))
+  (:require [anseml.sax.parser :as sax])
+  (:import (java.io BufferedReader)))
 
 (def ^:dynamic
   ^{:doc "Bind to true if you want write to use tabs instead of spaces"}

test/anseml/demo.clj

@@ -0,0 +1,96 @@
+(ns anseml.demo
+  (:require [anseml.core :refer :all])
+  (:import (java.io BufferedReader StringReader)))
+
+(def example-element
+  (anseml.dom.model/create-element
+    '(:html
+       (:head (:title "Your title here"))
+       (:body {:bgcolor "FFFFFF"}
+         (:center (:img {:src "brokenImg.png"
+                         :align "bottom"}))
+         (:hr
+           (:a {:href "http://somegreatsite.com"} "Link Name")
+           "is a link to another nifty site"
+           (:h1 "This is a Header")
+           (:h2 "This is a Medium Header")
+           "Send me mail at " (:a {:href "mailto:[email protected]"} "[email protected]")
+           (:p "This is a new paragraph!")
+           (:p (:b "This is a new paragraph!"))
+           (:br) (:b (:i "This is a new sentence without a paragraph break, in bold italics")))))))
+
+; Write to file
+(with-open [w (clojure.java.io/writer  "demo_output.txt")]
+  (binding [*out* w]
+    (anseml.dom.writer/write example-element)))
+
+; Read file
+(let [dom-file (with-open [rdr (clojure.java.io/reader "demo_output.txt")]
+                 (anseml.dom.parser/parse rdr))
+      sax-file (with-open [rdr (clojure.java.io/reader "demo_output.txt")]
+                 (anseml.sax.parser/parse-lazy-seq rdr))]
+  (println (if (= dom-file example-element)
+             "Files are equal"))
+  (println (type sax-file)))
+
+; Transform to HTML DOM
+(with-open [w (clojure.java.io/writer  "demo_output_dom.html")]
+  (binding [*out* w]
+    (anseml.dom.transformation/transform-to-html example-element)))
+
+; Transform to HTML SAX
+(with-open [w (clojure.java.io/writer  "demo_output_sax.html")
+            rdr (clojure.java.io/reader "demo_output.txt")]
+  (binding [*out* w]
+    (anseml.sax.transformation/transform-to-html rdr)))
+
+; Fix broken image src attribute
+(let [fixed (-> example-element
+                (anseml.dom.query/query "//:img")
+                (first)
+                (anseml.dom.query/update-doc :update-attributes
+                                             (fn [attrs]
+                                               (assoc attrs :src "https://www.google.ru/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png")))
+                (anseml.dom.query/apply-update))]
+  (with-open [w (clojure.java.io/writer "demo_output_dom_fixed.html")]
+    (binding [*out* w]
+      (anseml.dom.transformation/transform-to-html fixed))))
+
+
+; Schema example
+(def schema (anseml.dom.model/create-element
+              '(:scm-schema
+                 (:scm-attribute {:tag "width"}
+                   (:scm-alternative
+                     :scm-string
+                     :scm-integer))
+
+                 (:scm-attribute {:tag "height"}
+                   :scm-integer)
+
+                 (:scm-element {:tag "inner"}
+                   :scm-string)
+
+                 (:scm-element {:tag "root"}
+                   (:scm-sequence
+                     :scm-string
+                     :inner)
+                   (:scm-attribute
+                     :width
+                     :height)))))
+
+(println (anseml.dom.schema/validate
+           (anseml.dom.schema/build-schema schema)
+           (anseml.dom.model/create-element
+             '(:root {:width  "1"
+                      :height 2}
+                "bla-bla"
+                (:inner
+                  "bla-bla")))))
+
+(println (anseml.sax.schema/validate
+           (anseml.sax.schema/build-schema schema)
+           (anseml.sax.parser/parse-lazy-seq
+             (BufferedReader.
+               (StringReader.
+                 "(:root {:width \"1\" :height 2}\n \"bla-bla\"\n (:inner\n \"bla-bla\"))")))))