(ns defgraph.core
  (:gen-class)
  (:import com.mxgraph.layout.mxOrganicLayout
           com.mxgraph.util.mxPoint
           com.mxgraph.view.mxGraph
           javax.swing.JFrame
           com.mxgraph.swing.mxGraphComponent))

(def defs     (filter #(.isFile %) (.listFiles (java.io.File. "defs/runs"))))
(def vertices (map #(.getName %) defs))
(def yaml     (org.yaml.snakeyaml.Yaml. (ExtendedConstructor.)))
(def extends  (map #(.get (.load yaml (slurp (.getPath %))) "ddts_extends") defs))
(def edges    (into {} (filter val (zipmap vertices extends))))
(def rootpath (memoize #(let [x (edges %)] (if x (conj {% x} (rootpath x)) {}))))

(defn graph [re]
  (let [filtered-edges (filter #(re-matches re (first %)) edges)
        complete-edges (reduce conj {} (map #(rootpath %) (keys filtered-edges)))]
    {:v (into #{} (concat (keys complete-edges) (vals complete-edges)))
     :e complete-edges}))

(defn layout-graph [mx model root]
  (.beginUpdate model)
  (let [layout (mxOrganicLayout. mx)]
    (doto layout
      (.setFineTuning false)
      (.setBorderLineCostFactor 10)
      (.setEdgeLengthCostFactor 0.001)
      (.setEdgeDistanceCostFactor 6000)
      (.setEdgeCrossingCostFactor 6000)
      (.setMaxIterations 1000)
      (.execute root)))
    (.endUpdate model))

(defn -main [& args]
  (if (> (count args) 1)
    (println "Supply at most a single filtering prefix.")
    (let [prefix (first args)
          g (graph (re-pattern (str prefix ".*")))
          mx (mxGraph.)
          model (.getModel mx)
          root (.getDefaultParent mx)
          height 1000
          width 1200]
      (doto mx
        (.setCellsDisconnectable false)
        (.setCellsEditable false)
        (.setCellsResizable false))
      (.beginUpdate model)
      (let [vs (:v g)
            fmkv #(.insertVertex mx root nil % (rand-int width) (rand-int height) 0 0)
            vmap (apply hash-map (interleave vs (map fmkv vs)))]
        (doseq [[label cell] vmap]
          (.setConnectable cell false)
          (.cellLabelChanged mx cell label true))
        (doseq [e (:e g)]
          (.insertEdge mx root nil "" (vmap (key e)) (vmap (val e)))))
      (.endUpdate model)
      (layout-graph mx model root)
      (let [gc (mxGraphComponent. mx)
            bounds (.getGraphBounds mx)
            view (.getView mx)]
        (let [offset-x (+ 20 (- (.getX bounds)))
              offset-y (+ 20 (- (.getY bounds)))]
          (.setTranslate view (mxPoint. offset-x offset-y)))
        (let [actual-height (.getHeight bounds)
              actual-width (.getWidth bounds)
              scale-factor (* 0.9 (min (/ width actual-width) (/ height actual-height)))]
          (.setScale view scale-factor))
        (doto (JFrame. (str "defgraph" (if prefix (str " (" prefix ")") "")))
          (.add gc)
          (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
          (.setSize width height)
          (.setVisible true))))))

(ns defgraph.core
  (:gen-class)
  (:import [com.mxgraph.layout mxOrganicLayout]
           [com.mxgraph.swing mxGraphComponent]
           [com.mxgraph.util mxPoint]
           [com.mxgraph.view mxGraph]
           [javax.swing JFrame]))

(def defs     (filter #(.isFile %) (.listFiles (java.io.File. "defs/runs"))))
(def vertices (map #(.getName %) defs))
(def yaml     (org.yaml.snakeyaml.Yaml. (ExtendedConstructor.)))
(def extends  (map #(.get (.load yaml (slurp (.getPath %))) "ddts_extends") defs))
(def edges    (into {} (filter val (zipmap vertices extends))))
(def rootpath (memoize #(let [x (edges %)] (if x (conj {% x} (rootpath x)) {}))))

(defn graph [re]
  (let [filtered-edges (filter #(re-matches re (first %)) edges)
        complete-edges (reduce conj {} (map #(rootpath %) (keys filtered-edges)))]
    {:v (into #{} (concat (keys complete-edges) (vals complete-edges)))
     :e complete-edges}))

(defn layout-graph [mx model root]
  (.beginUpdate model)
  (let [layout (mxOrganicLayout. mx)]
    (doto layout
      (.setFineTuning false)
      (.setBorderLineCostFactor 10)
      (.setEdgeLengthCostFactor 0.001)
      (.setEdgeDistanceCostFactor 6000)
      (.setEdgeCrossingCostFactor 6000)
      (.setMaxIterations 1000)
      (.execute root)))
  (.endUpdate model))

(defn -main [& args]
  (if (> (count args) 1)
    (println "Supply at most a single filtering prefix.")
    (let [prefix (first args)
          g (graph (re-pattern (str prefix ".*")))
          mx (mxGraph.)
          model (.getModel mx)
          root (.getDefaultParent mx)
          height 1000
          width 1200]
      (doto mx
        (.setCellsDisconnectable false)
        (.setCellsEditable false)
        (.setCellsResizable false))
      (.beginUpdate model)
      (let [vs (:v g)
            fmkv #(.insertVertex mx root nil % (rand-int width) (rand-int height) 0 0)
            vmap (apply hash-map (interleave vs (map fmkv vs)))]
        (doseq [[label cell] vmap]
          (.setConnectable cell false)
          (.cellLabelChanged mx cell label true))
        (doseq [e (:e g)]
          (.insertEdge mx root nil "" (vmap (key e)) (vmap (val e)))))
      (.endUpdate model)
      (layout-graph mx model root)
      (let [gc (mxGraphComponent. mx)
            bounds (.getGraphBounds mx)
            view (.getView mx)]
        (let [offset-x (+ 20 (- (.getX bounds)))
              offset-y (+ 20 (- (.getY bounds)))]
          (.setTranslate view (mxPoint. offset-x offset-y)))
        (let [actual-height (.getHeight bounds)
              actual-width (.getWidth bounds)
              scale-factor (* 0.9 (min (/ width actual-width) (/ height actual-height)))]
          (.setScale view scale-factor))
        (doto (JFrame. (str "defgraph" (if prefix (str " (" prefix ")") "")))
          (.add gc)
          (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
          (.setSize width height)
          (.setVisible true))))))

change import style

change import style


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.view.ui.viewer.shapes
  (:require [goog.events :as events]
            [lentes.core :as l]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.main.state :as st]
            [uxbox.main.geom :as geom]
            [uxbox.main.ui.shapes.rect :refer (rect-shape)]
            [uxbox.main.ui.shapes.icon :refer (icon-shape)]
            [uxbox.main.ui.shapes.text :refer (text-shape)]
            [uxbox.main.ui.shapes.group :refer (group-shape)]
            [uxbox.main.ui.shapes.path :refer (path-shape)]
            [uxbox.main.ui.shapes.circle :refer (circle-shape)]
            [uxbox.view.ui.viewer.interactions :as itx])
  (:import goog.events.EventType))

(def itx-flag-ref
  (-> (comp (l/key :flags) (l/lens :interactions))
      (l/derive st/state)))

;; --- Interactions Wrapper

(defn- interactions-wrapper-did-mount
  [own]
  (let [dom (mx/dom-node own)
        shape (first (:rum/args own))
        evnts (itx/build-events shape)
        keys (reduce (fn [acc [evt callback]]
                       (conj acc (events/listen dom evt callback)))
                     []
                     evnts)]
    (assoc own ::keys keys)))

(defn- interactions-wrapper-will-unmount
  [own]
  (let [keys (::keys own)]
    (run! #(events/unlistenByKey %) keys)
    (dissoc own ::keys)))

(mx/defc interactions-wrapper
  {:did-mount interactions-wrapper-did-mount
   :will-unmount interactions-wrapper-will-unmount
   :mixins [mx/reactive mx/static]}
  [shape factory]
  (let [show-itx? (mx/react itx-flag-ref)
        rect (geom/inner-rect shape)]
    [:g {:id (str "itx-" (:id shape))}
     (factory shape)
     (when show-itx?
       [:circle {:fill "red"
                 :cx (:x rect)
                 :cy (:y rect)
                 :r 10}])]))

;; --- Shapes

(mx/defc shape*
  [{:keys [type] :as shape}]
  (case type
    :group (group-shape shape #(interactions-wrapper % shape*))
    :text (text-shape shape)
    :icon (icon-shape shape)
    :rect (rect-shape shape)
    :path (path-shape shape)
    :circle (circle-shape shape)))

(mx/defc shape
  [sid]
  (let [item (get-in @st/state [:shapes-by-id sid])]
    (interactions-wrapper item shape*)))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.view.ui.viewer.shapes
  (:require [goog.events :as events]
            [lentes.core :as l]
            [uxbox.util.mixins :as mx :include-macros true]
            [uxbox.main.state :as st]
            [uxbox.main.geom :as geom]
            [uxbox.main.ui.shapes.rect :refer (rect-shape)]
            [uxbox.main.ui.shapes.icon :refer (icon-shape)]
            [uxbox.main.ui.shapes.text :refer (text-shape)]
            [uxbox.main.ui.shapes.group :refer (group-shape)]
            [uxbox.main.ui.shapes.path :refer (path-shape)]
            [uxbox.main.ui.shapes.circle :refer (circle-shape)]
            [uxbox.view.ui.viewer.interactions :as itx])
  (:import goog.events.EventType))

(def itx-flag-ref
  (-> (comp (l/key :flags) (l/lens :interactions))
      (l/derive st/state)))

;; --- Interactions Wrapper

(defn- interactions-wrapper-did-mount
  [own]
  (let [dom (mx/dom-node own)
        shape (first (:rum/args own))
        evnts (itx/build-events shape)
        keys (reduce (fn [acc [evt callback]]
                       (conj acc (events/listen dom evt callback)))
                     []
                     evnts)]
    (assoc own ::keys keys)))

(defn- interactions-wrapper-will-unmount
  [own]
  (let [keys (::keys own)]
    (run! #(events/unlistenByKey %) keys)
    (dissoc own ::keys)))

(mx/defc interactions-wrapper
  {:did-mount interactions-wrapper-did-mount
   :will-unmount interactions-wrapper-will-unmount
   :mixins [mx/reactive mx/static]}
  [shape factory]
  (let [show-itx? (mx/react itx-flag-ref)
        rect (geom/inner-rect shape)]
    [:g {:id (str "itx-" (:id shape))}
     (factory shape)
     (when show-itx?
       [:circle {:fill "red"
                 :cx (:x rect)
                 :cy (:y rect)
                 :r 10}])]))

;; --- Shapes

(declare shape)

(mx/defc shape*
  [{:keys [type] :as item}]
  (case type
    :group (group-shape item shape)
    :text (text-shape item)
    :icon (icon-shape item)
    :rect (rect-shape item)
    :path (path-shape item)
    :circle (circle-shape item)))

(mx/defc shape
  [sid]
  (let [item (get-in @st/state [:shapes-by-id sid])]
    (interactions-wrapper item shape*)))

Fix some issues in rendering groups in view app.


(ns clojars.test.test-helper
  (:require [clojars
             [config :refer [config]]
             [db :as db]
             [email :as email]
             [errors :as errors]
             [stats :as stats]
             [search :as search]
             [system :as system]
             [web :as web]]
            [clojars.db.migrate :as migrate]
            [clojure.java
             [io :as io]
             [jdbc :as jdbc]]
            [clojure.string :as string]
            [clucy.core :as clucy]
            [com.stuartsierra.component :as component])
  (:import java.io.File))

(def local-repo (io/file (System/getProperty "java.io.tmpdir")
                         "clojars" "test" "local-repo"))
(def local-repo2 (io/file (System/getProperty "java.io.tmpdir")
                         "clojars" "test" "local-repo2"))

(def test-config {:port 0
                  :bind "127.0.0.1"
                  :db {:classname "org.sqlite.JDBC"
                       :subprotocol "sqlite"
                       :subname ":memory:"}
                  :repo "data/test/repo"
                  :bcrypt-work-factor 12})

(defn using-test-config [f]
  (with-redefs [config test-config]
    (f)))

(defn delete-file-recursively
  "Delete file f. If it's a directory, recursively delete all its contents."
  [f]
  (let [f (io/file f)]
    (when (.exists f)
      (when (.isDirectory f)
        (doseq [child (.listFiles f)]
          (delete-file-recursively child)))
      (io/delete-file f))))

(defn default-fixture [f]
  (using-test-config
   (fn []
     (delete-file-recursively (io/file (config :repo)))
     (f))))

(defn quiet-reporter []
  (reify errors/ErrorReporter
    (-report-error [t e ex id])))

(declare ^:dynamic *db*)

(defn with-clean-database [f]
  (binding [*db* {:connection (jdbc/get-connection (:db test-config))}]
    (try
      (with-out-str
        (migrate/migrate *db*))
      (f)
      (finally (.close (:connection *db*))))))

(defn no-stats []
  (stats/->MapStats {}))

(defn no-search []
  (reify search/Search))

(declare ^:dynamic test-port)

(defn app
  ([] (app {}))
  ([{:keys [:db :error-reporter :stats :search :mailer]
     :or {:db *db*
          :error-reporter (quiet-reporter)
          :stats (no-stats)
          :search (no-search)
          :mailer nil}}]
   (web/clojars-app db error-reporter stats search mailer)))

(declare ^:dynamic system)

(defn app-from-system []
  ;; TODO once the database is a protocol, review
  ;; usage of this to move things into unit tests
  (web/handler-optioned system))

(defn run-test-app
  ([f]
   (binding [system (component/start (assoc (system/new-system test-config)
                                            :error-reporter (quiet-reporter)
                                            :index-factory #(clucy/memory-index)
                                            :stats (no-stats)))]
     (let [server (get-in system [:http :server])
           port (-> server .getConnectors first .getLocalPort)]
       (binding [test-port port]
         (try
           (with-out-str
             (migrate/migrate (get-in system [:db :spec])))
           (f)
           (finally
             (component/stop system))))))))

(defn get-content-type [resp]
  (some-> resp :headers (get "content-type") (string/split #";") first))

(defn assert-cors-header [resp]
  (some-> resp :headers
          (get "access-control-allow-origin")
          (= "*")))

Implement assert-cors-header to test_helper


(ns leiningen.namespaces-test
  (:require [clojure.test :refer :all]
            [leiningen.namespaces :as ns]
            [leiningen.core.project :as p]))

(defn- read-fn [_]
  (p/read-raw "test-resources/project_test.clj"))

(deftest ^:unit convert-namespace->des-path-of-src
  (is (= ["../project/folder1/de/otto/one/cool/ns.clj"
          "../project/folder2/de/otto/one/cool/ns.clj"]
         (ns/namespace->target-path "de.otto.one.cool.ns" "project" read-fn))))

(deftest ^:unit convert-namespace->des-path-of-test
  (is (= ["../project/testfolder1/de/otto/one/cool/ns_test.clj"
          "../project/testfolder2/de/otto/one/cool/ns_test.clj"]
         (ns/namespace->target-path "de.otto.one.cool.ns-test" "project" read-fn))))

(def project-clj {:source-paths ["folder1" "folder2"]
                  :test-paths   ["testfolder1" "testfolder2"]})

(deftest ^:unit convert-namespace->src-path-of-src
  (is (= ["folder1/de/otto/one/cool/ns.clj"
          "folder2/de/otto/one/cool/ns.clj"]
         (ns/namespace->source-path "de.otto.one.cool.ns" project-clj))))

(deftest ^:unit convert-namespace->src-path-of-test
  (is (= ["testfolder1/de/otto/one/cool/ns_test.clj"
          "testfolder2/de/otto/one/cool/ns_test.clj"]
         (ns/namespace->source-path "de.otto.one.cool.ns-test" project-clj))))

(deftest ^:unit split-test-path
  (is (= {:src-or-test    ["testfolder1" "testfolder2"]
          :namespace-path "de/otto/one/cool/ns_test.clj"}
         (ns/split-path "de.otto.one.cool.ns-test" project-clj))))

(deftest ^:unit split-src-path
  (is (= {:src-or-test    ["folder1" "folder2"]
          :namespace-path "de/otto/one/cool/ns.clj"}
         (ns/split-path "de.otto.one.cool.ns" project-clj))))

(deftest ^:unit is-a-test-ns
  (is (= ["testfolder1" "testfolder2"]
         (ns/test-or-source-namespace "de.otto.one.cool.ns-test" project-clj))))

(deftest ^:unit is-not-a-test-ns
  (is (= ["folder1" "folder2"]
         (ns/test-or-source-namespace "de.otto.one.cool.ns" project-clj))))

(deftest ^:unit is-not-a-test-ns
  (is (= ["testfolder1" "testfolder2"]
         (ns/test-or-source-namespace "test-utils-ns" project-clj))))

(deftest ^:unit flap-map-1
  (is (= '([:a :1] [:a :2] [:a :3] [:b :1] [:b :2] [:b :3] [:c :1] [:c :2] [:c :3])
         (ns/cartesian-product '(:a :b :c) '(:1 :2 :3)))))

(deftest ^:unit flap-map-2
  (is (= nil
         (ns/cartesian-product '(:a :b :c) '()))))

(deftest ^:unit flap-map-3
  (is (= nil
         (ns/cartesian-product '() '(:1 :2 :3)))))

(deftest ^:unit flap-map-4
  (is (= '([:a :1])
         (ns/cartesian-product '(:a) '(:1)))))

(deftest ^:unit flap-map-4
  (is (true? (ns/ns-exists? "test-resources/project_test.clj")))
  (is (false? (ns/ns-exists? "test-resources/project_test_not-exists.clj"))))

(ns leiningen.namespaces-test
  (:require [clojure.test :refer :all]
            [leiningen.namespaces :as ns]
            [leiningen.core.project :as p]))

(defn- read-fn [_]
  (p/read-raw "test-resources/project_test.clj"))

(deftest ^:unit convert-namespace->des-path-of-src
  (is (= ["../project/folder1/de/otto/one/cool/ns.clj"
          "../project/folder2/de/otto/one/cool/ns.clj"]
         (ns/namespace->target-path "de.otto.one.cool.ns" "project" read-fn))))

(deftest ^:unit convert-namespace->des-path-of-test
  (is (= ["../project/testfolder1/de/otto/one/cool/ns_test.clj"
          "../project/testfolder2/de/otto/one/cool/ns_test.clj"]
         (ns/namespace->target-path "de.otto.one.cool.ns-test" "project" read-fn))))

(deftest ^:unit resource->target-path-test
  (is (= ["../target-project/folder1/resource.edn"
          "../target-project/folder2/resource.edn"]
         (ns/resource->target-path "resource.edn"
                                   "target-project"
                                   (fn [_] {:resource-paths ["folder1" "folder2"]})))))

(deftest ^:unit resource->source-path-test
  (is (= ["folder1/resource.edn"
          "folder2/resource.edn"]
         (ns/resource->source-path "resource.edn" {:resource-paths ["folder1" "folder2"]}))))

(def project-clj {:source-paths ["folder1" "folder2"]
                  :test-paths   ["testfolder1" "testfolder2"]})

(deftest ^:unit convert-namespace->src-path-of-src
  (is (= ["folder1/de/otto/one/cool/ns.clj"
          "folder2/de/otto/one/cool/ns.clj"]
         (ns/namespace->source-path "de.otto.one.cool.ns" project-clj))))

(deftest ^:unit convert-namespace->src-path-of-test
  (is (= ["testfolder1/de/otto/one/cool/ns_test.clj"
          "testfolder2/de/otto/one/cool/ns_test.clj"]
         (ns/namespace->source-path "de.otto.one.cool.ns-test" project-clj))))

(deftest ^:unit split-test-path
  (is (= {:src-or-test    ["testfolder1" "testfolder2"]
          :namespace-path "de/otto/one/cool/ns_test.clj"}
         (ns/split-path "de.otto.one.cool.ns-test" project-clj))))

(deftest ^:unit split-src-path
  (is (= {:src-or-test    ["folder1" "folder2"]
          :namespace-path "de/otto/one/cool/ns.clj"}
         (ns/split-path "de.otto.one.cool.ns" project-clj))))

(deftest ^:unit is-a-test-ns
  (is (= ["testfolder1" "testfolder2"]
         (ns/test-or-source-namespace "de.otto.one.cool.ns-test" project-clj))))

(deftest ^:unit is-not-a-test-ns
  (is (= ["folder1" "folder2"]
         (ns/test-or-source-namespace "de.otto.one.cool.ns" project-clj))))

(deftest ^:unit is-not-a-test-ns
  (is (= ["testfolder1" "testfolder2"]
         (ns/test-or-source-namespace "test-utils-ns" project-clj))))

(deftest ^:unit flap-map-1
  (is (= '([:a :1] [:a :2] [:a :3] [:b :1] [:b :2] [:b :3] [:c :1] [:c :2] [:c :3])
         (ns/cartesian-product '(:a :b :c) '(:1 :2 :3)))))

(deftest ^:unit flap-map-2
  (is (= nil
         (ns/cartesian-product '(:a :b :c) '()))))

(deftest ^:unit flap-map-3
  (is (= nil
         (ns/cartesian-product '() '(:1 :2 :3)))))

(deftest ^:unit flap-map-4
  (is (= '([:a :1])
         (ns/cartesian-product '(:a) '(:1)))))

(deftest ^:unit flap-map-4
  (is (true? (ns/ns-exists? "test-resources/project_test.clj")))
  (is (false? (ns/ns-exists? "test-resources/project_test_not-exists.clj"))))

add some tests for the update logic of resources


(ns asciinema-player.view-test
  (:require-macros [cljs.test :refer (is deftest testing)])
  (:require [cljs.test]
            [asciinema-player.view :as v]))

(deftest fg-color-test
  (is (= (v/fg-color nil false) nil))
  (is (= (v/fg-color nil true) nil))
  (is (= (v/fg-color 1 false) 1))
  (is (= (v/fg-color 1 true) 9))
  (is (= (v/fg-color 7 true) 15))
  (is (= (v/fg-color 8 true) 8))
  (is (= (v/fg-color 15 true) 15)))

(deftest bg-color-test
  (is (= (v/bg-color nil false) nil))
  (is (= (v/bg-color nil true) nil))
  (is (= (v/bg-color 1 false) 1))
  (is (= (v/bg-color 1 true) 9))
  (is (= (v/bg-color 7 true) 15))
  (is (= (v/bg-color 8 true) 8))
  (is (= (v/bg-color 15 true) 15)))

(deftest part-class-name-test
  (is (= (v/part-class-name {} false) ""))
  (is (= (v/part-class-name {:fg 1} false) "fg-1"))
  (is (= (v/part-class-name {:bg 2} false) "bg-2"))
  (is (= (v/part-class-name {:fg 1 :bold true} false) "fg-9 bright"))
  (is (= (v/part-class-name {:fg 9 :bold true} false) "fg-9 bright"))
  (is (= (v/part-class-name {:fg 1 :bg 2 :underline true} false) "fg-1 bg-2 underline"))
  (is (= (v/part-class-name {:inverse true} false) "fg-bg bg-fg"))
  (is (= (v/part-class-name {:fg 1 :inverse true} false) "fg-bg bg-1"))
  (is (= (v/part-class-name {:bg 2 :inverse true} false) "fg-2 bg-fg"))
  (is (= (v/part-class-name {:fg 1 :bg 2 :inverse true} false) "fg-2 bg-1"))
  (is (= (v/part-class-name {:fg 1 :bg 2 :bold true :blink true :inverse true} false) "fg-10 bg-9 bright")))

(deftest elapsed-time-test
  (is (= (v/elapsed-time 0.88) "00:00"))
  (is (= (v/elapsed-time 1.00) "00:01"))
  (is (= (v/elapsed-time 133.95) "02:13")))

(deftest remaining-time-test
  (is (= (v/remaining-time 0.88 3) "-00:02"))
  (is (= (v/remaining-time 1.00 3) "-00:02"))
  (is (= (v/remaining-time 133.95 134) "-00:00")))

(deftest insert-cursor-test
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 0) [["f" {:foo true :cursor true :inverse true}] ["oo" {:foo true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 1) [["f" {:foo true}] ["o" {:foo true :cursor true :inverse true}] ["o" {:foo true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 2) [["fo" {:foo true}] ["o" {:foo true :cursor true :inverse true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 5) [["foo" {:foo true}] ["ba" {:bar true}] ["r" {:bar true :cursor true :inverse true}]]))
  (is (= (v/insert-cursor [["f" {:foo true}] ["bar" {:bar true}]] 0) [["f" {:foo true :cursor true :inverse true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["b" {:bar true}]] 3) [["foo" {:foo true}] ["b" {:bar true :cursor true :inverse true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["b" {:bar true}] ["qux" {:qux true}]] 3) [["foo" {:foo true}] ["b" {:bar true :cursor true :inverse true}] ["qux" {:qux true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]] 9) [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]] 10) [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]]))
  (is (= (v/insert-cursor [] 0) []))
  (is (= (v/insert-cursor [] 1) [])))

(ns asciinema-player.view-test
  (:require-macros [cljs.test :refer (is deftest testing)])
  (:require [cljs.test]
            [asciinema-player.view :as v]))

(deftest fg-color-test
  (is (= (v/fg-color nil false) nil))
  (is (= (v/fg-color nil true) nil))
  (is (= (v/fg-color 1 false) 1))
  (is (= (v/fg-color 1 true) 9))
  (is (= (v/fg-color 7 true) 15))
  (is (= (v/fg-color 8 true) 8))
  (is (= (v/fg-color 15 true) 15)))

(deftest bg-color-test
  (is (= (v/bg-color nil false) nil))
  (is (= (v/bg-color nil true) nil))
  (is (= (v/bg-color 1 false) 1))
  (is (= (v/bg-color 1 true) 9))
  (is (= (v/bg-color 7 true) 15))
  (is (= (v/bg-color 8 true) 8))
  (is (= (v/bg-color 15 true) 15)))

(deftest part-class-name-test
  (is (= (v/part-class-name {} false) ""))
  (is (= (v/part-class-name {:fg 1} false) "fg-1"))
  (is (= (v/part-class-name {:bg 2} false) "bg-2"))
  (is (= (v/part-class-name {:fg 1 :bold true} false) "fg-9 bright"))
  (is (= (v/part-class-name {:fg 9 :bold true} false) "fg-9 bright"))
  (is (= (v/part-class-name {:fg 1 :bg 2 :underline true} false) "fg-1 bg-2 underline"))
  (is (= (v/part-class-name {:inverse true} false) "fg-bg bg-fg"))
  (is (= (v/part-class-name {:fg 1 :inverse true} false) "fg-bg bg-1"))
  (is (= (v/part-class-name {:bg 2 :inverse true} false) "fg-2 bg-fg"))
  (is (= (v/part-class-name {:fg 1 :bg 2 :inverse true} false) "fg-2 bg-1"))
  (is (= (v/part-class-name {:fg 1 :bg 2 :bold true :blink true :inverse true} false) "fg-10 bg-9 bright")))

(deftest elapsed-time-test
  (is (= (v/elapsed-time 0.88) "00:00"))
  (is (= (v/elapsed-time 1.00) "00:01"))
  (is (= (v/elapsed-time 133.95) "02:13")))

(deftest remaining-time-test
  (is (= (v/remaining-time 0.88 3) "-00:02"))
  (is (= (v/remaining-time 1.00 3) "-00:02"))
  (is (= (v/remaining-time 133.95 134) "-00:00")))

(deftest insert-cursor-test
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 0) [["f" {:foo true :cursor true}] ["oo" {:foo true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 1) [["f" {:foo true}] ["o" {:foo true :cursor true}] ["o" {:foo true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 2) [["fo" {:foo true}] ["o" {:foo true :cursor true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}]] 5) [["foo" {:foo true}] ["ba" {:bar true}] ["r" {:bar true :cursor true}]]))
  (is (= (v/insert-cursor [["f" {:foo true}] ["bar" {:bar true}]] 0) [["f" {:foo true :cursor true}] ["bar" {:bar true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["b" {:bar true}]] 3) [["foo" {:foo true}] ["b" {:bar true :cursor true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["b" {:bar true}] ["qux" {:qux true}]] 3) [["foo" {:foo true}] ["b" {:bar true :cursor true}] ["qux" {:qux true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]] 9) [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]]))
  (is (= (v/insert-cursor [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]] 10) [["foo" {:foo true}] ["bar" {:bar true}] ["baz" {:baz true}]]))
  (is (= (v/insert-cursor [] 0) []))
  (is (= (v/insert-cursor [] 1) [])))

Fix insert-cursor-test

Fix insert-cursor-test


(ns memoria.handlers.cards-test
  (:require [memoria.handlers.cards :as cards-handler]
            [memoria.entities.cards :as cards]
            [clojure.test :refer :all]
            [memoria.support.debugging :refer :all]
            [ring.mock.request :as mock]))

(def a-card {:id 123 :title "A Card" :contents "The contents"})

(deftest listing-cards
  (with-redefs [cards/all (fn [] [a-card])]
    (let [response (cards-handler/cards-routes (mock/request :get "/cards"))]
      (testing "Responds with 200"
        (is (= (:status response) 200)))

      (testing "Returns the cards"
        (is (= (:body response) [a-card])))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(deftest getting-a-card
  (with-redefs [cards/find-by-id (fn [id] a-card)]
    (let [response (cards-handler/cards-routes (mock/request :get (str "/cards/" (:id a-card))))]
      (testing "Responds with 200"
        (is (= (:status response) 200)))

      (testing "Returns the card"
        (is (= (:body response) a-card)))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(deftest getting-a-not-found-card
  (with-redefs [cards/find-by-id (fn [id] nil)]
    (let [response (cards-handler/cards-routes (mock/request :get "/cards/123"))]
      (testing "Responds with 404"
        (is (= (:status response) 404)))

      (testing "Returns a not found message"
        (is (= (get-in response [:body :message]) "Could not find a card with id 123"))))))

(deftest inserting-a-card
  (with-redefs [cards/insert (fn [attrs] a-card)]
    (let [attrs (select-keys a-card [:title :contents])
          response (cards-handler/cards-routes (mock/request :post "/cards" attrs))]
      (testing "Responds with 200"
        (is (= (:status response) 201)))

      (testing "Returns the created card"
        (is (= (get-in response [:body :id]) 123)))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(deftest inserting-a-card-with-invalid-attributes
  (with-redefs [cards/insert (fn [attrs] (assoc a-card :errors {:title "Can't be blank."}))]
    (let [attrs {}
          response (cards-handler/cards-routes (mock/request :post "/cards" attrs))]
      (testing "Responds with 400"
        (is (= (:status response) 400)))

      (testing "Returns the created card"
        (is (= (get-in response [:body :id]) 123)))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(ns memoria.handlers.cards-test
  (:require [memoria.handlers.cards :as cards-handler]
            [memoria.entities.cards :as cards]
            [clojure.test :refer :all]
            [memoria.support.debugging :refer :all]
            [ring.mock.request :as mock]))

(def a-card {:id 123 :title "A Card" :contents "The contents"})

(deftest listing-cards
  (with-redefs [cards/all (constantly [a-card])]
    (let [response (cards-handler/cards-routes (mock/request :get "/cards"))]
      (testing "Responds with 200"
        (is (= (:status response) 200)))

      (testing "Returns the cards"
        (is (= (:body response) [a-card])))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(deftest getting-a-card
  (with-redefs [cards/find-by-id (constantly a-card)]
    (let [response (cards-handler/cards-routes (mock/request :get (str "/cards/" (:id a-card))))]
      (testing "Responds with 200"
        (is (= (:status response) 200)))

      (testing "Returns the card"
        (is (= (:body response) a-card)))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(deftest getting-a-not-found-card
  (with-redefs [cards/find-by-id (constantly nil)]
    (let [response (cards-handler/cards-routes (mock/request :get "/cards/123"))]
      (testing "Responds with 404"
        (is (= (:status response) 404)))

      (testing "Returns a not found message"
        (is (= (get-in response [:body :message]) "Could not find a card with id 123"))))))

(deftest inserting-a-card
  (with-redefs [cards/insert (constantly a-card)]
    (let [attrs (select-keys a-card [:title :contents])
          response (cards-handler/cards-routes (mock/request :post "/cards" attrs))]
      (testing "Responds with 200"
        (is (= (:status response) 201)))

      (testing "Returns the created card"
        (is (= (get-in response [:body :id]) 123)))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

(deftest inserting-a-card-with-invalid-attributes
  (with-redefs [cards/insert (constantly (assoc a-card :errors {:title "Can't be blank."}))]
    (let [attrs {}
          response (cards-handler/cards-routes (mock/request :post "/cards" attrs))]
      (testing "Responds with 400"
        (is (= (:status response) 400)))

      (testing "Returns the created card"
        (is (= (get-in response [:body :id]) 123)))

      (testing "Has json as the content type"
        (is (= (get-in response [:headers "Content-Type"]) "application/json"))))))

Use constantly to stub functions

Use constantly to stub functions


(defproject
  hello
  "luminus"
  :dependencies
  [[org.clojure/clojure "1.5.1"]
   [lib-noir "0.7.9"]
   [compojure "1.1.6"]
   [ring-server "0.3.1"]
   [selmer "0.5.7"]
   [com.taoensso/timbre "2.7.1"]
   [com.postspectacular/rotor "0.1.0"]
   [com.taoensso/tower "1.5.1"]
   [mysql/mysql-connector-java "5.1.28"]
   [korma "0.3.0-RC5"]
   [log4j
    "1.2.17"
    :exclusions
    [javax.mail/mail
     javax.jms/jms
     com.sun.jdmk/jmxtools
     com.sun.jmx/jmxri]]]
  :ring
  {:handler hello.handler/app,
   :init hello.handler/init,
   :destroy hello.handler/destroy}
  :profiles
  {:production
   {:ring
    {:open-browser? false, :stacktraces? false, :auto-reload? false}},
   :dev
   {:dependencies [[ring-mock "0.1.5"] [ring/ring-devel "1.2.1"]]}}
  :url
  "http://example.com/FIXME"
  :plugins
  [[lein-ring "0.8.10"]]
  :description
  "FIXME: write description"
  :min-lein-version "2.0.0")

(defproject
  hello
  "luminus"
  :dependencies
  [[org.clojure/clojure "1.5.1"]
   [lib-noir "0.8.2"]
   [compojure "1.1.6"]
   [ring-server "0.3.1"]
   [selmer "0.5.7"]
   [com.taoensso/timbre "2.7.1"]
   [com.postspectacular/rotor "0.1.0"]
   [com.taoensso/tower "2.0.2"]
   [mysql/mysql-connector-java "5.1.28"]
   [korma "0.3.0-RC5"]
   [log4j
    "1.2.17"
    :exclusions
    [javax.mail/mail
     javax.jms/jms
     com.sun.jdmk/jmxtools
     com.sun.jmx/jmxri]]]
  :ring
  {:handler hello.handler/app,
   :init hello.handler/init,
   :destroy hello.handler/destroy}
  :profiles
  {:uberjar {:aot :all}
   :production
   {:ring
    {:open-browser? false, :stacktraces? false, :auto-reload? false}},
   :dev
   {:dependencies [[ring-mock "0.1.5"] [ring/ring-devel "1.2.2"]]}}
  :url
  "http://example.com/FIXME"
  :plugins
  [[lein-ring "0.8.10"]]
  :description
  "FIXME: write description"
  :min-lein-version "2.0.0")

Update project.clj

Update project.clj


(ns irresponsible.oolong
  (:require [com.stuartsierra.component :as cpt]
            [clojure.tools.reader.edn :as edn]
            [clojure.tools.reader.reader-types :as rt]
            [irresponsible.oolong.util :refer [simple-system]]))

;; oolong is a simple config-based loader for stuartsierra's brilliant
;; `component` library that solves our dependency issues.

;; This file contains the high level functions for integrating oolong
;; into your application.

;; If you want to get going quickly, best check out the docs in the
;; README.md file at the root of the repository. You can also see it online
;; on github at https://github.com/jjl/oolong/

(defn brew
  "Given a configuration, brews the described system descriptor under the
   `:app` key using the entire file as configuration.
   Args: [config]
     - config: a map with an `:app` key which is a valid system descriptor
   Returns: new system with any dependencies resolved
   Throws: if system cannot be loaded"
  [{:keys [app] :as config}]
  (simple-system app (dissoc config :app)))

(def ^:deprecated brew-master brew)       ; backcompat

(defn brew-file
  "Given a configuration file path, reads the file as edn and brews the
   described system descriptor under the `:app` key using the entire
   file as configuration.
   Args: [filename]
     - filename: a filename naming a file of edn which must take the form
                 of a map. The `:app` key in the map should point to a valid
                 RSD. The entire map will be used as configuration
   Returns: new system with any dependencies resolved
   Throws: if file does not exist, is invalid edn or is invalid oolong."
  [filename]
  (-> filename slurp rt/indexing-push-back-reader edn/read brew))

(def ^:deprecated brew-master-file brew-file)

;; For convenience, we alias a few things from `component`

(def Lifecycle "The Lifecycle protocol for components" cpt/Lifecycle)
(def start "Starts a component" cpt/start)
(def stop "Stops a component" cpt/stop)
(def start-system "Starts a system" cpt/start-system)
(def stop-system "Stops a system" cpt/stop-system)

(ns irresponsible.oolong
  (:require [com.stuartsierra.component :as cpt]
            #?@(:clj [[clojure.tools.reader.edn :as edn]
                      [clojure.tools.reader.reader-types :as rt]])
            [irresponsible.oolong.util :refer [simple-system]]))

;; oolong is a simple config-based loader for stuartsierra's brilliant
;; `component` library that solves our dependency issues.

;; This file contains the high level functions for integrating oolong
;; into your application.

;; If you want to get going quickly, best check out the docs in the
;; README.md file at the root of the repository. You can also see it online
;; on github at https://github.com/jjl/oolong/

(defn brew
  "Given a configuration, brews the described system descriptor under the
   `:app` key using the entire file as configuration.
   Args: [config]
     - config: a map with an `:app` key which is a valid system descriptor
   Returns: new system with any dependencies resolved
   Throws: if system cannot be loaded"
  [{:keys [app] :as config}]
  (simple-system app (dissoc config :app)))

(def ^:deprecated brew-master brew)       ; backcompat

#?(:clj
 (defn brew-file
   "Given a configuration file path, reads the file as edn and brews the
    described system descriptor under the `:app` key using the entire
    file as configuration.
    Args: [filename]
      - filename: a filename naming a file of edn which must take the form
                  of a map. The `:app` key in the map should point to a valid
                  RSD. The entire map will be used as configuration
    Returns: new system with any dependencies resolved
    Throws: if file does not exist, is invalid edn or is invalid oolong."
   [filename]
   (-> filename slurp rt/indexing-push-back-reader edn/read brew)))
#?(:clj
 (def ^:deprecated brew-master-file brew-file))

;; For convenience, we alias a few things from `component`

(def Lifecycle "The Lifecycle protocol for components" cpt/Lifecycle)
(def start "Starts a component" cpt/start)
(def stop "Stops a component" cpt/stop)
(def start-system "Starts a system" cpt/start-system)
(def stop-system "Stops a system" cpt/stop-system)

Support CLJS in oolong by making brew-file CLJ only


(ns shadow.cljs.modern
  (:require
    [cljs.analyzer :as ana]
    [cljs.compiler :as comp]
    [cljs.env :as env]
    [clojure.string :as str]
    [clojure.walk :as walk]))

;; just semi-modern for now
;; requires too much work to make it actually modern (let/const vs var, etc)

;; just got tired of not having access to class and deftype being annoying sometimes

;; FIXME: should calculate protocol pmasks ala deftype so fast-path macros support
;; FIXME: should likely generate sane equals/hash impl?
;; I'm fine with identity compare only for now, this isn't meant to replace deftype/defrecord after all

#?(:cljs
   (set! ana/specials (conj ana/specials `defclass* `super*))
   :clj
   (alter-var-root #'ana/specials conj `defclass* `super* `js-template*))

(defn find-and-replace-super-call [form]
  (let [res
        (walk/prewalk
          (fn [form]
            (if-not (and (list? form) (= 'super (first form)))
              form
              `(super* ~@(rest form))))
          form)]

    (if (not= form res)
      res
      ;; if super call was not found, add it first
      (cons `(super*) form))))

(defn parse-class [form]
  (loop [classname nil
         fields []
         constructor nil
         extends nil
         protocols []
         protocol nil
         protocol-fns []
         [head & more :as current] form]

    (let [l? (list? head) s? (symbol? head)]

      (cond
        ;; all done
        (not (seq current))
        (-> {:classname classname
             :extends extends
             :constructor constructor
             :fields fields
             :protocols protocols}
            (cond->
              protocol
              (update :protocols conj {:protocol-name protocol :protocol-fns protocol-fns})))

        ;; SomeClass, symbol before any other form
        (and s? (nil? constructor) (empty? fields) (empty? protocols) (nil? extends) (nil? protocol) (nil? classname))
        (recur head fields constructor extends protocols protocol protocol-fns more)

        ;; (field foo default?)
        (and l? (nil? protocol) (= 'field (first head)))
        (let [field-count (count head)
              field-name (nth head 1)]
          (cond
            ;; (field foo)
            (and (= 2 field-count) (simple-symbol? field-name))
            (recur classname (conj fields {:field-form head :field-name field-name}) constructor extends protocols protocol protocol-fns more)

            ;; (field foo some-default)
            ;; FIXME: should restrict some-default to actual values, not sure expressions will work?
            (and (= 3 field-count) (simple-symbol? field-name))
            (recur classname (conj fields {:field-form head :field-name field-name :field-default (nth head 2)}) constructor extends protocols protocol protocol-fns more)
            :else
            (throw (ex-info "invalid field definition" {:form head}))))

        ;; (constructor [foo bar] ...)
        (and l? (nil? protocol) (nil? constructor) (= 'constructor (first head)) (vector? (second head)))
        (recur classname fields head extends protocols protocol protocol-fns more)

        ;; (extends SomeClass)
        (and l? (nil? protocol) (nil? extends) (= 'extends (first head)) (= 2 (count head)) (symbol? (second head)))
        (recur classname fields constructor (second head) protocols protocol protocol-fns more)

        ;; SomeProtocol start when protocol already active, save protocol, repeat current
        (and s? (some? protocol))
        (recur classname fields constructor extends (conj protocols {:protocol-name protocol :protocol-fns protocol-fns}) nil [] current)

        ;; SomeProtocol start
        s?
        (recur classname fields constructor extends protocols head [] more)

        ;; (protocol-fn [] ...)
        (and l? protocol)
        (recur classname fields constructor extends protocols protocol
          ;; this is important so that the extend-type code emits a var self__ = this;
          ;; no clue why ::ana/type controls that
          (conj protocol-fns (vary-meta head assoc ::ana/type classname))
          more)

        :else
        (throw (ex-info "invalid defclass form" {:form head}))
        ))))

(defmethod ana/parse `defclass*
  [op env form name opts]
  (let [{:keys [classname extends constructor fields protocols] :as parsed}
        (parse-class (rest form))]

    (assert (symbol? classname) "classname required")

    (let [qualified-name (symbol (-> env :ns :name str) (str classname))
          munged-name (symbol (str/replace (comp/munge qualified-name) "." "$"))

          field-syms (map :field-name fields)

          locals (reduce
                   (fn [m fld]
                     (assoc m fld
                              {:name fld
                               ;; why do these exist?
                               :line (ana/get-line fld env)
                               :column (ana/get-col fld env)
                               :local :field
                               :field true
                               :mutable true ;; always treat all as mutable
                               :tag (-> fld meta :tag)}))
                   {classname {:name qualified-name
                               :tag classname}}
                   field-syms)

          [_ ctor-args & ctor-body] constructor

          _ (assert (pos? (count ctor-args)) "contructor requires at least one argument name for this")

          [this-sym & ctor-args] ctor-args

          _ (assert (symbol? this-sym) "can't destructure first constructur argument")

          ctor-body
          (find-and-replace-super-call ctor-body)

          arg-syms (vec (take (count ctor-args) (repeatedly gensym)))

          ctor-locals
          (reduce-kv
            (fn [locals idx fld]
              ;; FIXME: what should fn args locals look like?
              (assoc locals fld {:name fld}))
            ;; pretty sure thats wrong but works in our favor
            ;; since accessing this before super() is invalid
            ;; and this kinda ensures that
            (assoc locals this-sym {:name (symbol "self__")
                                    :tag classname})
            arg-syms)

          ctor-env
          (assoc env :context :statement
                     :locals ctor-locals
                     ::extends extends
                     ::fields fields)

          ;; lazy way to deal with destructuring
          ctor-form
          `(cljs.core/let [~@(interleave ctor-args arg-syms)]
             ~@ctor-body)

          ctor-ast
          (ana/analyze ctor-env ctor-form)

          extend-ast
          (when (seq protocols)
            (let [extend-env
                  (assoc env :locals locals)

                  extend-form
                  `(cljs.core/extend-type ~classname
                     ~@(->> (for [{:keys [protocol-name protocol-fns]} protocols]
                              (into [protocol-name] protocol-fns))
                            (mapcat identity)))]
              (ana/analyze extend-env extend-form)))

          extends-ast
          (when extends
            (ana/analyze (assoc env :context :expr) extends))]

      (swap! env/*compiler* update-in [::ana/namespaces (-> env :ns :name) :defs classname]
        (fn [m]
          (-> m
              (assoc :name qualified-name
                     :tag 'function
                     :type true
                     :num-fields (count arg-syms)
                     :record false
                     :protocols #{})
              (merge (ana/source-info form env)))))

      (-> {:op ::class :env env :form form
           :qualified-name qualified-name
           :munged-name munged-name
           :classname classname
           :tag 'function
           :children []
           :ctor-args arg-syms
           :ctor ctor-ast}
          (cond->
            extends-ast
            (assoc :extends extends-ast)

            extend-ast
            (assoc :extend extend-ast :children [:ctor :extend]))))))

(defmethod comp/emit* ::class
  [{:keys [env qualified-name munged-name extends extend ctor-args ctor]}]
  (comp/emits (comp/munge qualified-name) " = class ")
  (comp/emits munged-name)
  (when extends
    (comp/emits " extends ")
    (comp/emit extends))
  (comp/emitln " {")

  (comp/emitln "  constructor(" (interpose "," ctor-args) ") {")
  (comp/emit ctor)
  (comp/emitln "  }")
  (comp/emitln "};")

  (when extend
    (comp/emit extend)))

;; this is always added by class* so we know the correct position
;; to initialize arguments since its not allowed to access this before super
(defmethod ana/parse `super*
  [op {::keys [extends fields] :as env} [_ & super-args :as form] name opts]
  {:op ::super
   :form form
   :env env
   :call-super? (some? extends)
   :children [:super-args :field-init]
   :super-args (mapv #(ana/analyze (assoc env :context :expr) %) super-args)
   :field-init
   (ana/analyze env
     `(~'do ~@(->> fields
                   (filter :field-default)
                   (map
                     (fn [{:keys [field-name field-default field-form]}]
                       (with-meta
                         `(~'set! ~field-name ~field-default)
                         (meta field-form))))
                   )))})

(defmethod comp/emit* ::super
  [{:keys [call-super? super-args field-init] :as ast}]
  (when call-super?
    (comp/emitln "super(" (interpose "," super-args) ");"))

  ;; required for direct field accesses here and anywhere in the ctor
  (comp/emitln "var self__ = this;")

  ;; initialize fields with defaults directly after super is called
  (comp/emit field-init))

;; only defclass for now since class expressions don't work with extend-type
;; could use a slightly slimmer version for class that doesn't allow protocols
;; or maybe go through specify or so?
(defmacro defclass [& body]
  `(defclass* ~@body))

(defmethod comp/emit* ::js-template
  [{:keys [env tagged parts]}]
  (comp/emit-wrap env
    (when tagged
      (comp/emit (first parts)))
    (comp/emits "`")
    (doseq [{:keys [op val] :as part} (if tagged (rest parts) parts)]
      (if (and (= :const op) (string? val))
        (let [quoted
              (-> val
                  ;; FIXME: anything else that needs replacing?
                  ;; newlines and stuff are allowed
                  (str/replace #"`" (constantly "\\`"))
                  (str/replace #"\$\{" (constantly "\\${")))]
          (comp/emits quoted))
        (do (comp/emits "${")
            (comp/emit part)
            (comp/emits "}"))))
    (comp/emits "`")))

(defmethod ana/parse `js-template*
  [op env form name opts]
  (let [part-env (assoc env :context :expr)
        parts (mapv #(ana/analyze part-env %) (rest form))]

    {:op ::js-template
     :env env
     :form form
     :parts parts
     :tagged (not (string? (second form)))
     :children [:parts]}))

(defmacro js-template [& body]
  `(js-template* ~@body))

;; FIXME: use spec for parsing this. bad errors otherwise if used incorrectly
(defmacro js-await [[name thenable] & body]
  (let [last-expr (last body)

        [body catch]
        (if (and (seq? last-expr) (= 'catch (first last-expr)))
          [(butlast body) last-expr]
          [body nil])]

    ;; FIXME: -> here will always return a promise so shouldn't be necessary to add js hint?
    `(-> ~thenable
         ~@(when (seq body)
             [`(.then (fn [~name] ~@body))])
         ~@(when catch
             (let [[name & body] catch]
               [`(.catch (fn [~name] ~@body))]
               )))))

(comment
  (macroexpand-1
    '(js-await [{:keys [foo]} (bar)]
       (do-thing foo)
       (catch x (fail x))
       ))

  (macroexpand-1
    '(js-await [{:keys [foo]} (bar)]
       (do-thing foo)))

  (macroexpand-1
    '(js-await [foo (bar)]
       (catch e :yo))))

(ns shadow.cljs.modern
  (:require
    [cljs.analyzer :as ana]
    [cljs.compiler :as comp]
    [cljs.env :as env]
    [clojure.string :as str]
    [clojure.walk :as walk]))

;; just semi-modern for now
;; requires too much work to make it actually modern (let/const vs var, etc)

;; just got tired of not having access to class and deftype being annoying sometimes

;; FIXME: should calculate protocol pmasks ala deftype so fast-path macros support
;; FIXME: should likely generate sane equals/hash impl?
;; I'm fine with identity compare only for now, this isn't meant to replace deftype/defrecord after all

#?(:cljs
   (set! ana/specials (conj ana/specials `defclass* `super*))
   :clj
   (alter-var-root #'ana/specials conj `defclass* `super* `js-template*))

(defn find-and-replace-super-call [form]
  (let [res
        (walk/prewalk
          (fn [form]
            (if-not (and (list? form) (= 'super (first form)))
              form
              `(super* ~@(rest form))))
          form)]

    (if (not= form res)
      res
      ;; if super call was not found, add it first
      (cons `(super*) form))))

(defn parse-class [form]
  (loop [classname nil
         fields []
         constructor nil
         extends nil
         protocols []
         protocol nil
         protocol-fns []
         [head & more :as current] form]

    (let [l? (list? head) s? (symbol? head)]

      (cond
        ;; all done
        (not (seq current))
        (-> {:classname classname
             :extends extends
             :constructor constructor
             :fields fields
             :protocols protocols}
            (cond->
              protocol
              (update :protocols conj {:protocol-name protocol :protocol-fns protocol-fns})))

        ;; SomeClass, symbol before any other form
        (and s? (nil? constructor) (empty? fields) (empty? protocols) (nil? extends) (nil? protocol) (nil? classname))
        (recur head fields constructor extends protocols protocol protocol-fns more)

        ;; (field foo default?)
        (and l? (nil? protocol) (= 'field (first head)))
        (let [field-count (count head)
              field-name (nth head 1)]
          (cond
            ;; (field foo)
            (and (= 2 field-count) (simple-symbol? field-name))
            (recur classname (conj fields {:field-form head :field-name field-name}) constructor extends protocols protocol protocol-fns more)

            ;; (field foo some-default)
            ;; FIXME: should restrict some-default to actual values, not sure expressions will work?
            (and (= 3 field-count) (simple-symbol? field-name))
            (recur classname (conj fields {:field-form head :field-name field-name :field-default (nth head 2)}) constructor extends protocols protocol protocol-fns more)
            :else
            (throw (ex-info "invalid field definition" {:form head}))))

        ;; (constructor [foo bar] ...)
        (and l? (nil? protocol) (nil? constructor) (= 'constructor (first head)) (vector? (second head)))
        (recur classname fields head extends protocols protocol protocol-fns more)

        ;; (extends SomeClass)
        (and l? (nil? protocol) (nil? extends) (= 'extends (first head)) (= 2 (count head)) (symbol? (second head)))
        (recur classname fields constructor (second head) protocols protocol protocol-fns more)

        ;; SomeProtocol start when protocol already active, save protocol, repeat current
        (and s? (some? protocol))
        (recur classname fields constructor extends (conj protocols {:protocol-name protocol :protocol-fns protocol-fns}) nil [] current)

        ;; SomeProtocol start
        s?
        (recur classname fields constructor extends protocols head [] more)

        ;; (protocol-fn [] ...)
        (and l? protocol)
        (recur classname fields constructor extends protocols protocol
          ;; this is important so that the extend-type code emits a var self__ = this;
          ;; no clue why ::ana/type controls that
          (conj protocol-fns (vary-meta head assoc ::ana/type classname))
          more)

        :else
        (throw (ex-info "invalid defclass form" {:form head}))
        ))))

(defmethod ana/parse `defclass*
  [op env form name opts]
  (let [{:keys [classname extends constructor fields protocols] :as parsed}
        (parse-class (rest form))]

    (assert (symbol? classname) "classname required")

    (let [qualified-name (symbol (-> env :ns :name str) (str classname))
          munged-name (symbol (str/replace (comp/munge qualified-name) "." "$"))

          field-syms (map :field-name fields)

          locals (reduce
                   (fn [m fld]
                     (assoc m fld
                              {:name fld
                               ;; why do these exist?
                               :line (ana/get-line fld env)
                               :column (ana/get-col fld env)
                               :local :field
                               :field true
                               :mutable true ;; always treat all as mutable
                               :tag (-> fld meta :tag)}))
                   {classname {:name qualified-name
                               :tag classname}}
                   field-syms)

          [_ ctor-args & ctor-body] constructor

          _ (assert (pos? (count ctor-args)) "contructor requires at least one argument name for this")

          [this-sym & ctor-args] ctor-args

          _ (assert (symbol? this-sym) "can't destructure first constructur argument")

          ctor-body
          (find-and-replace-super-call ctor-body)

          arg-syms (vec (take (count ctor-args) (repeatedly gensym)))

          ctor-locals
          (reduce-kv
            (fn [locals idx fld]
              ;; FIXME: what should fn args locals look like?
              (assoc locals fld {:name fld}))
            ;; pretty sure thats wrong but works in our favor
            ;; since accessing this before super() is invalid
            ;; and this kinda ensures that
            (assoc locals this-sym {:name (symbol "self__")
                                    :tag classname})
            arg-syms)

          ctor-env
          (assoc env :context :statement
                     :locals ctor-locals
                     ::extends extends
                     ::fields fields)

          ;; lazy way to deal with destructuring
          ctor-form
          `(cljs.core/let [~@(interleave ctor-args arg-syms)]
             ~@ctor-body)

          ctor-ast
          (ana/analyze ctor-env ctor-form)

          extend-ast
          (when (seq protocols)
            (let [extend-env
                  (assoc env :locals locals)

                  extend-form
                  `(cljs.core/extend-type ~classname
                     ~@(->> (for [{:keys [protocol-name protocol-fns]} protocols]
                              (into [protocol-name] protocol-fns))
                            (mapcat identity)))]
              (ana/analyze extend-env extend-form)))

          extends-ast
          (when extends
            (ana/analyze (assoc env :context :expr) extends))]

      (swap! env/*compiler* update-in [::ana/namespaces (-> env :ns :name) :defs classname]
        (fn [m]
          (-> m
              (assoc :name qualified-name
                     :tag 'function
                     :type true
                     :num-fields (count arg-syms)
                     :record false
                     :protocols #{})
              (merge (ana/source-info form env)))))

      (-> {:op ::class :env env :form form
           :qualified-name qualified-name
           :munged-name munged-name
           :classname classname
           :tag 'function
           :children []
           :ctor-args arg-syms
           :ctor ctor-ast}
          (cond->
            extends-ast
            (assoc :extends extends-ast)

            extend-ast
            (assoc :extend extend-ast :children [:ctor :extend]))))))

(defmethod comp/emit* ::class
  [{:keys [env qualified-name munged-name extends extend ctor-args ctor]}]
  (comp/emits (comp/munge qualified-name) " = class ")
  (comp/emits munged-name)
  (when extends
    (comp/emits " extends ")
    (comp/emit extends))
  (comp/emitln " {")

  (comp/emitln "  constructor(" (interpose "," ctor-args) ") {")
  (comp/emit ctor)
  (comp/emitln "  }")
  (comp/emitln "};")

  (when extend
    (comp/emit extend)))

;; this is always added by class* so we know the correct position
;; to initialize arguments since its not allowed to access this before super
(defmethod ana/parse `super*
  [op {::keys [extends fields] :as env} [_ & super-args :as form] name opts]
  {:op ::super
   :form form
   :env env
   :call-super? (some? extends)
   :children [:super-args :field-init]
   :super-args (mapv #(ana/analyze (assoc env :context :expr) %) super-args)
   :field-init
   (ana/analyze env
     `(~'do ~@(->> fields
                   (filter :field-default)
                   (map
                     (fn [{:keys [field-name field-default field-form]}]
                       (with-meta
                         `(~'set! ~field-name ~field-default)
                         (meta field-form))))
                   )))})

(defmethod comp/emit* ::super
  [{:keys [call-super? super-args field-init] :as ast}]
  (when call-super?
    (comp/emitln "super(" (interpose "," super-args) ");"))

  ;; required for direct field accesses here and anywhere in the ctor
  (comp/emitln "var self__ = this;")

  ;; initialize fields with defaults directly after super is called
  (comp/emit field-init))

;; only defclass for now since class expressions don't work with extend-type
;; could use a slightly slimmer version for class that doesn't allow protocols
;; or maybe go through specify or so?
(defmacro defclass [& body]
  `(defclass* ~@body))

(defmethod comp/emit* ::js-template
  [{:keys [env tagged parts]}]
  (comp/emit-wrap env
    (when tagged
      (comp/emit (first parts)))
    (comp/emits "`")
    (doseq [{:keys [op val] :as part} (if tagged (rest parts) parts)]
      (if (and (= :const op) (string? val))
        (let [quoted
              (-> val
                  ;; FIXME: anything else that needs replacing?
                  ;; newlines and stuff are allowed
                  (str/replace #"`" (constantly "\\`"))
                  (str/replace #"\$\{" (constantly "\\${")))]
          (comp/emits quoted))
        (do (comp/emits "${")
            (comp/emit part)
            (comp/emits "}"))))
    (comp/emits "`")))

(defmethod ana/parse `js-template*
  [op env form name opts]
  (let [part-env (assoc env :context :expr)
        parts (mapv #(ana/analyze part-env %) (rest form))]

    {:op ::js-template
     :env env
     :form form
     :parts parts
     :tagged (not (string? (second form)))
     :children [:parts]}))

(defmacro js-template [& body]
  `(js-template* ~@body))

;; FIXME: use spec for parsing this. bad errors otherwise if used incorrectly
(defmacro js-await [[name thenable] & body]
  (let [last-expr (last body)

        [body catch]
        (if (and (seq? last-expr) (= 'catch (first last-expr)))
          [(butlast body) last-expr]
          [body nil])]

    ;; FIXME: -> here will always return a promise so shouldn't be necessary to add js hint?
    `(-> ~thenable
         ~@(when (seq body)
             [`(.then (fn [~name] ~@body))])
         ~@(when catch
             (let [[_ name & body] catch]
               [`(.catch (fn [~name] ~@body))]
               )))))

(comment
  (macroexpand-1
    '(js-await [{:keys [foo]} (bar)]
       (do-thing foo)
       (catch x (fail x))
       ))

  (macroexpand-1
    '(js-await [{:keys [foo]} (bar)]
       (do-thing foo)))

  (macroexpand-1
    '(js-await [foo (bar)]
       (catch e :yo))))

fix js-await catch

fix js-await catch

fixes #1030


(ns lambdaui.api
  (:require [org.httpkit.server :as http :refer [with-channel on-close on-receive send!]]
            [compojure.core :refer [routes GET POST defroutes]]
            [lambdaui.dummy-data :as frontend-dummy]
            [ring.middleware.json :as ring-json]
            [compojure.route :as route])
  )

;spike websocket -- example code.
;(defonce c (atom nil))
;(defn websocket [req]
;  (reset! c (with-channel req channel
;                          (on-close channel (fn [status] (println "channel closed: " status)))
;                          (on-receive channel (fn [data]    ;; echo it back
;                                                (send! channel data)))))
;  )

(defn backend-for-frontend []
  (ring-json/wrap-json-response
    (routes (GET "/api/summaries" [] (frontend-dummy/build-summaries))
            (GET "/" [] (ring.util.response/redirect "/ui/index.html"))
            (route/resources "/ui" {:root "public"})
            ))
  )

(defonce server (atom nil))

(defn start-server [port]
  (reset! server (http/run-server (backend-for-frontend) {:port port})))

(ns lambdaui.api
  (:require [org.httpkit.server :as http :refer [with-channel on-close on-receive send!]]
            [compojure.core :refer [routes GET POST defroutes]]
            [lambdaui.dummy-data :as frontend-dummy]
            [ring.middleware.json :as ring-json]
            [compojure.route :as route])
  )

;spike websocket -- example code.
;(defonce c (atom nil))
;(defn websocket [req]
;  (reset! c (with-channel req channel
;                          (on-close channel (fn [status] (println "channel closed: " status)))
;                          (on-receive channel (fn [data]    ;; echo it back
;                                                (send! channel data)))))
;  )

(defn ui-for-pipeline [pipeline]
  (ring-json/wrap-json-response
    (routes (GET "/api/summaries" [] (frontend-dummy/build-summaries))
            (GET "/" [] (ring.util.response/redirect "/ui/index.html"))
            (route/resources "/ui" {:root "public"})
            ))
  )

(defonce server (atom nil))

(defn start-server [port]
  (reset! server (http/run-server (ui-for-pipeline nil) {:port port})))

rename routes function

rename routes function


(ns user
  (:require [clojure.pprint :refer (pprint pp)]
            [clojure.tools.namespace.repl :refer (refresh refresh-all)]
            [cmr.dev-system.system :as system]
            [cmr.dev-system.tests :as tests]
            [cmr.common.log :as log :refer (debug info warn error)]
            [cmr.common.dev.util :as d]
            [cmr.system-int-test.system :as sit-sys]
            [cmr.common.jobs :as jobs]
            [cmr.common.config :as config]
            [earth.driver :as earth-viz]
            [common-viz.util :as common-viz]
            [vdd-core.core :as vdd])
  (:use [clojure.test :only [run-all-tests]]
        [clojure.repl]
        [alex-and-georges.debug-repl]
        [cmr.common.dev.capture-reveal]))

(def system nil)

(defn start
  "Starts the current development system."
  []
  (config/reset-config-values)

  (jobs/set-default-job-start-delay! (* 3 3600))

  ;; Comment/uncomment these lines to switch between external and internal settings.

  (system/set-dev-system-elastic-type! :in-memory)
  ; (system/set-dev-system-elastic-type! :external)

  ;; Note external ECHO does not work with the automated tests. The automated tests expect they
  ;; can interact with the Mock ECHO to setup users, acls, and other ECHO objects.
  (system/set-dev-system-echo-type! :in-memory)
  ; (system/set-dev-system-echo-type! :external)

  ; (system/set-dev-system-db-type! :in-memory)
  (system/set-dev-system-db-type! :external)

  (system/set-dev-system-message-queue-type! :in-memory)
  ; (system/set-dev-system-message-queue-type! :external)

  (let [s (system/create-system)]
    (alter-var-root #'system
                    (constantly
                      (system/start s))))
  (d/touch-user-clj))

(defn stop
  "Shuts down and destroys the current development system."
  []
  (alter-var-root #'system
                  (fn [s]
                    (when s (system/stop s)))))

(defn reset []
  ;; Stop the system integration test system
  (sit-sys/stop)
  ; Stops the running code
  (stop)
  ; Refreshes all of the code and then restarts the system
  (refresh :after 'user/start))

(defn reload-coffeescript []
  (do
    (println "Compiling coffeescript")
    (println (common-viz/compile-coffeescript (get-in system [:components :vdd-server :config])))
    (vdd/data->viz {:cmd :reload})))

(defn run-all-tests-future
  "Runs all tests asynchronously, with :fail-fast? and :speak? enabled."
  []
  (future
    (tests/run-all-tests {:fail-fast? true :speak? true})))

(info "Custom dev-system user.clj loaded.")

(ns user
  (:require [clojure.pprint :refer (pprint pp)]
            [clojure.tools.namespace.repl :refer (refresh refresh-all)]
            [cmr.dev-system.system :as system]
            [cmr.dev-system.tests :as tests]
            [cmr.common.log :as log :refer (debug info warn error)]
            [cmr.common.dev.util :as d]
            [cmr.system-int-test.system :as sit-sys]
            [cmr.common.jobs :as jobs]
            [cmr.common.config :as config]
            [earth.driver :as earth-viz]
            [common-viz.util :as common-viz]
            [vdd-core.core :as vdd])
  (:use [clojure.test :only [run-all-tests]]
        [clojure.repl]
        [alex-and-georges.debug-repl]
        [cmr.common.dev.capture-reveal]))

(def system nil)

(defn start
  "Starts the current development system."
  []
  (config/reset-config-values)

  (jobs/set-default-job-start-delay! (* 3 3600))

  ;; Comment/uncomment these lines to switch between external and internal settings.

  (system/set-dev-system-elastic-type! :in-memory)
  ; (system/set-dev-system-elastic-type! :external)

  ;; Note external ECHO does not work with the automated tests. The automated tests expect they
  ;; can interact with the Mock ECHO to setup users, acls, and other ECHO objects.
  (system/set-dev-system-echo-type! :in-memory)
  ; (system/set-dev-system-echo-type! :external)

  (system/set-dev-system-db-type! :in-memory)
  ; (system/set-dev-system-db-type! :external)

  (system/set-dev-system-message-queue-type! :in-memory)
  ; (system/set-dev-system-message-queue-type! :external)

  (let [s (system/create-system)]
    (alter-var-root #'system
                    (constantly
                      (system/start s))))
  (d/touch-user-clj))

(defn stop
  "Shuts down and destroys the current development system."
  []
  (alter-var-root #'system
                  (fn [s]
                    (when s (system/stop s)))))

(defn reset []
  ;; Stop the system integration test system
  (sit-sys/stop)
  ; Stops the running code
  (stop)
  ; Refreshes all of the code and then restarts the system
  (refresh :after 'user/start))

(defn reload-coffeescript []
  (do
    (println "Compiling coffeescript")
    (println (common-viz/compile-coffeescript (get-in system [:components :vdd-server :config])))
    (vdd/data->viz {:cmd :reload})))

(defn run-all-tests-future
  "Runs all tests asynchronously, with :fail-fast? and :speak? enabled."
  []
  (future
    (tests/run-all-tests {:fail-fast? true :speak? true})))

(info "Custom dev-system user.clj loaded.")

Reset db config

CMR-1687: Reset db config


(ns c2.core-test
  (:use-macros [c2.util :only [p pp profile]])
  (:require [c2.svg :as svg])
  (:use [c2.core :only [unify!]]
        [c2.dom :only [attr children]]))

(set! *print-fn* #(.log js/console %))

(def xhtml "http://www.w3.org/1999/xhtml")

(def container (.createElementNS js/document xhtml "div"))
(def svg-container (.createElementNS js/document "http://www.w3.org/2000/svg" "svg"))
;;Appending to html instead of body here because of PhantomJS page.injectJs() wonky behavior
(.appendChild (.querySelector js/document "html") container)
(.appendChild (.querySelector js/document "html") svg-container)

(defn clear! []
  (set! (.-innerHTML container) "")
  (set! (.-innerHTML svg-container) ""))

(print "\n\nSingle node enter/update/exit\n=============================")
(let [n 100
      mapping (fn [d] [:span {:x d} (str d)])]

  (profile (str "ENTER single tag with " n " data")
           (unify! container (range n) mapping))
  (let [children (children container)
        fel      (first children)]
    (assert (= n (count children)))
    (assert (= "span" (.toLowerCase (.-nodeName fel))))
    (assert (= "0" (:x (attr fel)))))

  (profile (str "UPDATE single tag, reversing order")
           (unify! container (reverse (range n)) mapping))
  (let [children (children container)
        fel       (first children)]
    (assert (= n (count children)))
    (assert (= "span" (.toLowerCase (.-nodeName fel))))
    (assert (= (str (dec n)) (:x (attr fel)))))

  (profile (str "UPDATE single tag with new datum")
           (unify! container (range (inc n)) mapping))
  (assert (= (inc n) (count (children container))))

  (profile (str "REMOVE " (/ n 2) " single tags")
           (unify! container (range (/ n 2)) mapping))
  (assert (= (/ n 2)  (count (children container)))))

(clear!)

(print "\n\nMore complex dataset\n====================")
(let [n 100
      data (map #(hash-map :id % :val (str (rand)))
                (range n))
      new-data (map #(assoc % :val (str (rand))) data)
      mapping (fn [d idx] [:div {:val (:val d)}
                          [:span (str (:id d))]])]
  (profile "ENTER node hiearchy"
           (unify! container data mapping
                   :key-fn :id))
  (assert (= 100 (count (children container))))

  (profile "UPDATE/EXIT node hiearchy"
           (unify! container (take 10 new-data) mapping
                   :key-fn :id))

  (assert (= 10 (count (children container))))
  (assert (= (:val (first new-data))
             (:val (attr (first (children container)))))))

(clear!)

(print "\n\nHurray, no errors!")

(ns c2.core-test
  (:use-macros [c2.util :only [p pp profile]])
  (:require [c2.svg :as svg])
  (:use [c2.core :only [unify!]]
        [c2.dom :only [attr children]]))

(set! *print-fn* #(.log js/console %))

(def xhtml "http://www.w3.org/1999/xhtml")

(def container (.createElementNS js/document xhtml "div"))
(def svg-container (.createElementNS js/document "http://www.w3.org/2000/svg" "svg"))
;;Appending to html instead of body here because of PhantomJS page.injectJs() wonky behavior
(.appendChild (.querySelector js/document "html") container)
(.appendChild (.querySelector js/document "html") svg-container)

(defn clear! []
  (set! (.-innerHTML container) "")
  (set! (.-innerHTML svg-container) ""))

(print "\n\nSingle node enter/update/exit\n=============================")
(let [n 100
      mapping (fn [d] [:span {:x d} (str d)])]

  (profile (str "ENTER single tag with " n " data")
           (unify! container (range n) mapping))
  (let [children (children container)
        fel      (first children)]
    (assert (= n (count children)))
    (assert (= "span" (.toLowerCase (.-nodeName fel))))
    (assert (= "0" (:x (attr fel)))))

  (profile (str "UPDATE single tag, reversing order")
           (unify! container (reverse (range n)) mapping))
  (let [children (children container)
        fel       (first children)]
    (assert (= n (count children)))
    (assert (= "span" (.toLowerCase (.-nodeName fel))))
    (assert (= (str (dec n)) (:x (attr fel)))))

  (profile (str "UPDATE single tag with new datum")
           (unify! container (range (inc n)) mapping))
  (assert (= (inc n) (count (children container))))

  (profile (str "REMOVE " (/ n 2) " single tags")
           (unify! container (range (/ n 2)) mapping))
  (assert (= (/ n 2)  (count (children container)))))

(clear!)

(print "\n\nAtom-updates on single node enter/update/exit\n=============================")
(let [n 100
      mapping (fn [d] [:span {:x d} (str d)])
      !ds (atom (range n))]

  (profile (str "ENTER single tag with " n " data")
           (unify! container !ds mapping))
  (let [children (children container)
        fel      (first children)]
    (assert (= n (count children)))
    (assert (= "span" (.toLowerCase (.-nodeName fel))))
    (assert (= "0" (:x (attr fel)))))

  (profile (str "UPDATE single tag, reversing order")
           (swap! !ds reverse))
  (let [children (children container)
        fel       (first children)]
    (assert (= n (count children)))
    (assert (= "span" (.toLowerCase (.-nodeName fel))))
    (assert (= (str (dec n)) (:x (attr fel))))))

(clear!)

(print "\n\nMore complex dataset\n====================")
(let [n 100
      data (map #(hash-map :id % :val (str (rand)))
                (range n))
      new-data (map #(assoc % :val (str (rand))) data)
      mapping (fn [d idx] [:div {:val (:val d)}
                          [:span (str (:id d))]])]
  (profile "ENTER node hiearchy"
           (unify! container data mapping
                   :key-fn :id))
  (assert (= 100 (count (children container))))

  (profile "UPDATE/EXIT node hiearchy"
           (unify! container (take 10 new-data) mapping
                   :key-fn :id))

  (assert (= 10 (count (children container))))
  (assert (= (:val (first new-data))
             (:val (attr (first (children container)))))))

(clear!)

(print "\n\nHurray, no errors!")

Test unify! updates for datasets referenced by an atom.


(ns taoensso.faraday.tests.main
  (:require [expectations     :as test :refer :all]
            [taoensso.encore  :as encore]
            [taoensso.faraday :as far]
            [taoensso.nippy   :as nippy])
  (:import  [com.amazonaws.auth BasicAWSCredentials]
            [com.amazonaws.internal StaticCredentialsProvider]))

;; TODO LOTS of tests still outstanding, PRs very, very welcome!!

(comment (test/run-tests '[taoensso.faraday.tests.main]))

;;;; Config & setup

(def ^:dynamic *client-opts*
  {:access-key (get (System/getenv) "AWS_DYNAMODB_ACCESS_KEY")
   :secret-key (get (System/getenv) "AWS_DYNAMODB_SECRET_KEY")
   :endpoint   (get (System/getenv) "AWS_DYNAMODB_ENDPOINT")})

(def ttable :faraday.tests.main)
(def range-table :faraday.tests.range)

(defn- before-run {:expectations-options :before-run} []
  (assert (and (:access-key *client-opts*)
               (:secret-key *client-opts*)))
  (println "Setting up testing environment...")
  (far/ensure-table *client-opts* ttable [:id :n]
    {:throughput  {:read 1 :write 1}
     :block?      true})
  (far/ensure-table *client-opts* range-table [:title :s]
    {:range-keydef [:number :n]
     :throughput   {:read 1 :write 1}
     :block?       true})
  (println "Ready to roll..."))

(defn- after-run {:expectations-options :after-run} [])

(comment (far/delete-table *client-opts* ttable))

;;;; Basic API

(let [i0 {:id 0 :name "foo"}
      i1 {:id 1 :name "bar"}]

  (far/batch-write-item *client-opts* {ttable {:delete [{:id 0} {:id 1} {:id 2}]}})

  (expect ; Batch put
   [i0 i1 nil] (do (far/batch-write-item *client-opts* {ttable {:put [i0 i1]}})
                   [(far/get-item *client-opts* ttable {:id  0})
                    (far/get-item *client-opts* ttable {:id  1})
                    (far/get-item *client-opts* ttable {:id -1})]))

  (expect ; Batch get
   (set [i0 i1]) (->> (far/batch-get-item *client-opts*
                        {ttable {:prim-kvs    {:id [0 1]}
                                 :consistent? true}})
                      ttable set))

  (expect ; Batch get, with :attrs
   (set [(dissoc i0 :name) (dissoc i1 :name)])
   (->> (far/batch-get-item *client-opts*
          {ttable {:prim-kvs    {:id [0 1]}
                   :attrs       [:id]
                   :consistent? true}})
        ttable set))

  (expect ; Batch delete
   [nil nil] (do (far/batch-write-item *client-opts* {ttable {:delete {:id [0 1]}}})
                 [(far/get-item *client-opts* ttable {:id 0})
                  (far/get-item *client-opts* ttable {:id 1})])))

;;;; Range queries
(let [j0 {:title "One" :number 0}
      j1 {:title "One" :number 1}
      k0 {:title "Two" :number 0}
      k1 {:title "Two" :number 1}]

  (far/batch-write-item *client-opts*
    {range-table {:put [j0 j1 k0 k1]}})

  (expect ; Query, normal ordering
    [j0 j1] (far/query *client-opts* range-table {:title [:eq "One"]}))

  (expect ; Query, reverse ordering
    [j1 j0] (far/query *client-opts* range-table {:title [:eq "One"]}
              {:order :desc}))

  (expect ; Query with :limit
    [j0] (far/query *client-opts* range-table {:title [:eq "One"]}
           {:limit 1 :span-reqs {:max 1}})))

(expect-let ; Serialization
 ;; Dissoc'ing :bytes, :throwable, :ex-info, and :exception because Object#equals()
 ;; is reference-based and not structural. `expect` falls back to Java equality,
 ;; and so will fail when presented with different Java objects that don't themselves
 ;; implement #equals() - such as arrays and Exceptions - despite having identical data.
 [data ;; nippy/stress-data-comparable ; Awaiting Nippy v2.6
  (dissoc nippy/stress-data :bytes :throwable :exception :ex-info)]
 {:id 10 :nippy-data data}
 (do (far/put-item *client-opts* ttable {:id 10 :nippy-data (far/freeze data)})
     (far/get-item *client-opts* ttable {:id 10})))

(expect-let ; "Unserialized" bytes
 [data (byte-array (mapv byte [0 1 2]))]
 #(encore/ba= data %)
 (do (far/put-item *client-opts* ttable {:id 11 :ba-data data})
     (:ba-data (far/get-item *client-opts* ttable {:id 11}))))

(let [i0 {:id 0 :name "foo"}
      i1 {:id 1 :name "bar"}
      i2 {:id 2 :name "baz"}]

  (expect ; Throw for bad conds
   #=(far/ex :conditional-check-failed)
   (do (far/batch-write-item *client-opts* {ttable {:put [i0 i1]}})
       (far/put-item *client-opts* ttable i1 {:expected {:id false}})))

  ;;; Proceed for good conds
  (expect nil? (far/put-item *client-opts* ttable i1 {:expected {:id 1}}))
  (expect nil? (far/put-item *client-opts* ttable i2 {:expected {:id false}}))
  (expect nil? (far/put-item *client-opts* ttable i2 {:expected {:id 2
                                                               :dummy false}})))

;; (expect (interaction (println anything&)) (println 5))
;; (expect (interaction (println Long))      (println 5))

;;; Test AWSCredentialProvider
(when-let [endpoint (:endpoint *client-opts*)]
  (let [i0 {:id 0 :name "foo"}
        i1 {:id 1 :name "bar"}
        i2 {:id 2 :name "baz"}
        creds    (BasicAWSCredentials. (:access-key *client-opts*)
                   (:secret-key *client-opts*))
        provider (StaticCredentialsProvider. creds)]

    (binding [*client-opts* {:provider provider
                             :endpoint endpoint}]

      (expect ; Batch put
        [i0 i1 nil]
        (do
          (far/batch-write-item *client-opts*
            {ttable {:delete [{:id 0} {:id 1} {:id 2}]}})
          ;;
          (far/batch-write-item *client-opts* {ttable {:put [i0 i1]}})
          [(far/get-item *client-opts* ttable {:id  0})
           (far/get-item *client-opts* ttable {:id  1})
           (far/get-item *client-opts* ttable {:id -1})])))))

;;; Test `list-tables` lazy sequence
;; Creates a _large_ number of tables so only run locally
(when-let [endpoint (:endpoint *client-opts*)]
  (when (.contains ^String endpoint "localhost")
    (expect
      (let [;; Generate > 100 tables to exceed the batch size limit:
            tables (map #(keyword (str "test_" %)) (range 102))]
        (doseq [table tables]
          (far/ensure-table *client-opts* table [:id :n]
            {:throughput  {:read 1 :write 1}
             :block?      true}))
        (let [table-count (count (far/list-tables *client-opts*))]
          (doseq [table tables]
            (far/delete-table *client-opts* table))
          (> table-count 100))))))

(ns taoensso.faraday.tests.main
  (:require [expectations     :as test :refer :all]
            [taoensso.encore  :as encore]
            [taoensso.faraday :as far]
            [taoensso.nippy   :as nippy])
  (:import  [com.amazonaws.auth BasicAWSCredentials]
            [com.amazonaws.internal StaticCredentialsProvider]))

;; TODO LOTS of tests still outstanding, PRs very, very welcome!!

(comment (test/run-tests '[taoensso.faraday.tests.main]))

;;;; Config & setup

(def ^:dynamic *client-opts*
  {:access-key (get (System/getenv) "AWS_DYNAMODB_ACCESS_KEY")
   :secret-key (get (System/getenv) "AWS_DYNAMODB_SECRET_KEY")
   :endpoint   (get (System/getenv) "AWS_DYNAMODB_ENDPOINT")})

(def ttable :faraday.tests.main)
(def range-table :faraday.tests.range)

(def run-after-setup (atom #{}))

(defn- after-setup! [thunk]
  (swap! run-after-setup conj thunk))

(defn- before-run {:expectations-options :before-run} []
  (assert (and (:access-key *client-opts*)
               (:secret-key *client-opts*)))
  (println "Setting up testing environment...")
  (far/ensure-table *client-opts* ttable [:id :n]
    {:throughput  {:read 1 :write 1}
     :block?      true})
  (far/ensure-table *client-opts* range-table [:title :s]
    {:range-keydef [:number :n]
     :throughput   {:read 1 :write 1}
     :block?       true})

  (doseq [thunk @run-after-setup]
    (thunk))

  (println "Ready to roll..."))

(defn- after-run {:expectations-options :after-run} [])

(comment (far/delete-table *client-opts* ttable))

;;;; Basic API

(let [i0 {:id 0 :name "foo"}
      i1 {:id 1 :name "bar"}]

  (after-setup!
   #(far/batch-write-item *client-opts*
                          {ttable {:delete [{:id 0} {:id 1} {:id 2}]}}))

  (expect ; Batch put
   [i0 i1 nil] (do (far/batch-write-item *client-opts* {ttable {:put [i0 i1]}})
                   [(far/get-item *client-opts* ttable {:id  0})
                    (far/get-item *client-opts* ttable {:id  1})
                    (far/get-item *client-opts* ttable {:id -1})]))

  (expect ; Batch get
   (set [i0 i1]) (->> (far/batch-get-item *client-opts*
                        {ttable {:prim-kvs    {:id [0 1]}
                                 :consistent? true}})
                      ttable set))

  (expect ; Batch get, with :attrs
   (set [(dissoc i0 :name) (dissoc i1 :name)])
   (->> (far/batch-get-item *client-opts*
          {ttable {:prim-kvs    {:id [0 1]}
                   :attrs       [:id]
                   :consistent? true}})
        ttable set))

  (expect ; Batch delete
   [nil nil] (do (far/batch-write-item *client-opts* {ttable {:delete {:id [0 1]}}})
                 [(far/get-item *client-opts* ttable {:id 0})
                  (far/get-item *client-opts* ttable {:id 1})])))

(let [i {:id 10 :name "update me"}]

  (after-setup!
    #(far/delete-item *client-opts* ttable {:id 10}))

  (expect
   {:id 10 :name "baz"}
   (do
     (far/put-item *client-opts* ttable i)
     (far/update-item
        *client-opts* ttable {:id 10} {:name [:put "baz"]} {:return :all-new})))

  (expect
   #= (far/ex :conditional-check-failed)
   (far/update-item *client-opts* ttable
       {:id 10} {:name [:put "baz"]}
       {:expected {:name "garbage"}})))

(let [items [{:id 11 :name "eleven" :test "batch"}
             {:id 12 :name "twelve" :test "batch"}
             {:id 13 :name "thirteen" :test "batch"}]
      [i1 i2 i3] items]

  (after-setup!
   (fn [] (far/batch-write-item
          *client-opts* {ttable {:delete (map #(select-keys % #{:id}) items)}})))

  (expect
   [i1]
   (do (far/batch-write-item *client-opts* {ttable {:put items}})
       (far/scan *client-opts* ttable
                 {:attr-conds {:name [:eq "eleven"]}})))

  (expect
   #{i1 i3}
   (into #{} (far/scan *client-opts* ttable
                       {:attr-conds {:name [:ne "twelve"]
                                     :test [:eq "batch"]}})))

  (expect
   (repeat 3 {:test "batch"})
   (far/scan *client-opts* ttable {:attr-conds {:test [:eq "batch"]}
                                   :return [:test]})))

;;;; range queries
(let [j0 {:title "One" :number 0}
      j1 {:title "One" :number 1}
      k0 {:title "Two" :number 0}
      k1 {:title "Two" :number 1}]

  (after-setup!
    #(far/batch-write-item *client-opts* {range-table {:put [j0 j1 k0 k1]}}))

  (expect ; Query, normal ordering
    [j0 j1] (far/query *client-opts* range-table {:title [:eq "One"]}))

  (expect ; Query, reverse ordering
    [j1 j0] (far/query *client-opts* range-table {:title [:eq "One"]}
              {:order :desc}))

  (expect ; Query with :limit
    [j0] (far/query *client-opts* range-table {:title [:eq "One"]}
           {:limit 1 :span-reqs {:max 1}})))

(expect-let ; Serialization
 ;; Dissoc'ing :bytes, :throwable, :ex-info, and :exception because Object#equals()
 ;; is reference-based and not structural. `expect` falls back to Java equality,
 ;; and so will fail when presented with different Java objects that don't themselves
 ;; implement #equals() - such as arrays and Exceptions - despite having identical data.
 [data ;; nippy/stress-data-comparable ; Awaiting Nippy v2.6
  (dissoc nippy/stress-data :bytes :throwable :exception :ex-info)]
 {:id 10 :nippy-data data}
 (do (far/put-item *client-opts* ttable {:id 10 :nippy-data (far/freeze data)})
     (far/get-item *client-opts* ttable {:id 10})))

(expect-let ; "Unserialized" bytes
 [data (byte-array (mapv byte [0 1 2]))]
 #(encore/ba= data %)
 (do (far/put-item *client-opts* ttable {:id 11 :ba-data data})
     (:ba-data (far/get-item *client-opts* ttable {:id 11}))))

(let [i0 {:id 0 :name "foo"}
      i1 {:id 1 :name "bar"}
      i2 {:id 2 :name "baz"}]

  (expect ; Throw for bad conds
   #=(far/ex :conditional-check-failed)
   (do (far/batch-write-item *client-opts* {ttable {:put [i0 i1]}})
       (far/put-item *client-opts* ttable i1 {:expected {:id false}})))

  ;;; Proceed for good conds
  (expect nil? (far/put-item *client-opts* ttable i1 {:expected {:id 1}}))
  (expect nil? (far/put-item *client-opts* ttable i2 {:expected {:id false}}))
  (expect nil? (far/put-item *client-opts* ttable i2 {:expected {:id 2
                                                               :dummy false}})))

;; (expect (interaction (println anything&)) (println 5))
;; (expect (interaction (println Long))      (println 5))

;;; Test AWSCredentialProvider
(when-let [endpoint (:endpoint *client-opts*)]
  (let [i0 {:id 0 :name "foo"}
        i1 {:id 1 :name "bar"}
        i2 {:id 2 :name "baz"}
        creds    (BasicAWSCredentials. (:access-key *client-opts*)
                   (:secret-key *client-opts*))
        provider (StaticCredentialsProvider. creds)]

    (binding [*client-opts* {:provider provider
                             :endpoint endpoint}]

      (expect ; Batch put
        [i0 i1 nil]
        (do
          (far/batch-write-item *client-opts*
            {ttable {:delete [{:id 0} {:id 1} {:id 2}]}})
          ;;
          (far/batch-write-item *client-opts* {ttable {:put [i0 i1]}})
          [(far/get-item *client-opts* ttable {:id  0})
           (far/get-item *client-opts* ttable {:id  1})
           (far/get-item *client-opts* ttable {:id -1})])))))

;;; Test `list-tables` lazy sequence
;; Creates a _large_ number of tables so only run locally
(when-let [endpoint (:endpoint *client-opts*)]
  (when (.contains ^String endpoint "localhost")
    (expect
     (let [ ;; Generate > 100 tables to exceed the batch size limit:
           tables (map #(keyword (str "test_" %)) (range 102))]
       (doseq [table tables]
         (far/ensure-table *client-opts* table [:id :n]
                           {:throughput  {:read 1 :write 1}
                            :block?      true}))
       (let [table-count (count (far/list-tables *client-opts*))]
         (doseq [table tables]
           (far/delete-table *client-opts* table))
         (> table-count 100))))

    (let [update-t :faraday.tests.update-table]
      (after-setup!
       #(do
          (when (far/describe-table *client-opts* update-t)
            (far/delete-table *client-opts* update-t))
          (far/create-table
           *client-opts* update-t [:id :n]
           {:throughput {:read 1 :write 1} :block? true})))

      (expect
       {:read 2 :write 2}
       (-> (far/update-table *client-opts* update-t {:read 2 :write 2})
           deref
           :throughput
           (select-keys #{:read :write}))))))

Extend test coverage to all Dynamo API fns