Added testing, fixed factory/compiler and IdMapper bugs

build.boot

@@ -1,5 +1,5 @@
                                         ;-*- mode: Clojure;-*-
-(set-env! :resource-paths #{"src" "java"}
+(set-env! :resource-paths #{"src"}
           :dependencies '[[org.clojure/clojure "1.7.0-alpha4"]
                           [com.taoensso/timbre "3.3.1" :exclusions [com.taoensso/carmine]]
                           [org.clojure/core.typed "0.2.77"]
@@ -7,13 +7,16 @@
 
                           [boot-deps "0.1.2" :scope "test"]
                           [midje "1.6.3" :scope "test"]
-                          [zilti/boot-midje "0.1.1" :scope "test"]
+                          [adzerk/bootlaces "0.1.9" :scope "test"]
-                          [zilti/boot-typed "0.1.0" :scope "test"]])
+                          [zilti/boot-midje "0.1.2" :scope "test"]
+                          [zilti/boot-typed "0.1.1" :scope "test"]])
 
 (require '[zilti.boot-midje :refer [midje]]
-         '[zilti.boot-typed :refer [typed]])
+         '[zilti.boot-typed :refer [typed]]
+         '[adzerk.bootlaces :refer :all])
 
-(def +version+ "0.0.5-SNAPSHOT")
+(def +version+ "0.0.21-SNAPSHOT")
+(bootlaces! +version+)
 
 (task-options!
  pom {:project 'clojurefx
@@ -21,16 +24,21 @@
       :description "A Clojure JavaFX wrapper."
       :url "https://bitbucket.com/zilti/clojurefx"
       :scm {:url "https://bitbucket.com/zilti/clojurefx"}
-      :license {:name "GNU Lesser General Public License 3.0"
+      :license {"name" "GNU Lesser General Public License 3.0"
-                :url "http://www.gnu.org/licenses/lgpl-3.0.txt"}}
+                "url" "http://www.gnu.org/licenses/lgpl-3.0.txt"}}
- midje {:test-paths #{"test"}
+ midje {:test-paths #{"test"}}
-        :autotest true}
+ typed {:namespaces #{'clojurefx.clojurefx 'clojurefx.protocols 'clojurefx.scripting}}
- typed {:namespaces #{'clojurefx.blargh}}
  repl {:server true})
 
 (deftask develop
   []
+  (task-options!
+   midje {:autotest true})
+
+  (set-env! :resource-paths #{"src" "test"})
+  
   (comp (repl)
         (midje)
         (watch)
         (typed)))
+

src/clojurefx/clojurefx.clj

@@ -1,9 +1,10 @@
 (ns clojurefx.clojurefx
-  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile])
+  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send meta with-meta])
   (:require [clojure.core.typed :refer :all]
             [clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]]
             [taoensso.timbre :as timbre]
             [clojure.java.io :as io]
+            [clojure.zip :as zip]
             [clojurefx.protocols :refer :all]
             [clojure.java.io :refer :all]))
 
@@ -36,7 +37,7 @@ Runs the code on the FX application thread and waits until the return value is d
 
 (tc-ignore (timbre/refer-timbre))
 
