(ns fudje.sweet
  (:require [fudje.checkers :as checkers]
            [fudje.core :refer [mocking]]))

(defonce anything
  (fudje.checkers/->AnythingChecker))

(defonce irrelevant anything) ;; just a synonym

(defonce truthy
  (checkers/->TruthyChecker))

(defonce falsey
  (checkers/->FalseyChecker))

(defmacro contains
  "A macro to help us simulate the `contains` checker."
  [x & modifiers]
  `(fudje.checkers/->ContainsChecker ~x ~(zipmap modifiers (repeat true))))

(defmacro just
  "A macro to help us simulate the `just` argument-checker."
  [x & modifiers]
  `(fudje.checkers/->JustChecker ~x ~(zipmap modifiers (repeat true))))

(defmacro checker
  "A macro to help us simulate the `checker` checker."
  [& x]
  (if (vector? (first x))  ;;catch this syntactic quirk of midje
    `(fudje.checkers/->CustomChecker (fn ~@x))
    `(fudje.checkers/->CustomChecker ~(first x))))

(defmacro n-of
  "A macro to help us simulate the `n-of` checker."
  [x y]
  `(fudje.checkers/->NofChecker ~x ~y))

(defmacro one-of
  "A macro to help us simulate the `one-of` checker."
  [x]
  `(n-of ~x 1))

(defmacro two-of
  "A macro to help us simulate the `two-of` checker."
  [x]
  `(n-of ~x 2))

(defmacro three-of
  "A macro to help us simulate the `three-of` checker."
  [x]
  `(n-of ~x 3))

(defmacro four-of
  "A macro to help us simulate the `four-of` checker."
  [x]
  `(n-of ~x 4))

(defmacro five-of
  "A macro to help us simulate the `five-of` checker."
  [x]
  `(n-of ~x 5))

(defmacro six-of
  "A macro to help us simulate the `six-of` checker."
  [x]
  `(n-of ~x 6))

(defmacro seven-of
  "A macro to help us simulate the `seven-of` checker."
  [x]
  `(n-of ~x 7))

(defmacro eight-of
  "A macro to help us simulate the `eight-of` checker."
  [x]
  `(n-of ~x 8))

(defmacro nine-of
  "A macro to help us simulate the `nine-of` checker."
  [x]
  `(n-of ~x 9))

(defmacro ten-of
  "A macro to help us simulate the `ten-of` checker."
  [x]
  `(n-of ~x 10))

(defmacro has
  "A macro to help us simulate the `has` checker."
  [x y]
  `(fudje.checkers/->HasChecker ~x ~y))