-(import (javafx.scene.control Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
+(import (javafx.scene.control Labeled Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
                               MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion
                               TitledPane TabPane Tab TableColumnBase Labeled)
         (javafx.scene Node Scene Parent)
@@ -46,12 +47,7 @@ Runs the code on the FX application thread and waits until the return value is d
         (javafx.css Styleable)
         (java.util Collection))
 
-;; TODO This belongs elsewhere.
+;; TODO Use pred-substitute for tc-assert?
-(tc-ignore
- (defn load-fxml [filename]
-   (.load (javafx.fxml.FXMLLoader.) (-> filename io/resource io/input-stream))))
-
-;; TODO Use pred-substitute for tc-assert
 (defn tc-assert [clazz :- Class value :- Any & [message :- String]]
   (try (assert (instance? clazz value))
        (catch AssertionError e (tc-ignore (error (if message message "") e)
@@ -63,9 +59,29 @@ Runs the code on the FX application thread and waits until the return value is d
   (clojure.core.typed/pred* (quote clazz) 'clojurefx.clojurefx
                             (fn [arg] (boolean (instance? clazz arg)))))
 
+(defn pred-protocol [proto check]
+  (let [impls (keys (proto :impls))
+        check (type check)]
+    (reduce #(or %1 (isa? check %2)) false impls)))
+
+;;## Shadows
+
+(extend-protocol FXMeta
+  clojure.lang.IObj
+  (meta [this] (clojure.core/meta this))
+  (with-meta [this metadata] (clojure.core/with-meta this metadata))
+  Node
+  (meta [this] (.getUserData ^Node this))
+  (with-meta [this metadata] (.setUserData ^Node this metadata) this)
+  MenuItem
+  (meta [this] (.getUserData ^MenuItem this))
+  (with-meta [this metadata] (.setUserData ^MenuItem this metadata) this))
+
+;;## Standard
+
 (tc-ignore
  (extend-protocol FXValue
-   Label
+   Labeled
    (get-value [this] (.getText ^Label this))
    (set-value! [this value] (tc-assert String value) (.setText ^Label this ^String value) this)
    TextField
@@ -152,15 +168,6 @@ Runs the code on the FX application thread and waits until the return value is d
    (get-graphic [this] (.getGraphic ^Menu this))
    (set-graphic! [this graphic] (.setGraphic ^Menu this ^Node graphic))))
 
-(tc-ignore
- (extend-protocol clojure.lang.IObj
-   Node
-   (meta [this] (.getUserData ^Node this))
-   (withMeta [this metadata] (.setUserData ^Node this metadata) this)
-   MenuItem
-   (meta [this] (.getUserData ^MenuItem this))
-   (withMeta [this metadata] (.setUserData ^MenuItem this metadata) this)))
-
 (extend-protocol FXStyleSetter
   Node
   (set-style! [this style] (.setStyle ^Node this ^String style) this)
@@ -177,6 +184,8 @@ Runs the code on the FX application thread and waits until the return value is d
   (get-styleable-parent [this] (.getStyleableParent ^Styleable this))
   (get-type-selector [this] (.getTypeSelector ^Styleable this)))
 
+;;## Special Types
+
 (extend-type Stage
   FXStage
   (get-title [this] (.getTitle ^Stage this))
@@ -188,3 +197,31 @@ Runs the code on the FX application thread and waits until the return value is d
   FXScene
   (get-root [this] (.getRoot ^Scene this))
   (set-root! [this root] (.setRoot ^Scene this ^Parent root) this))
+
+;;## IdMapper
+(defn fxzipper [root]
+  (zip/zipper (fn branch? [node]
+                (or (pred-protocol FXParent node) (pred-protocol FXContainer node)))
+              (fn children [node]
+                (if (pred-protocol FXParent node)
+                  (into [] (get-subnodes node))
+                  [(get-content node)]))
+              (fn make-node [node children]
+                (if (pred-protocol FXParent node)
+                  (set-subnodes! node children)
+                  (set-content! node children)))
+              root))
+
+(defn get-node-by-id [graph id]
+  (loop [zipper (fxzipper graph)]
+    (cond (zip/end? zipper) nil
+          (= (get-id (zip/node zipper)) (name id)) (zip/node zipper)
+          :else (recur (zip/next zipper)))))
+
+(defn get-id-map [graph]
+  (loop [zipper (fxzipper graph)
+         ids {}]
+    (if (zip/end? zipper)
+      ids
+      (recur (zip/next zipper)
+             (assoc ids (keyword (get-id (zip/node zipper))) (zip/node zipper))))))

src/clojurefx/factory.clj

@@ -1,11 +1,12 @@
 (ns clojurefx.factory
-  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile])
+  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile meta with-meta])
   (:require [clojure.core.typed :refer :all]
-            [clojure.core.typed.unsafe :refer [ignore-with-unckecked-cast]]
+            [clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]]
             [taoensso.timbre :as timbre]
             [clojure.java.io :as io]
-            [clojurefx.clojurefx :refer :all]
+            [clojurefx.clojurefx :as fx]
-            [clojurefx.protocols :refer :all]))
+            [clojurefx.protocols :refer :all])
+  (:import (javafx.scene Scene Node Parent)))
 
 (tc-ignore (timbre/refer-timbre))
 
@@ -22,14 +23,23 @@
 (def setter second)
 
 (def translation-map
-  (atom {:text (with-meta [#'get-value #'set-value!] {:argument String :parent FXValue})
+  (atom {;;; FXValue
+         :text (with-meta [#'get-value #'set-value!] {:argument String :parent FXValue})
          :value (with-meta [#'get-value #'set-value!] {:argument Object :parent FXValue})
+         ;;; FXId
          :id (with-meta [#'get-id #'set-id!] {:argument String :parent FXId})
+         ;;; FXGraphic
          :graphic (with-meta [#'get-graphic #'set-graphic!] {:argument Node :parent FXGraphic})
+         ;;; FXContainer
          :content (with-meta [#'get-content #'set-content!] {:argument Node :parent FXContainer})
+         ;;; FXParent
          :children (with-meta [#'get-subnodes #'set-subnodes!] {:argument java.util.List :parent FXParent})
+         ;;; FXStyleSetter / FXStyleable
+         :style (with-meta [#'get-style #'set-style!] {:argument String :parent FXStyleable})
+         ;;; FXStage
          :title (with-meta [#'get-title #'set-title!] {:argument String :parent FXStage})
          :scene (with-meta [#'get-scene #'set-scene!] {:argument Scene :parent FXStage})
+         ;;; FXScene
          :root (with-meta [#'get-root #'set-root!] {:argument Parent :parent FXScene})}))
 
 (def mandatory-constructor-args

src/clojurefx/protocols.clj

@@ -1,7 +1,16 @@
 (ns clojurefx.protocols
-  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send])
+  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send meta with-meta])
   (:require [clojure.core.typed :refer :all]))
 
+;;## Shadows
+
+(defprotocol [[A :variance :covariant]]
+  FXMeta
+  (meta [this :- A] :- (Map Any Any))
+  (with-meta [this :- A metadata :- (Map Any Any)] :- A))
+
+;;## Standard
+
 (declare-protocols FXValue FXId FXParent)
 (defprotocol [[A :variance :covariant]
               [B :variance :covariant]]
@@ -54,6 +63,8 @@
 
 (defalias FXStyled (U FXStyleable FXStyleSetter))
 
+;;## Special Types
+
 (defprotocol [[A :variance :covariant :< javafx.stage.Stage]
               [B :variance :covariant :< javafx.scene.Scene]]
   FXStage

test/clojurefx/clojurefx_test.clj

@@ -1,13 +1,34 @@
 (ns clojurefx.clojurefx-test
-  (:refer-clojure :exclude [compile])
+  (:refer-clojure :exclude [compile meta with-meta])
+  (:require [clojurefx.factory :as factory]
+            [clojurefx.protocols :refer :all])
   (:use midje.sweet
         clojurefx.clojurefx))
 
-(def example-hierarchy
+(import (javafx.scene.layout VBox)
-  [:VBox {:id "VBox"
+        (javafx.scene.control ScrollPane Button Label))
-          :children [:Label {:text "Hi JavaFX!"}
-                     :Label {:text "Hi Clojure!"}]}])
 
-(fact "This compiles."
+;;## Element testing
-      (resolv-o-matic :Label) => javafx.scene.control.Label
+
-      (type (compile example-hierarchy)) => javafx.scene.layout.VBox)
+;;## IdMapper
+(def example-graph
+  (factory/compile
+   [VBox {:id "topBox"
+          :children [Button {:id "button"
+                             :text "Close"}
+                     ScrollPane {:content [Label {:id "label"
+                                                  :text "This rocks."}]}]}]))
+
+(facts "Id mapper"
+       (fact "Getting a top-level entry"
+             (type (get-node-by-id example-graph "topBox")) => javafx.scene.layout.VBox)
+       (fact "Getting an entry in an FXParent"
+             (type (get-node-by-id example-graph "button")) => javafx.scene.control.Button)
+       (fact "Getting an entry in an FXParent and an FXContainer"
+             (type (get-node-by-id example-graph "label")) => javafx.scene.control.Label)
+       (fact "Fetching the whole id map."
+             (map? (get-id-map example-graph)) => true)
+       (fact "Fetching label text from id-map."
+             (-> (get-id-map example-graph)
+                 :label
+                 get-value) => "This rocks."))

test/clojurefx/factory_test.clj

@@ -0,0 +1,31 @@
+(ns clojurefx.factory-test
+  (:refer-clojure :exclude [compile meta with-meta])
+  (:require [clojurefx.protocols :refer :all])
+  (:use midje.sweet
+        clojurefx.factory)
+  (:import (javafx.scene.control Button Label ScrollPane)
+           (javafx.scene.layout VBox)))
+
+(def fxml-node (atom nil))
+
+(facts "FXML loading"
+       (fact "Load the fxml file"
+             (type (reset! fxml-node (load-fxml "resources/test.fxml"))) => javafx.scene.layout.VBox)
+       (fact "Get VBox id"
+             (.getId @fxml-node) => "topBox"))
+
+(def example-graph
+  [VBox {:id "topBox"
+         :children [Button {:id "button"
+                            :text "Close"}
+                    ScrollPane {:content [Label {:id "label"
+                                                 :text "This rocks."}]}]}])
+
+(def scene-graph (atom nil))
+
+(facts "Vector compilation"
+       (fact "Simple element"
+             (type (compile [Label {:text "Hello ClojureFX"}])) => javafx.scene.control.Label)
+       (fact "Nested structure"
+             (type (reset! scene-graph (compile example-graph))) => javafx.scene.layout.VBox
+             (get-id @scene-graph) => "topBox"))

test/resources/test.fxml

@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="UTF-8"?>
+
+<?import java.net.*?>
+<?import javafx.geometry.*?>
+<?import javafx.scene.control.*?>
+<?import javafx.scene.layout.*?>
+<?import javafx.scene.text.*?>
+<?language clojure?>
+
+<VBox xmlns:fx="http://javafx.com/fxml" alignment="center" fx:id="topBox">
+  <Button fx:id="button" text="Close"/>
+  <ScrollPane>
+    <Label fx:id="label" text="This rocks."/>
+  </ScrollPane>
+</VBox>