(defmacro roughly
  "A macro to help us simulate the `roughly` checker."
  [x & y]
  (do
    (assert (number? x) "First argument to `roughly` MUST be a number!")
    `(fudje.checkers/->RoughlyChecker ~x ~(first y))))

(defmacro every-checker
  "A macro to help us simulate the `every-checker` checker."
  [& checkers]
  `(let [cs# ~(vec checkers)]
     (assert (every? fudje.util/poly-checker? cs#) "`every-checker` expects checkers!")
     (fudje.checkers/->EveryChecker cs#)))

(defmacro split-in-provided-without-metaconstants
  "Given a some typical Midje code where some `provided` clauses (mocks) follow the actual test assertions,
  separate the assertions from the mocks. Also replaces all meta-constants with keywords.
  Returns a vector of [<forms-before-provided (assertions)> <forms-after-provided (mocks)>]."
  [forms]
  `(->> ~forms
        (split-with #(if (list? %)
                      (not= :provided (keyword (symbol (first %))))
                      true))
        (map (partial clojure.walk/postwalk (fn [form#]
                                              (let [[mc?# to-replace#] (fudje.util/metaconstant? form#)]
                                                (if mc?#
                                                  (fudje.util/metaconstant->kw form# to-replace#)
                                                  (if (fudje.util/throwable? to-replace#) ;;we do not support replacing funciton-metaconstants, check for the Exception object here
                                                    (throw to-replace#)
                                                    form#))))))))

(defn- expand-tests
  "Map midje symbols `=>` & `=throws=>` to `is` & `(is (thrown? ...` respectively."
  [tests]
  (for [[t symb res] tests]
    (condp = symb
      '=> `(let [expected# ~res] ;; this is the common case
             (if (fudje.util/poly-checker? expected#)
               (clojure.test/is (~'compatible expected# ~t))
               (clojure.test/is (= ~res ~t))))
      '=throws=> (let [[xxx msg] res     ;; <xxx> will either be a Class or an Exception object
                       xxx-klass (cond-> xxx
                                         (fudje.util/throwable? xxx) class)]
                   (if (nil? msg)
                     `(clojure.test/is (~'thrown? ~xxx-klass ~t))
                     `(clojure.test/is (~'thrown-with-msg? ~xxx-klass ~(cond-> msg
                                                                               (string? msg) re-pattern) ~t))))
      (throw (IllegalArgumentException. ^String (format "arrow %s not recognised!" (str symb)))))))

(defmacro fact
  "An (almost) drop-in replacement for `midje.sweet/fact` which rewrites the code to not use Midje.
  Rudimentary support for converting top-level midje checkers exists (`contains` & `just`).
  ATTENTION: `let` bindings right after a `midje.sweet.fact` should be manually pulled one level up, before switching to `novate.sweet.fact`."
  [description & forms]
  (assert (string? description) "`novate.sweet/fact` requires a String description as the first arg (per `clojure.test/testing`)...")
  (let [[pre-provided post-provided] (fudje.sweet/split-in-provided-without-metaconstants forms)
        tests (->> pre-provided
                   (partition 3)
                   (map (fn [[t _ r :as x]]
                          (if (and (list? r)
                                   (= 'throws (symbol (first r))))
                            [t '=throws=> (rest r)]   ;; this requires special treatment (see `expand-tests`)
                            x)))
                   )
        mocks (-> post-provided first rest)]
    `(clojure.test/testing ~description
       (fudje.core/mocking ~mocks
         ~@(fudje.sweet/expand-tests tests)))
    ))

(defmacro are* ;;
  "Slightly patched version of `clojure.test/are` that assumes that <expr> is a `fact` or `mocking`.
   Only difference is that <expr> is NOT evaluated within the context of a `clojure.test/is` as the `fact` takes care of that.
   Not really intended for public use but it has to stay a public Var."
  {:added "1.1"}
  [argv expr & args]
  (if (or
        (and (empty? argv) (empty? args))
        (and (pos? (count argv))
             (pos? (count args))
             (zero? (mod (count args) (count argv)))))
    `(clojure.template/do-template ~argv ~expr ~@args)
    (throw (IllegalArgumentException. "The number of args doesn't match are's argv."))))

(defmacro tabular [fact-expr & body]
  (let [arga (volatile! #{})
        _ (clojure.walk/prewalk (fn [x]
                                  (if (fudje.util/qmark? x)
                                    (do (vswap! arga conj x) x)
                                    x))
                                fact-expr)
        [args assertions] (split-at (count @arga) body)]
    `(fudje.sweet/are* ~(vec args) ~fact-expr ~@assertions)))

(ns fudje.sweet
  (:require [fudje.checkers :as checkers]
            [fudje.core :refer [mocking]]))

(defonce anything
  (fudje.checkers/->AnythingChecker))

(defonce irrelevant anything) ;; just a synonym

(defonce truthy
  (checkers/->TruthyChecker))

(defonce falsey
  (checkers/->FalseyChecker))

(defmacro contains
  "A macro to help us simulate the `contains` checker."
  [x & modifiers]
  `(fudje.checkers/->ContainsChecker ~x ~(zipmap modifiers (repeat true))))

(defmacro just
  "A macro to help us simulate the `just` argument-checker."
  [x & modifiers]
  `(fudje.checkers/->JustChecker ~x ~(zipmap modifiers (repeat true))))

(defmacro checker
  "A macro to help us simulate the `checker` checker."
  [& x]
  (if (vector? (first x))  ;;catch this syntactic quirk of midje
    `(fudje.checkers/->CustomChecker (fn ~@x))
    `(fudje.checkers/->CustomChecker ~(first x))))

(defmacro n-of
  "A macro to help us simulate the `n-of` checker."
  [x y]
  `(fudje.checkers/->NofChecker ~x ~y))

(defmacro one-of
  "A macro to help us simulate the `one-of` checker."
  [x]
  `(n-of ~x 1))

(defmacro two-of
  "A macro to help us simulate the `two-of` checker."
  [x]
  `(n-of ~x 2))

(defmacro three-of
  "A macro to help us simulate the `three-of` checker."
  [x]
  `(n-of ~x 3))

(defmacro four-of
  "A macro to help us simulate the `four-of` checker."
  [x]
  `(n-of ~x 4))

(defmacro five-of
  "A macro to help us simulate the `five-of` checker."
  [x]
  `(n-of ~x 5))

(defmacro six-of
  "A macro to help us simulate the `six-of` checker."
  [x]
  `(n-of ~x 6))

(defmacro seven-of
  "A macro to help us simulate the `seven-of` checker."
  [x]
  `(n-of ~x 7))

(defmacro eight-of
  "A macro to help us simulate the `eight-of` checker."
  [x]
  `(n-of ~x 8))

(defmacro nine-of
  "A macro to help us simulate the `nine-of` checker."
  [x]
  `(n-of ~x 9))

(defmacro ten-of
  "A macro to help us simulate the `ten-of` checker."
  [x]
  `(n-of ~x 10))

(defmacro has
  "A macro to help us simulate the `has` checker."
  [x y]
  `(fudje.checkers/->HasChecker ~x ~y))

(defmacro roughly
  "A macro to help us simulate the `roughly` checker."
  [x & y]
  (do
    (assert (number? x) "First argument to `roughly` MUST be a number!")
    `(fudje.checkers/->RoughlyChecker ~x ~(first y))))

(defmacro every-checker
  "A macro to help us simulate the `every-checker` checker."
  [& checkers]
  `(let [cs# ~(vec checkers)]
     (assert (every? fudje.util/poly-checker? cs#) "`every-checker` expects checkers!")
     (fudje.checkers/->EveryChecker cs#)))

(defmacro split-in-provided-without-metaconstants
  "Given a some typical Midje code where some `provided` clauses (mocks) follow the actual test assertions,
  separate the assertions from the mocks. Also replaces all meta-constants with keywords.
  Returns a vector of [<forms-before-provided (assertions)> <forms-after-provided (mocks)>]."
  [forms]
  `(->> ~forms
        (split-with #(if (list? %)
                      (not= :provided (keyword (symbol (first %))))
                      true))
        (map (partial clojure.walk/postwalk (fn [form#]
                                              (let [[mc?# to-replace#] (fudje.util/metaconstant? form#)]
                                                (if mc?#
                                                  (fudje.util/metaconstant->kw form# to-replace#)
                                                  (if (fudje.util/throwable? to-replace#) ;;we do not support replacing funciton-metaconstants, check for the Exception object here
                                                    (throw to-replace#)
                                                    form#))))))))

(defn- expand-tests
  "Map midje symbols `=>` & `=throws=>` to `is` & `(is (thrown? ...` respectively."
  [tests]
  (for [[t symb res] tests]
    (condp = symb
      '=> `(let [expected# ~res] ;; this is the common case
             (if (fudje.util/poly-checker? expected#)
               (clojure.test/is (~'compatible expected# ~t))
               (clojure.test/is (= ~res ~t))))
      '=throws=> (let [[xxx msg] res     ;; <xxx> will either be a Class or an Exception object
                       xxx-klass (cond-> xxx
                                         (fudje.util/throwable? xxx) class)]
                   (if (nil? msg)
                     `(clojure.test/is (~'thrown? ~xxx-klass ~t))
                     `(clojure.test/is (~'thrown-with-msg? ~xxx-klass ~(cond-> msg
                                                                               (string? msg) re-pattern) ~t))))
      (throw (IllegalArgumentException. ^String (format "arrow %s not recognised!" (str symb)))))))

(defmacro fact
  "An (almost) drop-in replacement for `midje.sweet/fact` which rewrites the code to not use Midje.
  Rudimentary support for converting top-level midje checkers exists (`contains` & `just`).
  ATTENTION: `let` bindings right after a `midje.sweet.fact` should be manually pulled one level up, before switching to `novate.sweet.fact`."
  [description & forms]
  (assert (string? description) "`novate.sweet/fact` requires a String description as the first arg (per `clojure.test/testing`)...")
  (let [[pre-provided post-provided] (fudje.sweet/split-in-provided-without-metaconstants forms)
        tests (->> pre-provided
                   (partition 3)
                   (map (fn [[t _ r :as x]]
                          (if (and (list? r)
                                   (= 'throws (symbol (first r))))
                            [t '=throws=> (rest r)]   ;; this requires special treatment (see `expand-tests`)
                            x)))
                   )
        mocks (-> post-provided first rest)]
    `(clojure.test/testing ~description
       (fudje.core/mocking ~mocks
         ~@(fudje.sweet/expand-tests tests)))
    ))

(defmacro are* ;;
  "Slightly patched version of `clojure.test/are` that assumes that <expr> is a `fact` or `mocking`.
   Only difference is that <expr> is NOT evaluated within the context of a `clojure.test/is` as the `fact` takes care of that.
   Not really intended for public use but it has to stay a public Var."
  {:added "1.1"}
  [argv expr & args]
  (if (or
        (and (empty? argv) (empty? args))
        (and (pos? (count argv))
             (pos? (count args))
             (zero? (mod (count args) (count argv)))))
    `(clojure.template/do-template ~argv ~expr ~@args)
    (throw (IllegalArgumentException. "The number of args doesn't match are's argv."))))

(defmacro tabular [fact-expr & body]
  (with-local-vars [arga #{}]
    (clojure.walk/prewalk (fn [x]
                            (if (fudje.util/qmark? x)
                              (do (var-set arga (conj @arga x)) x)
                              x))
                          fact-expr)
    (let [[args assertions] (split-at (count @arga) body)]
      `(fudje.sweet/are* ~(vec args) ~fact-expr ~@assertions))
    )
  )

drop `volatile!` in favor of `with-local-vars`


(ns app.ctl
  (:require [cljs.core.async :refer [put! chan <! mult tap]]
            [dragonmark.web.core :as dw :refer [xf xform to-hiccup to-doc-frag]]
            [cljs.reader]
            [markdown.core :refer [md->html]]
            [cljsjs.mousetrap]
            [reagent.core :as reagent :refer [atom]]
            [re-frame.core :refer [dispatch-sync
                                   subscribe
                                   ]])
  (:require-macros [app.templates :refer [deftmpl]]
                   [reagent.ratom :refer [reaction]]
                   [cljs.core.async.macros :refer [go]]))

(defn reload-hook []
  (println "RELOAD CTL"))

(deftmpl ctl-tpl "controls.html")

(deftmpl help-tpl "help.html")

(deftmpl dataview-tpl "dataview.html")

(defn title-input [{:keys [title on-save on-stop]}]
  (let [val (atom title)
        stop #(do (on-stop)
                  (reset! val ""))
        save #(let [v (clojure.string/trim @val)]
                (on-save v)
                (stop))]
    (fn []
      [:input {:value @val
               :on-blur save
               :on-change #(reset! val (-> % .-target .-value))
               :on-key-down #(case (.-which %)
                               13 (save)
                               27 (stop)
                               nil)}])))

(def title-edit (with-meta title-input
                 {:component-did-mount #(.focus (reagent/dom-node %))}))

(defn display? [visible?]
  (if @visible?
    "display: block;"
    "display: none;"))

(defn visibility-class [visible?]
  (if visible?
    ""
    "hidden"))

(defn data-item [item channel]
  (let [editing (atom true)
        channels (subscribe [:channels])]
    (fn []
      @channels
      [:div
       (if @editing
         [title-edit {:title item
                      :on-save #(dispatch-sync [:channel-update-item @channel item %])
                      :on-stop #(reset! editing false)}]
         [:span {:on-click #(reset! editing (not @editing))} item])
       [:button {:on-click #(dispatch-sync [:delete item @channel])} "D"]])))

(defn data-items [items channel]
  (let [items (reaction (:items @channel))] ;;items update but not on the screen for some reason
    (fn []
      [:ul
       (for [item @items]
         [data-item item channel])])))

(defn channel-title [{:keys [title i channels]}]
  (let [editing (atom false)]
    (fn []
      [:a {:data-idx i
           :on-click #(dispatch-sync [:set-active-channel i])
           :on-double-click #(reset! editing (not @editing))}
       (if @editing
         [title-edit {:title (:title (@channels i))
                       :on-save #(dispatch-sync [:channel-set-title i %])
                       :on-stop #(reset! editing false)}]
         [:span {:class (str "view" @editing)} (:title (@channels i))])])))

(defn data-tab-item [channels active-idx]
  (let [data @channels]
    (for [i (range (count data))]
      [:div {:class (str "muted-" (:muted? (data i)) (when (= active-idx i) " active"))}
       [channel-title {:title (:title (@channels i))
                       :i i
                       :channels channels}]
       [:span {:class (str "glyphicon " (if (:muted? (data i)) "glyphicon-volume-off" "glyphicon-volume-up"))
               :aria-hidden "true"
               :on-click #(dispatch-sync [:mute (data i)])} ]])))

(defn allow-drop [e]
  (.preventDefault e))

(defn dataview [active-channel channels active-list-idx import-visible?]
  "Editing channels and data"
  (xform dataview-tpl
         [".datalist" {:on-drag-over allow-drop
                       :on-drag-enter allow-drop
                       :on-drop (fn [e] (.preventDefault e)
                                  (let [tree (.getData (.-dataTransfer e) "text")]
                                    (dispatch-sync [:import tree @active-channel])))}]
         [".datalist" [data-items (:items @active-channel) active-channel] ]
         [".nav-tabs li" :* (data-tab-item channels @active-list-idx) ]
         [".nav-tabs a"
          ]
         ["#channel-controls .channel-mix"
          {:value (:gain (@channels @active-list-idx))
           :on-change #(dispatch-sync
                        [:channel-set-mix
                         (@channels @active-list-idx)
                         (cljs.reader/read-string (.. % -target -value))])}]
         ["#clear-screen" {:on-click #(dispatch-sync [:clear @active-channel])}]
         ["#clear-all" {:on-click #(dispatch-sync [:clear-all])}]
         ["#toggle-import-dlg" {:on-click #(dispatch-sync [:toggle-import-visibility])}]

         ["#import-dlg" {:class (visibility-class @import-visible?)}]
         ["#textareaimport-button"
          {:on-click
           (fn []
             (dispatch-sync [:import
                             (.-value (.getElementById js/document "textareaimport"))
                             @active-channel])
             (aset (.getElementById js/document "textareaimport") "value" "")
             (dispatch-sync [:start]))}]
         ["#export-all" {:on-click (fn []
                                     (dispatch-sync [:export-all]))}]
         ["#textarea-export" {:on-click (fn [e]
                                          (.focus (.-target e))
                                          (.select (.-target e)))}]))

(defn control-panel [playstates]
  (let [player (subscribe [:player])
        controls (subscribe [:controls])
        active-list-idx (reaction (:active-list-idx @controls))
        dataview-visible? (reaction (:dataview-visible? @controls))
        help-visible? (reaction (:help-visible? @controls))
        import-visible? (reaction (:import-visible? @controls))
        channels (subscribe [:channels])
        active-channel (reaction (@channels @active-list-idx))]
    (fn []
      (xform ctl-tpl

             ["#control-panel" {:class (clojure.string/lower-case (playstates (:playstate @player)))}]
             ["#playbutton" {:on-click #(dispatch-sync [:toggle-play])} ]
             ["#dataview" {:style (display? dataview-visible?)}]
             ["#dataview" :*> (dataview active-channel channels active-list-idx import-visible?)]

             ["#ejectbutton" {:on-click #(dispatch-sync [:toggle-dataview-visibility])} ]
             ["#play-state" (playstates (:playstate player))]

             ;; how to refer to the attrs of elements here?
             ["#playmode input.drizzle" (if (= (:playmode @player) "drizzle") {:checked "true"} {})]
             ["#playmode input.pairs" (if (= (:playmode @player) "pairs") {:checked "true"} {})]
             ["#playmode input.single" (if (= (:playmode @player) "single") {:checked "true"} {})]

             ["#playmode input"
              {:on-change (fn [e]
                            (dispatch-sync [:set-playmode
                                            (.-value (.-target e))])
                            (dispatch-sync [:start]))}]

             ["#ipm" {:value (Math/floor (* 60  (:items-per-sec @player)))
                      :on-change (fn [evt]
                                   (dispatch-sync [:set-ipm
                                                   (cljs.reader/read-string (.. evt -target -value ))])
                                   (dispatch-sync [:start]))}]
             ["#doRandomize" (if (:randomize? @player) {:checked "true"} {})]
                                        ;           ["#doRandomize" {:on-click #(println (.. % -target -checked))}]
             ["#doRandomize" {:on-click #(dispatch-sync [:set-randomize (.. % -target -checked)])}]
             [".help" {:on-click #(dispatch-sync [:toggle-help])}]
             ["#help" {:style (display? help-visible?)} ]
             ["#help" :*> (xform ( str "<div>" (md->html help-tpl) "</div>"))]))))

(.click (js/jQuery "#screen")
        (fn [evt]
          (.toggle (js/jQuery "nav"))))

(.click (js/jQuery "#controls-overlay")
        (fn [evt]
          (.toggle (js/jQuery "nav"))))

(.bind js/Mousetrap "space" #(dispatch-sync [:toggle-play]))
(.bind js/Mousetrap "i" #(dispatch-sync [:insert-mode-enable]))
(.bind js/Mousetrap "esc" #(dispatch-sync [:insert-mode-disable]))

(ns app.ctl
  (:require [cljs.core.async :refer [put! chan <! mult tap]]
            [dragonmark.web.core :as dw :refer [xf xform to-hiccup to-doc-frag]]
            [cljs.reader]
            [markdown.core :refer [md->html]]
            [cljsjs.mousetrap]
            [reagent.core :as reagent :refer [atom]]
            [re-frame.core :refer [dispatch-sync
                                   subscribe
                                   ]])
  (:require-macros [app.templates :refer [deftmpl]]
                   [reagent.ratom :refer [reaction]]
                   [cljs.core.async.macros :refer [go]]))

(defn reload-hook []
  (println "RELOAD CTL"))

(deftmpl ctl-tpl "controls.html")

(deftmpl help-tpl "help.html")

(deftmpl dataview-tpl "dataview.html")

(defn title-input [{:keys [title on-save on-stop]}]
  (let [val (atom title)
        stop #(do (on-stop)
                  (reset! val ""))
        save #(let [v (clojure.string/trim @val)]
                (on-save v)
                (stop))]
    (fn []
      [:input {:value @val
               :on-blur save
               :on-change #(reset! val (-> % .-target .-value))
               :on-key-down #(case (.-which %)
                               13 (save)
                               27 (stop)
                               nil)}])))

(def title-edit (with-meta title-input
                  {:component-did-mount #(do (.focus (reagent/dom-node %))
                                             (.select (reagent/dom-node %)))}))

(defn display? [visible?]
  (if @visible?
    "display: block;"
    "display: none;"))

(defn visibility-class [visible?]
  (if visible?
    ""
    "hidden"))

(defn data-item [item channel]
  (let [editing (atom true)
        channels (subscribe [:channels])]
    (fn []
      @channels
      [:div
       (if @editing
         [title-edit {:title item
                      :on-save #(dispatch-sync [:channel-update-item @channel item %])
                      :on-stop #(reset! editing false)}]
         [:span {:on-click #(reset! editing (not @editing))} item])
       [:button {:on-click #(dispatch-sync [:delete item @channel])} "D"]])))

(defn data-items [items channel]
  (let [items (reaction (:items @channel))] ;;items update but not on the screen for some reason
    (fn []
      [:ul
       (for [item @items]
         [data-item item channel])])))

(defn channel-title [{:keys [title i channels]}]
  (let [editing (atom false)]
    (fn []
      [:a {:data-idx i
           :on-click #(dispatch-sync [:set-active-channel i])
           :on-double-click #(reset! editing (not @editing))}
       (if @editing
         [title-edit {:title (:title (@channels i))
                       :on-save #(dispatch-sync [:channel-set-title i %])
                       :on-stop #(reset! editing false)}]
         [:span {:class (str "view" @editing)} (:title (@channels i))])])))

(defn data-tab-item [channels active-idx]
  (let [data @channels]
    (for [i (range (count data))]
      [:div {:class (str "muted-" (:muted? (data i)) (when (= active-idx i) " active"))}
       [channel-title {:title (:title (@channels i))
                       :i i
                       :channels channels}]
       [:span {:class (str "glyphicon " (if (:muted? (data i)) "glyphicon-volume-off" "glyphicon-volume-up"))
               :aria-hidden "true"
               :on-click #(dispatch-sync [:mute (data i)])} ]])))

(defn allow-drop [e]
  (.preventDefault e))

(defn dataview [active-channel channels active-list-idx import-visible?]
  "Editing channels and data"
  (xform dataview-tpl
         [".datalist" {:on-drag-over allow-drop
                       :on-drag-enter allow-drop
                       :on-drop (fn [e] (.preventDefault e)
                                  (let [tree (.getData (.-dataTransfer e) "text")]
                                    (dispatch-sync [:import tree @active-channel])))}]
         [".datalist" [data-items (:items @active-channel) active-channel] ]
         [".nav-tabs li" :* (data-tab-item channels @active-list-idx) ]
         [".nav-tabs a"
          ]
         ["#channel-controls .channel-mix"
          {:value (:gain (@channels @active-list-idx))
           :on-change #(dispatch-sync
                        [:channel-set-mix
                         (@channels @active-list-idx)
                         (cljs.reader/read-string (.. % -target -value))])}]
         ["#clear-screen" {:on-click #(dispatch-sync [:clear @active-channel])}]
         ["#clear-all" {:on-click #(dispatch-sync [:clear-all])}]
         ["#toggle-import-dlg" {:on-click #(dispatch-sync [:toggle-import-visibility])}]

         ["#import-dlg" {:class (visibility-class @import-visible?)}]
         ["#textareaimport-button"
          {:on-click
           (fn []
             (dispatch-sync [:import
                             (.-value (.getElementById js/document "textareaimport"))
                             @active-channel])
             (aset (.getElementById js/document "textareaimport") "value" "")
             (dispatch-sync [:start]))}]
         ["#export-all" {:on-click (fn []
                                     (dispatch-sync [:export-all]))}]
         ["#textarea-export" {:on-click (fn [e]
                                          (.focus (.-target e))
                                          (.select (.-target e)))}]))

(defn control-panel [playstates]
  (let [player (subscribe [:player])
        controls (subscribe [:controls])
        active-list-idx (reaction (:active-list-idx @controls))
        dataview-visible? (reaction (:dataview-visible? @controls))
        help-visible? (reaction (:help-visible? @controls))
        import-visible? (reaction (:import-visible? @controls))
        channels (subscribe [:channels])
        active-channel (reaction (@channels @active-list-idx))]
    (fn []
      (xform ctl-tpl

             ["#control-panel" {:class (clojure.string/lower-case (playstates (:playstate @player)))}]
             ["#playbutton" {:on-click #(dispatch-sync [:toggle-play])} ]
             ["#dataview" {:style (display? dataview-visible?)}]
             ["#dataview" :*> (dataview active-channel channels active-list-idx import-visible?)]

             ["#ejectbutton" {:on-click #(dispatch-sync [:toggle-dataview-visibility])} ]
             ["#play-state" (playstates (:playstate player))]

             ;; how to refer to the attrs of elements here?
             ["#playmode input.drizzle" (if (= (:playmode @player) "drizzle") {:checked "true"} {})]
             ["#playmode input.pairs" (if (= (:playmode @player) "pairs") {:checked "true"} {})]
             ["#playmode input.single" (if (= (:playmode @player) "single") {:checked "true"} {})]

             ["#playmode input"
              {:on-change (fn [e]
                            (dispatch-sync [:set-playmode
                                            (.-value (.-target e))])
                            (dispatch-sync [:start]))}]

             ["#ipm" {:value (Math/floor (* 60  (:items-per-sec @player)))
                      :on-change (fn [evt]
                                   (dispatch-sync [:set-ipm
                                                   (cljs.reader/read-string (.. evt -target -value ))])
                                   (dispatch-sync [:start]))}]
             ["#doRandomize" (if (:randomize? @player) {:checked "true"} {})]
                                        ;           ["#doRandomize" {:on-click #(println (.. % -target -checked))}]
             ["#doRandomize" {:on-click #(dispatch-sync [:set-randomize (.. % -target -checked)])}]
             [".help" {:on-click #(dispatch-sync [:toggle-help])}]
             ["#help" {:style (display? help-visible?)} ]
             ["#help" :*> (xform ( str "<div>" (md->html help-tpl) "</div>"))]))))

(.click (js/jQuery "#screen")
        (fn [evt]
          (.toggle (js/jQuery "nav"))))

(.click (js/jQuery "#controls-overlay")
        (fn [evt]
          (.toggle (js/jQuery "nav"))))

(.bind js/Mousetrap "space" #(dispatch-sync [:toggle-play]))
(.bind js/Mousetrap "i" #(dispatch-sync [:insert-mode-enable]))
(.bind js/Mousetrap "esc" #(dispatch-sync [:insert-mode-disable]))

Select input text on focus

Select input text on focus


(ns cake.project
  (:use cake classlojure
        [cake.file :only [file global-file]]
        [cake.ant :only [fileset-seq]]
        [clojure.string :only [join]]
        [cake.utils.useful :only [assoc-or update merge-in tap]])
  (:import [java.io File]))

(defn- make-url [file]
  (str "file:" (.getPath file) (if (.isDirectory file) "/" "")))

(defn classpath []
  (map make-url
       (concat (map file [(System/getProperty "bake.path")
                          "src/" "src/clj/" "classes/" "resources/" "dev/" "test/" "test/classes/"])
               (fileset-seq {:dir (file "lib")            :includes "*.jar"})
               (fileset-seq {:dir (file "lib/dev")        :includes "*.jar"})
               (fileset-seq {:dir (global-file "lib/dev") :includes "*.jar"}))))

(defn ext-classpath []
  (map make-url
       (fileset-seq {:dir "lib/ext" :includes "*.jar"})))

(defonce classloader nil)

(defn make-classloader []
  (wrap-ext-classloader (ext-classpath))
  (when-let [cl (classlojure (classpath))]
    (eval-in cl '(do (require 'cake)
                     (require 'bake.io)
                     (require 'bake.reload)
                     (require 'clojure.main)))
    cl))

(defn reload! []
  (alter-var-root #'classloader (fn [_] (make-classloader))))

(defn reload []
  (alter-var-root #'classloader
    (fn [cl]
      (if cl
        (do (eval-in cl '(bake.reload/reload)) cl)
        (make-classloader)))))

(defn- quote-if
  "We need to quote the binding keys so they are not evaluated within the bake
   syntax-quote and the binding values so they are not evaluated in the
   project/project-eval syntax-quote. This function makes that possible."
  [pred bindings]
  (reduce
   (fn [v form]
     (if (pred (count v))
       (conj v (list 'quote form))
       (conj v form)))
   [] bindings))

(defn- separate-bindings
  "Separate bindings based on whether their value is a Java core type or not, because Java types
   should be passed directly to the project classloader, while other values should be serialized."
  [bindings]
  (reduce (fn [b [sym val]]
            (if (and (class val) (.getClassLoader (class val)))
              (update b 0 conj  sym val)
              (update b 1 assoc sym val)))
          [[] {}]
          (partition 2 bindings)))

(defn- shared-bindings []
  `[~'cake/*current-task* '~*current-task*
    ~'cake/*project-root* '~*project-root*
    ~'cake/*project*      '~*project*
    ~'cake/*context*      '~*context*
    ~'cake/*script*       '~*script*
    ~'cake/*opts*         '~*opts*
    ~'cake/*pwd*          '~*pwd*
    ~'cake/*env*          '~*env*
    ~'cake/*vars*         '~*vars*])

(defn project-eval [ns-forms bindings body]
  (reload)
  (let [[let-bindings object-bindings] (separate-bindings bindings)
        temp-ns (gensym "bake")
        form
        `(do (ns ~temp-ns
               (:use ~'cake)
               ~@ns-forms)
             (fn [ins# outs# ~@(keys object-bindings)]
               (try
                 (clojure.main/with-bindings
                   (bake.io/with-streams ins# outs#
                     (binding ~(shared-bindings)
                       (let ~(quote-if odd? let-bindings)
                         ~@body))))
                 (finally
                  (remove-ns '~temp-ns)))))]
    (try (apply eval-in classloader
                `(clojure.main/with-bindings (eval '~form))
                *ins* *outs* (vals object-bindings))
         (catch Throwable e
           (println "error evaluating:")
           (prn body)
           (throw e)))))

(defmacro bake
  "Execute code in a your project classloader. Bindings allow passing state to the project
   classloader. Namespace forms like use and require must be specified before bindings."
  {:arglists '([ns-forms* bindings body*])}
  [& forms]
  (let [[ns-forms [bindings & body]] (split-with (complement vector?) forms)]
    `(project-eval '~ns-forms ~(quote-if even? bindings) '~body)))

(defn group [project]
  (if (or (= project 'clojure) (= project 'clojure-contrib))
    "org.clojure"
    (or (namespace project) (name project))))

(defn dep-map [deps]
  (into {}
    (for [[dep version & opts] deps]
      [dep (apply hash-map :version version opts)])))

(defn create [project-name version opts]
  (let [artifact (name project-name)
        artifact-version (str artifact "-" version)]
    (-> opts
        (assoc :artifact-id  artifact
               :group-id     (group project-name)
               :aot          (or (:aot opts) (:namespaces opts))
               :version      version
               :context      (symbol (or (:context opts) "dev"))
               :jar-name     (or (:jar-name opts) artifact-version)
               :war-name     (or (:war-name opts) artifact-version)
               :uberjar-name (or (:uberjar-name opts) (str artifact-version "-standalone")))
        (assoc-or :dependencies (:deps opts))
        (assoc-or :dev-dependencies (:dev-deps opts))
        (update :dependencies     dep-map)
        (update :ext-dependencies dep-map)
        (update :dev-dependencies dep-map)
        (assoc-or :name artifact))))

(ns cake.project
  (:use cake classlojure
        [cake.file :only [file global-file]]
        [cake.ant :only [fileset-seq]]
        [clojure.string :only [join]]
        [cake.utils.useful :only [assoc-or update merge-in tap]])
  (:import [java.io File]))

(defn- make-url [file]
  (str "file:" (.getPath file) (if (.isDirectory file) "/" "")))

(defn classpath []
  (map make-url
       (concat (map file [(System/getProperty "bake.path")
                          "src/" "src/clj/" "classes/" "resources/" "dev/" "test/" "test/classes/"])
               (fileset-seq {:dir (file "lib")            :includes "*.jar"})
               (fileset-seq {:dir (file "lib/dev")        :includes "*.jar"})
               (fileset-seq {:dir (global-file "lib/dev") :includes "*.jar"}))))

(defn ext-classpath []
  (map make-url
       (fileset-seq {:dir "lib/ext" :includes "*.jar"})))

(defonce classloader nil)

(defn make-classloader []
  (wrap-ext-classloader (ext-classpath))
  (when-let [cl (classlojure (classpath))]
    (eval-in cl '(do (require 'cake)
                     (require 'bake.io)
                     (require 'bake.reload)
                     (require 'clojure.main)))
    cl))

(defn reload! []
  (alter-var-root #'classloader (fn [_] (make-classloader))))

(defn reload []
  (alter-var-root #'classloader
    (fn [cl]
      (if cl
        (do (eval-in cl '(bake.reload/reload)) cl)
        (make-classloader)))))

(defn- quote-if
  "We need to quote the binding keys so they are not evaluated within the bake
   syntax-quote and the binding values so they are not evaluated in the
   project/project-eval syntax-quote. This function makes that possible."
  [pred bindings]
  (reduce
   (fn [v form]
     (if (pred (count v))
       (conj v (list 'quote form))
       (conj v form)))
   [] bindings))

(defn- separate-bindings
  "Separate bindings based on whether their value is a Java core type or not, because Java types
   should be passed directly to the project classloader, while other values should be serialized."
  [bindings]
  (reduce (fn [b [sym val]]
            (if (and (class val) (.getClassLoader (class val)))
              (update b 0 conj  sym val)
              (update b 1 assoc sym val)))
          [[] {}]
          (partition 2 bindings)))

(defn- shared-bindings []
  `[~'cake/*current-task* '~*current-task*
    ~'cake/*project-root* '~*project-root*
    ~'cake/*project*      '~*project*
    ~'cake/*context*      '~*context*
    ~'cake/*script*       '~*script*
    ~'cake/*opts*         '~*opts*
    ~'cake/*pwd*          '~*pwd*
    ~'cake/*env*          '~*env*
    ~'cake/*vars*         '~*vars*])

(defn project-eval [ns-forms bindings body]
  (reload)
  (let [[let-bindings object-bindings] (separate-bindings bindings)
        temp-ns (gensym "bake")
        form
        `(do (ns ~temp-ns
               (:use ~'cake)
               ~@ns-forms)
             (fn [ins# outs# ~@(keys object-bindings)]
               (try
                 (clojure.main/with-bindings
                   (bake.io/with-streams ins# outs#
                     (binding ~(shared-bindings)
                       (let ~(quote-if odd? let-bindings)
                         ~@body))))
                 (finally
                  (remove-ns '~temp-ns)))))]
    (try (apply eval-in classloader
                `(clojure.main/with-bindings (eval '~form))
                *ins* *outs* (vals object-bindings))
         (catch Throwable e
           (println "error evaluating:")
           (prn body)
           (throw e)))))

(defmacro bake
  "Execute code in a your project classloader. Bindings allow passing state to the project
   classloader. Namespace forms like use and require must be specified before bindings."
  {:arglists '([ns-forms* bindings body*])}
  [& forms]
  (let [[ns-forms [bindings & body]] (split-with (complement vector?) forms)]
    `(project-eval '~ns-forms ~(quote-if even? bindings) '~body)))

(defn group [project]
  (if (or (= project 'clojure) (= project 'clojure-contrib))
    "org.clojure"
    (or (namespace project) (name project))))

(defn dep-map [deps]
  (into {}
    (for [[dep version & opts] deps]
      [dep (apply hash-map :version version opts)])))

(defn create [project-name version opts]
  (let [artifact (name project-name)
        artifact-version (str artifact "-" version)]
    (-> opts
        (assoc :artifact-id  artifact
               :group-id     (group project-name)
               :aot          (or (:aot opts) (:namespaces opts))
               :version      version
               :context      (symbol (or (:context opts) "dev"))
               :jar-name     (or (:jar-name opts) artifact-version)
               :war-name     (or (:war-name opts) artifact-version)
               :uberjar-name (or (:uberjar-name opts) (str artifact-version "-standalone")))
        (assoc-or :dependencies (:deps opts))
        (assoc-or :ext-depencencies (:dev-deps opts))
        (assoc-or :dev-dependencies (:dev-deps opts))
        (update :dependencies     dep-map)
        (update :ext-dependencies dep-map)
        (update :dev-dependencies dep-map)
        (assoc-or :name artifact))))

Add a shortened version of ext-dependencies.


^:clj (ns c2.svg
        (:use [c2.maths :only [Pi Tau radians-per-degree
                               sin cos]]
              [clojure.core.match :only [match]]))

^:cljs (ns c2.svg
         (:use-macros [clojure.core.match.js :only [match]])
         (:use [c2.maths :only [Pi Tau radians-per-degree
                                sin cos]]))

;;Lil' SVG helpers
(defn translate [coordinates]
  (match [coordinates]
         [[x y]] (str "translate(" x "," y ")")
         [{:x x :y y}] (recur [x y])))

(defn scale [coordinates]
  (match [coordinates]
         [[x y]] (str "scale(" x "," y ")")
         [{:x x :y y}] (recur [x y])))

(defn axis
  "Returns axis <g> for input scale with ticks.
Direction away from the data frame is defined to be positive; use negative margins and widths for the axis to render inside of the data frame"
  [scale ticks & {:keys [orientation
                         formatter
                         major-tick-width
                         text-margin]
                  :or {orientation :left
                       formatter str
                       major-tick-width 6
                       text-margin 9}}]

  (let [[x y x1 x2 y1 y2] (case orientation
                            (:left :right) [:x :y :x1 :x2 :y1 :y2]
                            (:top :bottom) [:y :x :y1 :y2 :x1 :x2])

        parity (case orientation
                 (:left :top) -1
                 (:right :bottom) 1)]

    [:g.axis {:class (name orientation)}
     [:line.rule (apply hash-map (interleave [y1 y2] (:range scale)))]

     (map (fn [d]
            [:g.major-tick {:transform (translate {x 0 y (scale d)})}
             [:text {x (* parity text-margin)} (formatter d)]
             [:line {x1 0 x2 (* parity major-tick-width)}]])
          ticks)]))

(def ArcMax (- Tau 0.0000001))

(defn circle
  "Returns svg path data for a circle starting at 3 o'clock and sweeping in positive y."
  ([radius] (circle [0 0] radius))
  ([[x y] radius]
     (str "M"  (+ x radius) "," y
          "A" (+ x radius) "," (+ y radius) " 0 1,1" (- (+ x radius)) "," y
          "A" (+ x radius) "," (+ y radius) " 0 1,1" (+ x radius) "," y)))

(defn arc
  [& {:keys [inner-radius, outer-radius
             start-angle, end-angle, angle-offset]
      :or {inner-radius 0, outer-radius 1
           start-angle 0, end-angle Pi, angle-offset 0}}]
  (let [r0 inner-radius
        r1 outer-radius
        [a0 a1]  (sort [(+ angle-offset start-angle)
                        (+ angle-offset end-angle)])
        da (- a1 a0)
        large-arc-flag (if (< da Pi) "0" "1")

        s0 (sin a0), c0 (cos a0)
        s1 (sin a1), c1 (cos a1)]

    ;;SVG "A" parameters: (rx ry x-axis-rotation large-arc-flag sweep-flag x y)
    ;;see http://www.w3.org/TR/SVG/paths.html#PathData
    (if (>= da ArcMax)
      ;;Then just draw a full annulus
      (str "M0," r1
           "A" r1 "," r1 " 0 1,1 0," (- r1)
           "A" r1 "," r1 " 0 1,1 0," r1
           (if (not= 0 r0) ;;draw inner arc
             (str "M0," r0
                  "A" r0 "," r0 " 0 1,0 0," (- r0)
                  "A" r0 "," r0 " 0 1,0 0," r0))
           "Z")

      ;;Otherwise, draw the wedge
      (str "M" (* r1 c0) "," (* r1 s0)
           "A" r1 "," r1 " 0 " large-arc-flag ",1 " (* r1 c1) "," (* r1 s1)
           (if (not= 0 r0) ;;draw inner arc
             (str "L" (* r0 c1) "," (* r0 s1)
                  "A" r0 "," r0 " 0 " large-arc-flag ",0 " (* r0 c0) "," (* r0 s0))
             "L0,0")
           "Z"))))

^:clj (ns c2.svg
        (:use [c2.maths :only [Pi Tau radians-per-degree
                               sin cos]]
              [clojure.core.match :only [match]]))

^:cljs (ns c2.svg
         (:use-macros [clojure.core.match.js :only [match]])
         (:use [c2.maths :only [Pi Tau radians-per-degree
                                sin cos]]))

;;Lil' SVG helpers
(defn translate [coordinates]
  (match [coordinates]
         [[x y]] (str "translate(" x "," y ")")
         [{:x x :y y}] (recur [x y])))

(defn scale [coordinates]
  (match [coordinates]
         [[x y]] (str "scale(" x "," y ")")
         [{:x x :y y}] (recur [x y])))

(defn axis
  "Returns axis <g> for input scale with ticks.
Direction away from the data frame is defined to be positive; use negative margins and widths for the axis to render inside of the data frame"
  [scale ticks & {:keys [orientation
                         formatter
                         major-tick-width
                         text-margin]
                  :or {orientation :left
                       formatter str
                       major-tick-width 6
                       text-margin 9}}]

  (let [[x y x1 x2 y1 y2] (match [orientation]
                                 [(:or :left :right)] [:x :y :x1 :x2 :y1 :y2]
                                 [(:or :top :bottom)] [:y :x :y1 :y2 :x1 :x2])

        parity (match [orientation]
                      [(:or :left :top)] -1
                      [(:or :right :bottom)] 1)]

    (into [:g.axis {:class (name orientation)}
           [:line.rule (apply hash-map (interleave [y1 y2] (:range scale)))]]
           (map (fn [d]
            [:g.major-tick {:transform (translate {x 0 y (scale d)})}
             [:text {x (* parity text-margin)} (formatter d)]
             [:line {x1 0 x2 (* parity major-tick-width)}]])
          ticks))))

(def ArcMax (- Tau 0.0000001))

(defn circle
  "Returns svg path data for a circle starting at 3 o'clock and sweeping in positive y."
  ([radius] (circle [0 0] radius))
  ([[x y] radius]
     (str "M"  (+ x radius) "," y
          "A" (+ x radius) "," (+ y radius) " 0 1,1" (- (+ x radius)) "," y
          "A" (+ x radius) "," (+ y radius) " 0 1,1" (+ x radius) "," y)))

(defn arc
  [& {:keys [inner-radius, outer-radius
             start-angle, end-angle, angle-offset]
      :or {inner-radius 0, outer-radius 1
           start-angle 0, end-angle Pi, angle-offset 0}}]
  (let [r0 inner-radius
        r1 outer-radius
        [a0 a1]  (sort [(+ angle-offset start-angle)
                        (+ angle-offset end-angle)])
        da (- a1 a0)
        large-arc-flag (if (< da Pi) "0" "1")

        s0 (sin a0), c0 (cos a0)
        s1 (sin a1), c1 (cos a1)]

    ;;SVG "A" parameters: (rx ry x-axis-rotation large-arc-flag sweep-flag x y)
    ;;see http://www.w3.org/TR/SVG/paths.html#PathData
    (if (>= da ArcMax)
      ;;Then just draw a full annulus
      (str "M0," r1
           "A" r1 "," r1 " 0 1,1 0," (- r1)
           "A" r1 "," r1 " 0 1,1 0," r1
           (if (not= 0 r0) ;;draw inner arc
             (str "M0," r0
                  "A" r0 "," r0 " 0 1,0 0," (- r0)
                  "A" r0 "," r0 " 0 1,0 0," r0))
           "Z")

      ;;Otherwise, draw the wedge
      (str "M" (* r1 c0) "," (* r1 s0)
           "A" r1 "," r1 " 0 " large-arc-flag ",1 " (* r1 c1) "," (* r1 s1)
           (if (not= 0 r0) ;;draw inner arc
             (str "L" (* r0 c1) "," (* r0 s1)
                  "A" r0 "," r0 " 0 " large-arc-flag ",0 " (* r0 c0) "," (* r0 s0))
             "L0,0")
           "Z"))))

Use `into` so axis helper will work until #12 is addressed.


(ns sicp.chapter3.5-2)

;;;; 3.5  Streams

;;; 3.5.2  Infinite Streams

;; Exercise 3.53
(def s (lazy-seq (cons 1 (map + s s))))

;; Exercise 3.54
(defn mul-streams [s1 s2]
  (map * s1 s2))

(def integers (rest (range)))

(def factorials
  (lazy-seq (cons 1 (mul-streams (rest integers) factorials))))

(ns sicp.chapter3.5-2)

;;;; 3.5  Streams

;;; 3.5.2  Infinite Streams

;; Exercise 3.53
(defn add-streams [s1 s2]
  (map + s1 s2))

(def s (lazy-seq (cons 1 (add-streams s s))))

#_(take 10 s)

;; Exercise 3.54
(defn mul-streams [s1 s2]
  (map * s1 s2))

(def integers (rest (range)))

(def factorials
  (lazy-seq (cons 1 (mul-streams (rest integers) factorials))))

#_(take 10 factorials)

Improve Exercise 3.53 implementation

Improve Exercise 3.53 implementation


(ns emulator-4917.core
  (:require #?(:cljs [cljs.nodejs :as nodejs])
            #?(:cljs [goog.crypt :as gcrypt])
            [clojure.string :as str]))

;; enable *print-fn* in clojurescript
#?(:cljs (enable-console-print!))

(defn to-4bit-array
  "Convert 0xf4 to [f 4]"
  [s]
  (let [h (bit-shift-right s 4) ;; 0xf4 >> 4   => f
        l (bit-and s 0x0f)]     ;; 0xf4 & 0x0f => 4
    [h l]))

(defn parse-rom
  "Parse binary file and convert contents to vector."
  [file]
  (flatten
   (map to-4bit-array
        #?(:clj
           (.getBytes (slurp file) "ascii")
           :cljs
           (->  (nodejs/require "fs")
                (.readFileSync file "ascii")
                .toString
                gcrypt/stringToUtf8ByteArray)
           ))))

(defn -main [& args]
  (let [arg1 (nth args 0)]
    (if arg1
      (println (parse-rom arg1))
      (println "Error: Please specify filename."))))

;; setup node.js starter point
#?(:cljs (set! *main-cli-fn* -main))

(ns emulator-4917.core
  (:require #?(:cljs [cljs.nodejs :as nodejs])
            #?(:cljs [goog.crypt :as gcrypt])
            [clojure.string :as str]))

;; enable *print-fn* in clojurescript
#?(:cljs (enable-console-print!))

(defn to-4bit-array
  "Convert 0xf4 to [f 4]"
  [s]
  (let [h (bit-shift-right s 4) ;; 0xf4 >> 4   => f
        l (bit-and s 0x0f)]     ;; 0xf4 & 0x0f => 4
    [h l]))

(defn parse-rom
  "Parse binary file and convert contents to vector."
  [file]
  (flatten
   (map to-4bit-array
        #?(:clj
           (.getBytes (slurp file) "ascii")
           :cljs
           (->  (nodejs/require "fs")
                (.readFileSync file "ascii")
                .toString
                gcrypt/stringToByteArray)
           ))))

(defn -main [& args]
  (let [arg1 (nth args 0)]
    (if arg1
      (println (parse-rom arg1))
      (println "Error: Please specify filename."))))

;; setup node.js starter point
#?(:cljs (set! *main-cli-fn* -main))

cljs: use stringToByteArray instead of stringToUtf8ByteArray

Our array only conatains ascii code.

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>


(ns exploud.util
  "## Some helper functions"
  (:require [clj-time.core :as time])
  (:import java.util.UUID))

(defn string->int
  "Attempts to turn a string into an integer, or nil if not an integer."
  [s]
  (when s
    (try
      (Integer/parseInt (str s))
      (catch Exception e
        nil))))

(defn ami-details
  "Extracts details from the name of an AMI in the form ent-{app}-{version}-{iteration}-{year}-{month}-{day}_{hour}-{minute}-{second}"
  [name]
  (let [matches (re-find #"^ent-([^-]+)-([\.0-9]+)-([0-9]+)-([0-9]{4})-([0-9]{2})-([0-9]{2})_([0-9]{2})-([0-9]{2})-([0-9]{2})$" name)]
    {:name (nth matches 1)
     :version (nth matches 2)
     :iteration (nth matches 3)
     :bake-date (time/date-time (string->int (nth matches 4)) (string->int (nth matches 5)) (string->int (nth matches 6)) (string->int (nth matches 7)) (string->int (nth matches 8)) (string->int (nth matches 9)))}))

(defn generate-id
  "Create a random ID for a deployment or task."
  []
  (str (UUID/randomUUID)))

(defn list-from
  "If `thing` is a collection we'll get it back, otherwise we make a list with
   `thing` as the only item. I'm __almost certain__ there must be a function in
   `clojure.core` for this, but I still can't find it. If you know what it is I
   want, __PLEASE__ let Neil know!"
  [thing]
  (cond
   (coll? thing)
   thing
   (nil? thing)
   []
   :else
   [thing]))

(defn strip-first-forward-slash
  "Turns `/this/that` into `this/that`."
  [thing]
  (second (re-find #"^/*(.+)" thing)))

(defn append-to-task-log
  "Appends the given message to the task's `:log`, creating a new one if it
   doesn't exist."
  [message task]
  (let [updated-log (conj (or (:log task) [])
                          {:message message
                           :date (time/now)})]
    (assoc task :log updated-log)))

(ns exploud.util
  "## Some helper functions"
  (:require [clj-time.core :as time])
  (:import java.util.UUID))

(defn string->int
  "Attempts to turn a string into an integer, or nil if not an integer."
  [s]
  (when s
    (try
      (Integer/parseInt (str s))
      (catch Exception e
        nil))))

(defn ami-details
  "Extracts details from the name of an AMI in the form ent-{app}-{version}-{iteration}-{year}-{month}-{day}_{hour}-{minute}-{second}"
  [name]
  (let [matches (re-find #"^ent-([^-]+)-([\.0-9]+)-([0-9]+)-([0-9]{4})-([0-9]{2})-([0-9]{2})_([0-9]{2})-([0-9]{2})-([0-9]{2})$" name)]
    {:name (nth matches 1)
     :version (nth matches 2)
     :iteration (nth matches 3)
     :bake-date (time/date-time (string->int (nth matches 4)) (string->int (nth matches 5)) (string->int (nth matches 6)) (string->int (nth matches 7)) (string->int (nth matches 8)) (string->int (nth matches 9)))}))

(defn generate-id
  "Create a random ID for a deployment or task."
  []
  (str (UUID/randomUUID)))

(defn list-from
  "If `thing` is a collection we'll get it back, otherwise we make a list with
   `thing` as the only item. I'm __almost certain__ there must be a function in
   `clojure.core` for this, but I still can't find it. If you know what it is I
   want, __PLEASE__ let Neil know!"
  [thing]
  (cond
   (coll? thing)
   thing
   (nil? thing)
   []
   :else
   [thing]))

(defn strip-first-forward-slash
  "Turns `/this/that` into `this/that`."
  [thing]
  (second (re-find #"^/*(.+)" thing)))

(defn append-to-task-log
  "Appends the given message to the task's `:log`, creating a new one if it
   doesn't exist."
  [message task]
  (let [updated-log (conj (vec (:log task))
                          {:message message :date (time/now)})]
    (assoc task :log updated-log)))

Make sure we always conj to the end

Make sure we always conj to the end


(ns hatnik.web.client.components
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [hatnik.web.client.app-state :as state]
            [hatnik.web.client.form.add-action :as add-action]
            [hatnik.web.client.z-actions :as action])
  (:use [jayq.core :only [$]]))

(defn ^:export add-new-project []
  (let [project-name-input (.getElementById js/document "project-name-input")]
    (set! (.-value project-name-input) "")
    (.modal ($ :#iModalProject))))

(defn render-action-type [a-type]
  (when (= "email" a-type)
    (dom/span #js {:className "glyphicon glyphicon-envelope action-type"})))

(defn render-action [project-id act]
  (dom/div
   #js {:onClick (fn []
                   (add-action/show :project-id project-id
                                    :type :update
                                    :action @act))
        :className "panel panel-default action"}
   (dom/div
    #js {:className "panel-body bg-success"}
    (render-action-type (get act "type"))
    (dom/span #js {:className "action-info"}
              (dom/div #js {:className "library-name"}
                       (get act "library"))
              (dom/div #js {:className "version"}
                       (get act "last-processed-version"))))))

(defn add-new-action [project-id]
  (dom/div #js {:className "panel panel-default panel-info action add-action"
                :onClick #(add-action/show :type :add
                                           :project-id project-id)}
           (dom/div #js {:className "panel-body bg-info"}
                    (dom/span #js {:className "glyphicon glyphicon-plus"})
                    " Add action")))

(defn actions-table [id actions]
  (let [actions (->> actions
                     (sort-by first)
                     (map second))
        rendered
        (map (fn [act]
               (dom/div #js {:className "col-sm-12 col-md-6 col-lg-4 prj-list-item"}
                        (render-action id act)))
             actions)]
    (apply dom/div #js {:className "row"}
           (concat rendered
                   [(dom/div #js {:className "col-sm-12 col-md-6 col-lg-4 prj-list-item"}
                             (add-new-action id))]))))

(defn project-menu [project]
  (let [project-name-input (.getElementById js/document "project-name-edit-input")]
    (set! (.-value project-name-input)
          (get @project "name"))
    (state/set-current-project (get @project "id"))
    (.modal ($ :#iModalProjectMenu))))

(defn project-header-menu-button [project]
  (dom/div #js {:className "dropdown"}
           (dom/button
            #js {:className "btn btn-default"
                 :type "button"
                 :onClick #(project-menu project)}
            (dom/span #js {:className "glyphicon glyphicon-pencil pull-right"}))))

(defn project-view [prj owner]
  (reify
    om/IRender
    (render [_]
      (dom/div
       #js {:className "panel panel-default panel-primary"}
       (dom/div
        #js {:className "panel-heading"}
        (dom/div
         nil
         (dom/h4
          #js {:className "panel-title"}
          (dom/div #js {:className "row"}
                   (dom/div #js {:className "col-sm-8 col-md-8 col-lg-8"}
                            (dom/a
                             #js {:data-parent "#accrodion"
                                  :data-toggle "collapse"
                                  :href (str "#" (str "__PrjList" (get prj "id")))}
                             (dom/div #js {:className "bg-primary"} (get prj "name"))))
                   (dom/div
                    #js {:className "col-sm-2 col-md-1 col-lg-1 pull-right"}
                    (project-header-menu-button prj))))))
       (dom/div #js {:className "panel-collapse collapse in"
                     :id (str "__PrjList" (get prj "id"))}
                (dom/div #js {:className "panel-body"}
                         (actions-table (get prj "id") (get prj "actions"))))))))

(defn project-list [data owner]
  (reify
    om/IRender
    (render [this]
      (let [project-data (->> (:projects data)
                              (sort-by first)
                              (map second))
            user-data (:user data)]
        (dom/div #js {:className "panel-group" :id "iProjectList"}
                 (apply dom/div nil
                        (map #(om/build project-view %) project-data)))))))

(defn app-view [data owner]
  (reify

    om/IWillMount
    (will-mount [this]
      (.send goog.net.XhrIo "/api/current-user" state/update-user-data)
      (.send goog.net.XhrIo "/api/projects" state/update-projects-list))

    om/IRender
    (render [this]
      (dom/div nil
      (dom/div
       #js {:className "row"}
       (dom/div #js {:className "col-md-2"}
                (dom/a #js {:className "btn btn-success"
                            :onClick add-new-project} "Add new project"))
       (dom/div #js {:className "col-md-10"}))

      (dom/div nil
               (dom/p nil "")
               (om/build project-list data))))))

(ns hatnik.web.client.components
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [hatnik.web.client.app-state :as state]
            [hatnik.web.client.form.add-action :as add-action]
            [hatnik.web.client.z-actions :as action])
  (:use [jayq.core :only [$]]))

(defn ^:export add-new-project []
  (let [project-name-input (.getElementById js/document "project-name-input")]
    (set! (.-value project-name-input) "")
    (.modal ($ :#iModalProject))))

(defn render-action-type [a-type]
  (when (= "email" a-type)
    (dom/span #js {:className "glyphicon glyphicon-envelope action-type"})))

(defn add-new-action-card [data owner]
  (reify
    om/IRender
    (render [this]
      (let [id (:project-id data)]
      (dom/div #js {:className "panel panel-default panel-info action add-action"
                    :onClick #(add-action/show :type :add
                                               :project-id id)}
               (dom/div #js {:className "panel-body bg-info"}
                        (dom/span #js {:className "glyphicon glyphicon-plus"})
                        " Add action"))))))

(defn email-action-card [data owner]
  (reify
    om/IRender
    (render [this]
      (let [id (:project-id data)]
      (dom/div #js {:className "panel panel-default action"
                    :onClick #(add-action/show :type :update
                                               :project-id id
                                               :action @data)}
               (dom/div
                #js {:className "panel-body bg-success"}
                (dom/span #js {:className "glyphicon glyphicon-envelope action-type"})
                (dom/span #js {:className "action-info"}
                          (dom/div #js {:className "library-name"}
                                   (get data "library"))
                          (dom/div #js {:className "version"}
                                   (get data "last-processed-version")))))))))

(defmulti render-action #(:type %))

(defmethod render-action "email" [data]
  (om/build email-action-card data))

(defmethod render-action :add [data]
  (om/build add-new-action-card data))

(defn actions-table [id actions]
  (let [actions (->> actions
                     (sort-by first)
                     (map second))
        rendered
        (map (fn [act]
               (dom/div #js {:className "col-sm-12 col-md-6 col-lg-4 prj-list-item"}
                        (render-action (assoc act :project-id id :type (get act "type")))))
             actions)]
    (apply dom/div #js {:className "row"}
           (concat rendered
                   [(dom/div #js {:className "col-sm-12 col-md-6 col-lg-4 prj-list-item"}
                             (render-action {:type :add :project-id id}))]))))

(defn project-menu [project]
  (let [project-name-input (.getElementById js/document "project-name-edit-input")]
    (set! (.-value project-name-input)
          (get @project "name"))
    (state/set-current-project (get @project "id"))
    (.modal ($ :#iModalProjectMenu))))

(defn project-header-menu-button [project]
  (dom/div #js {:className "dropdown"}
           (dom/button
            #js {:className "btn btn-default"
                 :type "button"
                 :onClick #(project-menu project)}
            (dom/span #js {:className "glyphicon glyphicon-pencil pull-right"}))))

(defn project-view [prj owner]
  (reify
    om/IRender
    (render [_]
      (dom/div
       #js {:className "panel panel-default panel-primary"}
       (dom/div
        #js {:className "panel-heading"}
        (dom/div
         nil
         (dom/h4
          #js {:className "panel-title"}
          (dom/div #js {:className "row"}
                   (dom/div #js {:className "col-sm-8 col-md-8 col-lg-8"}
                            (dom/a
                             #js {:data-parent "#accrodion"
                                  :data-toggle "collapse"
                                  :href (str "#" (str "__PrjList" (get prj "id")))}
                             (dom/div #js {:className "bg-primary"} (get prj "name"))))
                   (dom/div
                    #js {:className "col-sm-2 col-md-1 col-lg-1 pull-right"}
                    (project-header-menu-button prj))))))
       (dom/div #js {:className "panel-collapse collapse in"
                     :id (str "__PrjList" (get prj "id"))}
                (dom/div #js {:className "panel-body"}
                         (actions-table (get prj "id") (get prj "actions"))))))))

(defn project-list [data owner]
  (reify
    om/IRender
    (render [this]
      (let [project-data (->> (:projects data)
                              (sort-by first)
                              (map second))
            user-data (:user data)]
        (dom/div #js {:className "panel-group" :id "iProjectList"}
                 (apply dom/div nil
                        (map #(om/build project-view (assoc % :user user-data))
                             project-data)))))))

(defn app-view [data owner]
  (reify

    om/IWillMount
    (will-mount [this]
      (.send goog.net.XhrIo "/api/current-user" state/update-user-data)
      (.send goog.net.XhrIo "/api/projects" state/update-projects-list))

    om/IRender
    (render [this]
      (dom/div nil
      (dom/div
       #js {:className "row"}
       (dom/div #js {:className "col-md-2"}
                (dom/a #js {:className "btn btn-success"
                            :onClick add-new-project} "Add new project"))
       (dom/div #js {:className "col-md-10"}))

      (dom/div nil
               (dom/p nil "")
               (om/build project-list data))))))

Implement action cards through om components.


(ns swarmpit.component.dashboard
  (:require [material.components :as comp]
            [swarmpit.component.mixin :as mixin]
            [swarmpit.component.state :as state]
            [swarmpit.component.progress :as progress]
            [swarmpit.component.common :as common]
            [swarmpit.component.plot :as plot]
            [swarmpit.component.service.list :as services]
            [swarmpit.component.node.list :as nodes]
            [swarmpit.ajax :as ajax]
            [swarmpit.routes :as routes]
            [sablono.core :refer-macros [html]]
            [clojure.contrib.humanize :as humanize]
            [clojure.contrib.inflect :as inflect]
            [goog.string.format]
            [goog.string :as gstring]
            [rum.core :as rum]))

(def plot-node-cpu-id "nodeCpuStats")

(def plot-node-ram-id "nodeRamStats")

(def plot-service-cpu-id "serviceCpuStats")

(def plot-service-ram-id "serviceRamStats")

(defn node-cpu-plot [stats-ts]
  (plot/multi plot-node-cpu-id
              stats-ts
              :cpu
              :name
              "CPU utilization by Node"
              "[%]"
              [0 100]))

(defn node-ram-plot [stats-ts]
  (plot/multi plot-node-ram-id
              stats-ts
              :memory
              :name
              "Memory utilization by Node"
              "[%]"
              [0 100]))

(defn service-cpu-plot [tasks-ts]
  (plot/multi plot-service-cpu-id
              tasks-ts
              :cpu
              :service
              "CPU usage by Service"
              "[vCPU]"))

(defn service-ram-plot [tasks-ts]
  (plot/multi plot-service-ram-id
              tasks-ts
              :memory
              :service
              "Memory usage by Service"
              "[MiB]"))

(defn- stats-handler
  []
  (ajax/get
    (routes/path-for-backend :stats)
    {:state      [:loading? :stats]
     :on-success (fn [{:keys [response]}]
                   (state/update-value [:stats] response state/form-value-cursor))
     :on-error   (fn [_])}))

(defn- services-ts-handler
  []
  (ajax/get
    (routes/path-for-backend :services-ts)
    {:state      [:loading? :services-ts]
     :on-success (fn [{:keys [response]}]
                   (state/update-value [:services-ts] response state/form-value-cursor))
     :on-error   (fn [_])}))

(defn- nodes-ts-handler
  []
  (ajax/get
    (routes/path-for-backend :nodes-ts)
    {:state      [:loading? :nodes-ts]
     :on-success (fn [{:keys [response]}]
                   (state/update-value [:nodes-ts] response state/form-value-cursor))
     :on-error   (fn [_])}))

(defn- nodes-handler
  []
  (ajax/get
    (routes/path-for-backend :nodes)
    {:state      [:loading? :nodes]
     :on-success (fn [{:keys [response]}]
                   (nodes-ts-handler)
                   (state/update-value [:nodes] response state/form-value-cursor))}))

(defn- services-handler
  []
  (ajax/get
    (routes/path-for-backend :services)
    {:state      [:loading? :services]
     :on-success (fn [{:keys [response origin?]}]
                   (state/update-value [:services] response state/form-value-cursor))}))

(defn- me-handler
  []
  (ajax/get
    (routes/path-for-backend :me)
    {:on-success (fn [{:keys [response]}]
                   (state/update-value [:services-dashboard] (:service-dashboard response) state/form-value-cursor)
                   (state/update-value [:nodes-dashboard] (:node-dashboard response) state/form-value-cursor))}))

(defn- init-form-state
  []
  (state/set-value {:loading? {:stats       true
                               :nodes       true
                               :nodes-ts    true
                               :services    true
                               :services-ts true}} state/form-state-cursor))

(defn- init-form-value
  []
  (state/set-value {:stats              {}
                    :services           []
                    :services-dashboard []
                    :services-ts        []
                    :nodes              []
                    :nodes-dashboard    []
                    :nodes-ts           []} state/form-value-cursor))

(def mixin-init-form
  (mixin/init-form
    (fn [{{:keys [id]} :params}]
      (init-form-state)
      (init-form-value)
      (stats-handler)
      (nodes-handler)
      (services-handler)
      (services-ts-handler)
      (me-handler))))

(defn- resource-chip
  [name count]
  (comp/chip {:key       name
              :avatar    (comp/avatar {} count)
              :className "Swarmpit-dashboard-chip"
              :label     (inflect/pluralize-noun count name)}))

(rum/defc dashboard-cluster < rum/static [nodes]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "CLUSTER")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (str (count nodes) " " (inflect/pluralize-noun (count nodes) "node")))]
       [:div.Swarmpit-dashbord-section-chips
        (resource-chip "manager" (count (filter #(= "manager" (:role %)) nodes)))
        (resource-chip "worker" (count (filter #(= "worker" (:role %)) nodes)))]])))

(rum/defc dashboard-memory < rum/static [{:keys [usage used total] :as memory}]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "MEMORY")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (common/render-capacity used true))]
       [:div.Swarmpit-dashbord-section-graph
        (common/resource-pie
          {:value used
           :limit total
           :usage usage
           :type  :memory}
          (str (common/render-capacity total true) " ram")
          "graph-memory")]])))

(rum/defc dashboard-disk < rum/static [{:keys [usage used total] :as disk}]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "DISK")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (common/render-capacity used false))]
       [:div.Swarmpit-dashbord-section-graph
        (common/resource-pie
          {:value used
           :limit total
           :usage usage
           :type  :disk}
          (str (common/render-capacity total false) " size")
          "graph-disk")]])))

(rum/defc dashboard-cpu < rum/static [{:keys [usage cores] :as cpu}]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "CPU")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (common/render-cores (/ cores usage)))]
       [:div.Swarmpit-dashbord-section-graph
        (common/resource-pie
          {:value (/ cores usage)
           :limit cores
           :usage usage
           :type  :cpu}
          (str cores " vCPU")
          "graph-cpu")]])))

(defn dashboard-node-ram-callback
  [state]
  (let [ts (first (:rum/args state))]
    (node-ram-plot ts))
  state)

(rum/defc dashboard-node-ram-stats < rum/static
                                     {:did-mount  dashboard-node-ram-callback
                                      :did-update dashboard-node-ram-callback} [nodes-ts]
  (comp/card
    (if (empty? nodes-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-node-ram-id}]))))

(defn dashboard-node-cpu-callback
  [state]
  (let [ts (first (:rum/args state))]
    (node-cpu-plot ts))
  state)

(rum/defc dashboard-node-cpu-stats < rum/static
                                     {:did-mount  dashboard-node-cpu-callback
                                      :did-update dashboard-node-cpu-callback} [nodes-ts]
  (comp/card
    (if (empty? nodes-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-node-cpu-id}]))))

(defn dashboard-service-ram-callback
  [state]
  (let [ts (first (:rum/args state))]
    (service-ram-plot ts))
  state)

(rum/defc dashboard-service-ram-stats < rum/static
                                        {:did-mount  dashboard-service-ram-callback
                                         :did-update dashboard-service-ram-callback} [services-memory-ts]
  (comp/card
    (if (empty? services-memory-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-service-ram-id}]))))

(defn dashboard-service-cpu-callback
  [state]
  (let [ts (first (:rum/args state))]
    (service-cpu-plot ts))
  state)

(rum/defc dashboard-service-cpu-stats < rum/static
                                        {:did-mount  dashboard-service-cpu-callback
                                         :did-update dashboard-service-cpu-callback} [services-cpu-ts]
  (comp/card
    (if (empty? services-cpu-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-service-cpu-id}]))))

(rum/defc form-info < rum/static [{:keys [stats services services-ts services-dashboard nodes nodes-ts nodes-dashboard] :as item}]
  (let [pinned-services (filter #(contains? (set services-dashboard) (:id %)) services)
        pinned-nodes (filter #(contains? (set nodes-dashboard) (:id %)) nodes)
        running-services (->> (filter #(not= "not running" (:state %)) services)
                              (map :serviceName)
                              (set))
        services-cpu-ts (filter #(contains? running-services (:service %)) (:cpu services-ts))
        services-memory-ts (filter #(contains? running-services (:service %)) (:memory services-ts))]
    (comp/mui
      (html
        [:div.Swarmpit-form
         [:div.Swarmpit-form-context
          (comp/grid
            {:container true
             :spacing   2}
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-cluster nodes))
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-disk (:disk stats)))
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-memory (:memory stats)))
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-cpu (:cpu stats)))
            (when (not-empty pinned-services)
              (comp/grid
                {:item true
                 :xs   12
                 :sm   12
                 :lg   12
                 :xl   12}
                (services/pinned pinned-services)))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-service-ram-stats services-memory-ts))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-service-cpu-stats services-cpu-ts))
            (when (not-empty pinned-nodes)
              (comp/grid
                {:item true
                 :xs   12
                 :sm   12
                 :lg   12
                 :xl   12}
                (nodes/pinned pinned-nodes)))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-node-ram-stats nodes-ts))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-node-cpu-stats nodes-ts)))]]))))

(rum/defc form < rum/reactive
                 mixin-init-form
                 mixin/subscribe-form [{{:keys [name]} :params}]
  (let [{:keys [loading?]} (state/react state/form-state-cursor)
        item (state/react state/form-value-cursor)]
    (progress/form
      (or (:stats loading?)
          (:nodes loading?)
          (:nodes-ts loading?)
          (:services loading?)
          (:services-ts loading?))
      (form-info item))))

(ns swarmpit.component.dashboard
  (:require [material.components :as comp]
            [swarmpit.component.mixin :as mixin]
            [swarmpit.component.state :as state]
            [swarmpit.component.progress :as progress]
            [swarmpit.component.common :as common]
            [swarmpit.component.plot :as plot]
            [swarmpit.component.service.list :as services]
            [swarmpit.component.node.list :as nodes]
            [swarmpit.ajax :as ajax]
            [swarmpit.routes :as routes]
            [sablono.core :refer-macros [html]]
            [clojure.contrib.humanize :as humanize]
            [clojure.contrib.inflect :as inflect]
            [goog.string.format]
            [goog.string :as gstring]
            [rum.core :as rum]))

(def plot-node-cpu-id "nodeCpuStats")

(def plot-node-ram-id "nodeRamStats")

(def plot-service-cpu-id "serviceCpuStats")

(def plot-service-ram-id "serviceRamStats")

(defn node-cpu-plot [stats-ts]
  (plot/multi plot-node-cpu-id
              stats-ts
              :cpu
              :name
              "CPU utilization by Node"
              "[%]"
              [0 100]))

(defn node-ram-plot [stats-ts]
  (plot/multi plot-node-ram-id
              stats-ts
              :memory
              :name
              "Memory utilization by Node"
              "[%]"
              [0 100]))

(defn service-cpu-plot [tasks-ts]
  (plot/multi plot-service-cpu-id
              tasks-ts
              :cpu
              :service
              "CPU usage by Service"
              "[vCPU]"))

(defn service-ram-plot [tasks-ts]
  (plot/multi plot-service-ram-id
              tasks-ts
              :memory
              :service
              "Memory usage by Service"
              "[MiB]"))

(defn- stats-handler
  []
  (ajax/get
    (routes/path-for-backend :stats)
    {:state      [:loading? :stats]
     :on-success (fn [{:keys [response]}]
                   (state/update-value [:stats] response state/form-value-cursor))
     :on-error   (fn [_])}))

(defn- services-ts-handler
  []
  (ajax/get
    (routes/path-for-backend :services-ts)
    {:state      [:loading? :services-ts]
     :on-success (fn [{:keys [response]}]
                   (state/update-value [:services-ts] response state/form-value-cursor))
     :on-error   (fn [_])}))

(defn- nodes-ts-handler
  []
  (ajax/get
    (routes/path-for-backend :nodes-ts)
    {:state      [:loading? :nodes-ts]
     :on-success (fn [{:keys [response]}]
                   (state/update-value [:nodes-ts] response state/form-value-cursor))
     :on-error   (fn [_])}))

(defn- nodes-handler
  []
  (ajax/get
    (routes/path-for-backend :nodes)
    {:state      [:loading? :nodes]
     :on-success (fn [{:keys [response]}]
                   (nodes-ts-handler)
                   (state/update-value [:nodes] response state/form-value-cursor))}))

(defn- services-handler
  []
  (ajax/get
    (routes/path-for-backend :services)
    {:state      [:loading? :services]
     :on-success (fn [{:keys [response origin?]}]
                   (state/update-value [:services] response state/form-value-cursor))}))

(defn- me-handler
  []
  (ajax/get
    (routes/path-for-backend :me)
    {:on-success (fn [{:keys [response]}]
                   (state/update-value [:services-dashboard] (:service-dashboard response) state/form-value-cursor)
                   (state/update-value [:nodes-dashboard] (:node-dashboard response) state/form-value-cursor))}))

(defn- init-form-state
  []
  (state/set-value {:loading? {:stats       true
                               :nodes       true
                               :nodes-ts    true
                               :services    true
                               :services-ts true}} state/form-state-cursor))

(defn- init-form-value
  []
  (state/set-value {:stats              {}
                    :services           []
                    :services-dashboard []
                    :services-ts        []
                    :nodes              []
                    :nodes-dashboard    []
                    :nodes-ts           []} state/form-value-cursor))

(def mixin-init-form
  (mixin/init-form
    (fn [{{:keys [id]} :params}]
      (init-form-state)
      (init-form-value)
      (stats-handler)
      (nodes-handler)
      (services-handler)
      (services-ts-handler)
      (me-handler))))

(defn- resource-chip
  [name count]
  (comp/chip {:key       name
              :avatar    (comp/avatar {} count)
              :className "Swarmpit-dashboard-chip"
              :label     (inflect/pluralize-noun count name)}))

(rum/defc dashboard-cluster < rum/static [nodes]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "CLUSTER")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (str (count nodes) " " (inflect/pluralize-noun (count nodes) "node")))]
       [:div.Swarmpit-dashbord-section-chips
        (resource-chip "manager" (count (filter #(= "manager" (:role %)) nodes)))
        (resource-chip "worker" (count (filter #(= "worker" (:role %)) nodes)))]])))

(rum/defc dashboard-memory < rum/static [{:keys [usage used total] :as memory}]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "MEMORY")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (common/render-capacity used true))]
       [:div.Swarmpit-dashbord-section-graph
        (common/resource-pie
          {:value used
           :limit total
           :usage usage
           :type  :memory}
          (str (common/render-capacity total true) " ram")
          "graph-memory")]])))

(rum/defc dashboard-disk < rum/static [{:keys [usage used total] :as disk}]
  (comp/paper
    {:elevation 0
     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
    (html
      [:div.Swarmpit-dashboard-section
       [:div
        (comp/typography
          {:variant   "body2"
           :className "Swarmpit-dashboard-section-title"}
          "DISK")
        (comp/typography
          {:variant   "h5"
           :className "Swarmpit-dashboard-section-value"}
          (common/render-capacity used false))]
       [:div.Swarmpit-dashbord-section-graph
        (common/resource-pie
          {:value used
           :limit total
           :usage usage
           :type  :disk}
          (str (common/render-capacity total false) " size")
          "graph-disk")]])))

(rum/defc dashboard-cpu < rum/static [{:keys [usage cores] :as cpu}]
  (let [used (/ cores usage)]
    (comp/paper
      {:elevation 0
       :className "Swarmpit-paper Swarmpit-dashboard-paper"}
      (html
        [:div.Swarmpit-dashboard-section
         [:div
          (comp/typography
            {:variant   "body2"
             :className "Swarmpit-dashboard-section-title"}
            "CPU")
          (comp/typography
            {:variant   "h5"
             :className "Swarmpit-dashboard-section-value"}
            (common/render-cores (if (js/isNaN used) nil used)))]
         [:div.Swarmpit-dashbord-section-graph
          (common/resource-pie
            {:value used
             :limit cores
             :usage usage
             :type  :cpu}
            (str cores " vCPU")
            "graph-cpu")]]))))

(defn dashboard-node-ram-callback
  [state]
  (let [ts (first (:rum/args state))]
    (node-ram-plot ts))
  state)

(rum/defc dashboard-node-ram-stats < rum/static
                                     {:did-mount  dashboard-node-ram-callback
                                      :did-update dashboard-node-ram-callback} [nodes-ts]
  (comp/card
    (if (empty? nodes-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-node-ram-id}]))))

(defn dashboard-node-cpu-callback
  [state]
  (let [ts (first (:rum/args state))]
    (node-cpu-plot ts))
  state)

(rum/defc dashboard-node-cpu-stats < rum/static
                                     {:did-mount  dashboard-node-cpu-callback
                                      :did-update dashboard-node-cpu-callback} [nodes-ts]
  (comp/card
    (if (empty? nodes-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-node-cpu-id}]))))

(defn dashboard-service-ram-callback
  [state]
  (let [ts (first (:rum/args state))]
    (service-ram-plot ts))
  state)

(rum/defc dashboard-service-ram-stats < rum/static
                                        {:did-mount  dashboard-service-ram-callback
                                         :did-update dashboard-service-ram-callback} [services-memory-ts]
  (comp/card
    (if (empty? services-memory-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-service-ram-id}]))))

(defn dashboard-service-cpu-callback
  [state]
  (let [ts (first (:rum/args state))]
    (service-cpu-plot ts))
  state)

(rum/defc dashboard-service-cpu-stats < rum/static
                                        {:did-mount  dashboard-service-cpu-callback
                                         :did-update dashboard-service-cpu-callback} [services-cpu-ts]
  (comp/card
    (if (empty? services-cpu-ts)
      {:className "Swarmpit-card hide"}
      {:className "Swarmpit-card"})
    (comp/card-content
      {:className "Swarmpit-table-card-content"}
      (html [:div {:id plot-service-cpu-id}]))))

(rum/defc form-info < rum/static [{:keys [stats services services-ts services-dashboard nodes nodes-ts nodes-dashboard] :as item}]
  (let [pinned-services (filter #(contains? (set services-dashboard) (:id %)) services)
        pinned-nodes (filter #(contains? (set nodes-dashboard) (:id %)) nodes)
        running-services (->> (filter #(not= "not running" (:state %)) services)
                              (map :serviceName)
                              (set))
        services-cpu-ts (filter #(contains? running-services (:service %)) (:cpu services-ts))
        services-memory-ts (filter #(contains? running-services (:service %)) (:memory services-ts))]
    (comp/mui
      (html
        [:div.Swarmpit-form
         [:div.Swarmpit-form-context
          (comp/grid
            {:container true
             :spacing   2}
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-cluster nodes))
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-disk (:disk stats)))
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-memory (:memory stats)))
            (comp/grid
              {:item true
               :xs   12
               :sm   6
               :lg   3
               :xl   3}
              (dashboard-cpu (:cpu stats)))
            (when (not-empty pinned-services)
              (comp/grid
                {:item true
                 :xs   12
                 :sm   12
                 :lg   12
                 :xl   12}
                (services/pinned pinned-services)))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-service-ram-stats services-memory-ts))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-service-cpu-stats services-cpu-ts))
            (when (not-empty pinned-nodes)
              (comp/grid
                {:item true
                 :xs   12
                 :sm   12
                 :lg   12
                 :xl   12}
                (nodes/pinned pinned-nodes)))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-node-ram-stats nodes-ts))
            (comp/grid
              {:item true
               :xs   12
               :sm   12
               :md   12
               :lg   6
               :xl   6}
              (dashboard-node-cpu-stats nodes-ts)))]]))))

(rum/defc form < rum/reactive
                 mixin-init-form
                 mixin/subscribe-form [{{:keys [name]} :params}]
  (let [{:keys [loading?]} (state/react state/form-state-cursor)
        item (state/react state/form-value-cursor)]
    (progress/form
      (or (:stats loading?)
          (:nodes loading?)
          (:nodes-ts loading?)
          (:services loading?)
          (:services-ts loading?))
      (form-info item))))

fix cpu NaN usage

fix cpu NaN usage


(ns test-pom
  (:use [leiningen.core :only [read-project defproject]]
        [leiningen.util.maven :only [make-model]]
        [leiningen.pom :only [pom]])
  (:use [clojure.test]
        [clojure.java.io :only [file delete-file]]))

(def test-project (read-project "test_projects/sample/project.clj"))

(deftest test-pom
  (let [pom-file (file (:root test-project) "pom.xml")]
    (delete-file pom-file true)
    (pom test-project)
    (is (.exists pom-file))))

(deftest test-make-model-includes-build-settings
  (let [model (make-model test-project)]
    (is (= "src" (-> model .getBuild .getSourceDirectory)))
    (is (= "test" (-> model .getBuild .getTestSourceDirectory)))))

(deftest test-snapshot-checking
  (is (thrown? Exception (pom (assoc test-project
                                :version "1.0"
                                :dependencies [['clojure "1.0.0-SNAPSHOT"]])))))

(ns test-pom
  (:use [leiningen.core :only [read-project defproject]]
        [leiningen.util.maven :only [make-model]]
        [leiningen.pom :only [pom]])
  (:use [clojure.test]
        [clojure.java.io :only [file delete-file]]))

(def test-project (read-project "test_projects/sample/project.clj"))

(deftest test-pom
  (let [pom-file (file (:root test-project) "pom.xml")]
    (delete-file pom-file true)
    (pom test-project)
    (is (.exists pom-file))))

(deftest test-make-model-includes-build-settings
  (let [model (make-model test-project)]
    (is (= "src" (-> model .getBuild .getSourceDirectory)))
    (is (= "test" (-> model .getBuild .getTestSourceDirectory)))))

(deftest test-snapshot-checking
  (let [aborted? (atom false)]
    (binding [leiningen.core/abort (partial reset! aborted?)]
      (pom (assoc test-project :version "1.0"
                  :dependencies [['clojure "1.0.0-SNAPSHOT"]]))
      (is @aborted?))))

Fix test-pom to watch for abort.

Fix test-pom to watch for abort.


(ns yetibot.core.repl
  "Load this namespace when working with YetiBot in the REPL or during dev."
  (:require
    [yetibot.core.db :as db]
    [yetibot.core.models.users :as users]
    [yetibot.core.loader :refer [load-commands-and-observers load-ns]]
    [yetibot.core.adapters.campfire :as cf]
    [yetibot.core.adapters.irc :as irc]))

; use a few non-network commands for testing
(defn load-minimal []
  (require 'yetibot.core.commands.echo :reload)
  (require 'yetibot.core.commands.help :reload)
  (require 'yetibot.core.observers.history :reload)
  (require 'yetibot.core.commands.history :reload)
  (require 'yetibot.core.commands.users :reload)
  (require 'yetibot.core.commands.collections :reload))

(defn start []
  (load-minimal)
  (db/repl-start)
  (cf/start)
  (irc/start))

(defn stop []
  (irc/stop))

(defn load-all []
  (future
    (load-commands-and-observers)))

(ns yetibot.core.repl
  "Load this namespace when working with YetiBot in the REPL or during dev."
  (:require
    [yetibot.core.db :as db]
    [yetibot.core.models.users :as users]
    [yetibot.core.loader :refer [load-commands-and-observers load-ns]]
    [yetibot.core.adapters.campfire :as cf]
    [yetibot.core.adapters.irc :as irc]))

; use a few non-network commands for testing
(defn load-minimal []
  (require 'yetibot.core.commands.echo :reload)
  (require 'yetibot.core.commands.help :reload)
  (require 'yetibot.core.observers.history :reload)
  (require 'yetibot.core.commands.history :reload)
  (require 'yetibot.core.commands.users :reload)
  (require 'yetibot.core.commands.collections :reload))

(defn start
  "Load a minimal set of commands, start the database and connect to chat adapters"
  []
  (load-minimal)
  (db/repl-start)
  (cf/start)
  (irc/start))

(defn start-offline
  "Offline repl-driven dev mode"
  []
  (load-minimal)
  (db/repl-start))

(defn stop []
  (irc/stop))

(defn load-all []
  (future
    (load-commands-and-observers)))

Add yetibot.core.repl/start-offline for offline dev


(ns hu.ssh.github-changelog.semver-test
  (:require
    [hu.ssh.github-changelog.semver :as semver]
    [hu.ssh.github-changelog.schema :refer [Semver]]
    [schema.experimental.generators :as g]
    [schema.experimental.complete :as c]
    [clojure.test :refer :all]))

(deftest extract
  (testing "with a v prefix"
    (is (semver/extract "v0.0.1"))
    (is (semver/extract "v0.9.3-pre0"))
    (is (semver/extract "v1.0.1")))
  (testing "without a v prefix"
    (is (semver/extract "0.0.1"))
    (is (semver/extract "0.9.3-pre0"))
    (is (semver/extract "1.0.1"))))

(deftest newer?
  (is (semver/newer? (c/complete {:major 1} Semver) (c/complete {:major 0} Semver)))
  (is (not (semver/newer? (c/complete {:major 0} Semver) (c/complete {:major 1} Semver)))))

(ns hu.ssh.github-changelog.semver-test
  (:require
    [hu.ssh.github-changelog.semver :as semver]
    [hu.ssh.github-changelog.schema :refer [Semver]]
    [schema.experimental.generators :as g]
    [schema.experimental.complete :as c]
    [clojure.test :refer :all]))

(deftest extract
  (testing "with a v prefix"
    (are [version] (not (nil? (semver/extract version)))
                   "v0.0.1"
                   "v0.9.3-pre0"
                   "v1.0.1"))
  (testing "without a v prefix"
    (are [version] (not (nil? (semver/extract version)))
                   "0.0.1"
                   "0.9.3-pre0"
                   "1.0.1")))

(deftest newer?
  (is (semver/newer? (c/complete {:major 1} Semver) (c/complete {:major 0} Semver)))
  (is (not (semver/newer? (c/complete {:major 0} Semver) (c/complete {:major 1} Semver)))))

refactor with are

refactor with are