(ns koeeoadi.components.palette
  (:require [goog.style :refer [setStyle]]
            [goog.events :as gevents]
            [goog.array :refer [forEach]]
            [goog.dom :refer [getActiveElement getDocument getElement getElementsByTagNameAndClass]]
            [om.dom :as dom]
            [om.next :as om :refer-macros [defui]]
            [koeeoadi.util :as util]
            [koeeoadi.reconciler :refer [reconciler]])
  (:import [goog.dom query]
           [goog.ui HsvPalette]
           [goog.ui.Component EventType]))

(declare Palette)
(declare PaletteWidget)

(defn widget-input-elem [comp]
  (aget (query "input" (getElement (dom/node comp))) 0))

(defn color-update
  ([comp]
   (let [{:keys [:palette-widget/active-color
                 :palette-widget/closure-comp]} (om/props comp)]
     (color-update comp active-color closure-comp (.getColor closure-comp))))
  ([comp active-color closure-comp color-hex]
   (when (not= color-hex (:color/hex active-color))
     (let [id         (:color/id active-color)
           color-comp (om/ref->any reconciler [:colors/by-id id])]
       (om/transact! color-comp
         `[(state/update-ref  {:mutate/name color/update
                               :props {:color/id  ~id
                                       :color/hex ~(.getColor closure-comp)}}) :palette])))))

(defn color-remove [comp {:keys [color/id] :as color} e]
  (.preventDefault e)
  (.stopPropagation e)
  (om/transact! comp
    `[(color/remove) :palette]))

(defn palette-widget-update [color-id faces-list]
  (om/transact! (om/class->any reconciler Palette)
    `[(state/merge
        {:palette-widget/active-color [:colors/by-id ~color-id]
         :palette-widget/face-classes-by-color-type ~(util/faces-to-colorize faces-list color-id)})]))

(defn face-class-prefix [color-type]
  (if (= :face/color-fg color-type)
    ".color-fg-"
    ".color-bg-"))

(defn face-to-selectors [face color-type]
  (vector (str ".code-" face) (str (face-class-prefix color-type) face)))

(defn colorize-faces [classes color-prop hex-temp]
  (when-not (empty? classes)
    (let [elements (query classes)]
      (forEach elements #(setStyle % color-prop hex-temp)))))

(defn selectors-for-colorize [faces color-type]
  (let [selectors (map #(face-to-selectors % color-type) faces)
        cnt (count selectors)]
    (cond
      (= count 0)
      [nil nil]

      (= count 1 (count faces))
      (first selectors)

      :else (reduce #(vector
                 (str (first %1) "," (first %2))
                 (str (last %1) "," (last %2)))
        selectors))))

(defn color-class [props]
  (let [{:keys [:color/id :color/hex :palette-widget/active-color]} props
        active? (= id (:color/id active-color))]
    (str "color color-editable"
      (when active? " color-active")
      (when-not hex " color-missing")
      " color-" id)))

(defui Color
  static om/Ident
  (ident [this {:keys [color/id]}]
    [:colors/by-id id])

  static om/IQuery
  (query [this]
    (into []
      (concat util/shared-color-query
        '[[:palette-widget/active-color _]
          [:faces/list _]])))

  Object
  (render [this]
    (let [{:keys [color/id color/hex faces/list] :as color} (om/props this)
          {:keys [hex-temp]} (om/get-state this)]
      (dom/div #js {:className (color-class color)
                    :style     (when (or hex-temp hex) #js {:backgroundColor (or hex-temp hex)})}
        (dom/div #js {:className "color-mask"
                      :onClick   #(palette-widget-update id list)})
        (dom/button #js {:className "color-remove"
                         :onClick   #(color-remove this color %)}
          (dom/i #js {:className "fa fa-remove fa-2x"}))))))

(def color (om/factory Color {:keyfn :color/id}))

(defn color-add [comp]
  (om/transact! comp '[(color/add)]))

(defui ColorAdder
  Object
  (render [this]
    (let [callback (:callback (om/get-computed this))]
      (dom/div #js {:className "color color-add"
                    :onClick   callback}
        (dom/i #js {:className "fa fa-plus"})))))

(def color-adder (om/factory ColorAdder))

(defn selectors [bg-faces fg-faces]
  (let [fg-faces-empty? (empty? fg-faces)
        bg-faces-empty? (empty? bg-faces)]
    (vector
      (clojure.string/join []))))

(defn handle-action [comp e]
  (let [{:keys [palette-widget/active-color
                palette-widget/face-classes-by-color-type]} (om/props comp)
        hex-temp (util/target-color e)]
    (if  (= (widget-input-elem comp) (getActiveElement (getDocument)))
      (color-update comp)
      ;; TODO refactor this so its in the state, its wasteful to calculate this on each run through, could maybe even use the element references themeselves
      (let [{:keys [bg-faces fg-faces]} face-classes-by-color-type
            color-editable-selector (str ".color-" (:color/id active-color))
            [code-bg-selector face-bg-color-selector] (selectors-for-colorize bg-faces :face/color-bg)
            [code-fg-selector face-fg-color-selector] (selectors-for-colorize fg-faces :face/color-fg)
            bg-selectors  (clojure.string/join "," (remove nil? [color-editable-selector code-bg-selector face-bg-color-selector face-fg-color-selector]))
            fg-selectors   (clojure.string/join "," (remove nil? [code-fg-selector]))]

        (colorize-faces bg-selectors "background-color" hex-temp)
        (colorize-faces fg-selectors "color" hex-temp)))))

(defui PaletteWidget
  static om/IQuery
  (query [this]
    '[[:palette-widget/closure-comp _]
      [:palette-widget/active-color _]
      [:palette-widget/face-classes-by-color-type _]
      [:faces/list _]])

  Object
  (componentDidMount [this]
    (let [{:keys        [palette-widget/active-color faces/list] :as props} (om/props this)
          widget        (HsvPalette. nil nil "goog-hsv-palette-sm")]
      (.render widget (getElement (dom/node this "paletteWidget")))
      (let [input (widget-input-elem this)]
        (.setColor widget (:color/hex active-color))
        (gevents/listen widget EventType.ACTION #(handle-action this %))
        (om/transact! this `[(state/merge
                               {:palette-widget/face-classes-by-color-type ~(util/faces-to-colorize list (:color/id active-color))
                                :palette-widget/closure-comp ~widget})]))))

  (componentDidUpdate [this {id-prev :color/id} _]
    (let [{:keys [palette-widget/active-color
                  palette-widget/closure-comp
                  faces/list]} (om/props this)]
      (when (not= (:color/id active-color) id-prev)
        (.setColor closure-comp (:color/hex active-color)))))

  (render [this]
    (let [{:keys [palette-widget/closure-comp
                  palette-widget/active-color] :as props} (om/props this)]

      (dom/div #js {:onMouseUp    #(color-update this)
                    :onMouseLeave #(color-update this)
                    :id  "palette-widget"
                    :ref "paletteWidget"} nil))))

(def palette-widget (om/factory PaletteWidget))

(defn minimum-colors-class [colors]
  (when (< (count colors) 3)
    "minimum-colors"))

(defui Palette
  static om/IQuery
  (query [this]
    `[:widget/active
      {:colors/list ~(om/get-query Color)}
      {:palette-widget ~(om/get-query PaletteWidget)}])

  Object
  (render [this]
    (let [{widget-active       :widget/active
           colors/list         :colors/list
           palette-widget-data :palette-widget} (om/props this)
          callback (partial color-add this)]
      (dom/div #js {:className (util/widget-class :palette widget-active)
                    :id        "palette"}
        (util/widget-title "Palette")
        (apply dom/div #js {:id "palette-colors"
                            :className (minimum-colors-class list)}
          (palette-widget palette-widget-data)
          (conj (mapv #(color (merge % palette-widget-data)) list)
            (color-adder (om/computed {} {:callback callback}))))))))

(def palette (om/factory Palette))

(ns koeeoadi.components.palette
  (:require [goog.style :refer [setStyle]]
            [goog.events :as gevents]
            [goog.array :refer [forEach]]
            [goog.dom :refer [getActiveElement getDocument getElement getElementsByTagNameAndClass]]
            [om.dom :as dom]
            [om.next :as om :refer-macros [defui]]
            [koeeoadi.util :as util]
            [koeeoadi.reconciler :refer [reconciler]])
  (:import [goog.dom query]
           [goog.ui HsvPalette]
           [goog.ui.Component EventType]))

(declare Palette)
(declare PaletteWidget)

(defn widget-input-elem [comp]
  (aget (query "input" (getElement (dom/node comp))) 0))

(defn color-update
  ([comp]
   (let [{:keys [:palette-widget/active-color
                 :palette-widget/closure-comp]} (om/props comp)]
     (color-update comp active-color closure-comp (.getColor closure-comp))))
  ([comp active-color closure-comp color-hex]
   (when (not= color-hex (:color/hex active-color))
     (let [id         (:color/id active-color)
           color-comp (om/ref->any reconciler [:colors/by-id id])]
       (om/transact! color-comp
         `[(state/update-ref  {:mutate/name color/update
                               :props {:color/id  ~id
                                       :color/hex ~(.getColor closure-comp)}}) :palette])))))

(defn color-remove [comp {:keys [color/id] :as color} e]
  (.preventDefault e)
  (.stopPropagation e)
  (om/transact! comp
    `[(color/remove) :palette]))

(defn palette-widget-update [color-id faces-list]
  (om/transact! (om/class->any reconciler Palette)
    `[(state/merge
        {:palette-widget/active-color [:colors/by-id ~color-id]
         :palette-widget/face-classes-by-color-type ~(util/faces-to-colorize faces-list color-id)})]))

(defn face-class-prefix [color-type]
  (if (= :face/color-fg color-type)
    ".color-fg-"
    ".color-bg-"))

(defn face-to-selectors [face color-type]
  (vector (str ".code-" face) (str (face-class-prefix color-type) face)))

(defn colorize-faces [classes color-prop hex-temp]
  (when-not (empty? classes)
    (let [elements (query classes)]
      (forEach elements #(setStyle % color-prop hex-temp)))))

(defn selectors-for-colorize [faces color-type]
  (let [selectors (map #(face-to-selectors % color-type) faces)
        cnt (count selectors)]
    (cond
      (= cnt 0)
      [nil nil]

      (= cnt 1)
      (first selectors)

      :else (reduce #(vector
                 (str (first %1) "," (first %2))
                 (str (last %1) "," (last %2)))
        selectors))))

(defn color-class [props]
  (let [{:keys [:color/id :color/hex :palette-widget/active-color]} props
        active? (= id (:color/id active-color))]
    (str "color color-editable"
      (when active? " color-active")
      (when-not hex " color-missing")
      " color-" id)))

(defui Color
  static om/Ident
  (ident [this {:keys [color/id]}]
    [:colors/by-id id])

  static om/IQuery
  (query [this]
    (into []
      (concat util/shared-color-query
        '[[:palette-widget/active-color _]
          [:faces/list _]])))

  Object
  (render [this]
    (let [{:keys [color/id color/hex faces/list] :as color} (om/props this)
          {:keys [hex-temp]} (om/get-state this)]
      (dom/div #js {:className (color-class color)
                    :style     (when (or hex-temp hex) #js {:backgroundColor (or hex-temp hex)})}
        (dom/div #js {:className "color-mask"
                      :onClick   #(palette-widget-update id list)})
        (dom/button #js {:className "color-remove"
                         :onClick   #(color-remove this color %)}
          (dom/i #js {:className "fa fa-remove fa-2x"}))))))

(def color (om/factory Color {:keyfn :color/id}))

(defn color-add [comp]
  (om/transact! comp '[(color/add)]))

(defui ColorAdder
  Object
  (render [this]
    (let [callback (:callback (om/get-computed this))]
      (dom/div #js {:className "color color-add"
                    :onClick   callback}
        (dom/i #js {:className "fa fa-plus"})))))

(def color-adder (om/factory ColorAdder))

(defn selectors [bg-faces fg-faces]
  (let [fg-faces-empty? (empty? fg-faces)
        bg-faces-empty? (empty? bg-faces)]
    (vector
      (clojure.string/join []))))

(defn handle-action [comp e]
  (let [{:keys [palette-widget/active-color
                palette-widget/face-classes-by-color-type]} (om/props comp)
        hex-temp (util/target-color e)]
    (if  (= (widget-input-elem comp) (getActiveElement (getDocument)))
      (color-update comp)
      ;; TODO refactor this so its in the state, its wasteful to calculate this on each run through, could maybe even use the element references themeselves
      (let [{:keys [bg-faces fg-faces]} face-classes-by-color-type
            color-editable-selector (str ".color-" (:color/id active-color))
            [code-bg-selector face-bg-color-selector] (selectors-for-colorize bg-faces :face/color-bg)
            [code-fg-selector face-fg-color-selector] (selectors-for-colorize fg-faces :face/color-fg)
            bg-selectors  (clojure.string/join "," (remove nil? [color-editable-selector code-bg-selector face-bg-color-selector face-fg-color-selector]))]
        (colorize-faces bg-selectors "background-color" hex-temp)
        (when code-fg-selector (colorize-faces code-fg-selector "color" hex-temp))))))

(defui PaletteWidget
  static om/IQuery
  (query [this]
    '[[:palette-widget/closure-comp _]
      [:palette-widget/active-color _]
      [:palette-widget/face-classes-by-color-type _]
      [:faces/list _]])

  Object
  (componentDidMount [this]
    (let [{:keys        [palette-widget/active-color faces/list] :as props} (om/props this)
          widget        (HsvPalette. nil nil "goog-hsv-palette-sm")]
      (.render widget (getElement (dom/node this "paletteWidget")))
      (let [input (widget-input-elem this)]
        (.setColor widget (:color/hex active-color))
        (gevents/listen widget EventType.ACTION #(handle-action this %))
        (om/transact! this `[(state/merge
                               {:palette-widget/face-classes-by-color-type ~(util/faces-to-colorize list (:color/id active-color))
                                :palette-widget/closure-comp ~widget})]))))

  (componentDidUpdate [this {id-prev :color/id} _]
    (let [{:keys [palette-widget/active-color
                  palette-widget/closure-comp
                  faces/list]} (om/props this)]
      (when (not= (:color/id active-color) id-prev)
        (.setColor closure-comp (:color/hex active-color)))))

  (render [this]
    (let [{:keys [palette-widget/closure-comp
                  palette-widget/active-color] :as props} (om/props this)]

      (dom/div #js {:onMouseUp    #(color-update this)
                    :onMouseLeave #(color-update this)
                    :id  "palette-widget"
                    :ref "paletteWidget"} nil))))

(def palette-widget (om/factory PaletteWidget))

(defn minimum-colors-class [colors]
  (when (< (count colors) 3)
    "minimum-colors"))

(defui Palette
  static om/IQuery
  (query [this]
    `[:widget/active
      {:colors/list ~(om/get-query Color)}
      {:palette-widget ~(om/get-query PaletteWidget)}])

  Object
  (render [this]
    (let [{widget-active       :widget/active
           colors/list         :colors/list
           palette-widget-data :palette-widget} (om/props this)
          callback (partial color-add this)]
      (dom/div #js {:className (util/widget-class :palette widget-active)
                    :id        "palette"}
        (util/widget-title "Palette")
        (apply dom/div #js {:id "palette-colors"
                            :className (minimum-colors-class list)}
          (palette-widget palette-widget-data)
          (conj (mapv #(color (merge % palette-widget-data)) list)
            (color-adder (om/computed {} {:callback callback}))))))))

(def palette (om/factory Palette))

Fix bug in css color updating

Fix bug in css color updating


(ns basics.core
  (:gen-class))

; similar to import static - reference code in other namespace as if it is local
(use 'clojure.set)
(require 'clojure.string)

(defn lists
  "lists"
  []
  (prn "lists")
  (prn (list 1 2 3))
  ; or quoted
  '(1 2 3)
  (prn (first '(1 2 3)))
  (prn (rest '(1 2 3)))
  ; get first/rest support from other various structures
  (seq #{1 2 3 4 5}))

(defn maps
  "maps"
  []
  (prn "maps")
  ; map literals are hashmaps
  (let [a {:a 1 :b 2}]
    (prn a)
    ; map and symbols are functions
    (prn (:a a))
    (prn (a :a))
    ; join data structures with merging function
    (prn (merge-with + a {:c 3 :d 4}))
    (prn (keys a))
  ))

(defn vectors
  "vectors"
  []
  (prn "vectors")
  ; random access
  (prn [1 2 3])
  (prn ([1 2 3] 2)))

(defn sets
  "sets"
  []
  (prn "sets")
  ; hash literals are hashsets
  (prn (union #{1 2 3} #{3 4 5}))
  (prn #{1 2 3}))

(defn overloaded
  ([a] (overloaded a 2))
  ([a b] (prn '(a b))))

(defn -main [& args]
  (lists)
  (maps)
  (vectors)
  (sets)

  (overloaded 1)
  (overloaded 1 2)

  ; var that is meant to be rebound - the name is convention and
  ; dynamic makes this explicit
  (def ^:dynamic *rebindable* "initial")

  ; without dynamic, optimizations are made since it will not be rebound
  (def static "static")

  ; regex literal
  #","

  'foo ;foo
  `foo ;user/foo
  (def foo 5) ;#'user/foo
  (resolve 'foo) ; #'user/foo

  ; destructuring
  (let [[a b c] [1 2 3]] (prn b))

  ; use or as a fallback if match fails
  (let [{a :a, b :b, :as m :or {a 5 b 7}} {:a 1 :b 2}] (prn b))

  ; build map from vectors
  (into {} (map vector [:a :b :c] [1 2 3]))

  ; anonymous function - ignore parameters with _
  ((fn [x _] x) 2 3)

  (.toLowerCase "AHHHHH")

  ; reference equality
  (identical? 'a 'a)
  ; value equality
  (= 'a 'a)

  ; null
  nil

  ; multimethods
  (defmulti encounter (fn [x y] [(:Species x) (:Species y)]))

  (defmethod encounter [:Bunny :Lion] [b l] :run-away)
  (defmethod encounter [:Lion :Bunny] [l b] :eat)

  (def b {:Species :Bunny})
  (def l {:Species :Lion})

  (prn (encounter b l))
  (prn (encounter l b))

  ; for loop returns another collection
  ; doseq is used for procedures returning nil
  (doseq [x (for [i (range 10)] (+ i 10))]
    (prn x))

  (let [a [1 2 3]
        b {:a 1 :b 2}
        c (list 1 2 3)]
    ;same interface for all collections
    (prn [(conj a 4)
          (conj b [:c 3])
          (conj c 4)
          a b c])))

(ns basics.core
  (:gen-class))

; similar to import static - reference code in other namespace as if it is local
(use 'clojure.set)
(require 'clojure.string)

(defn lists
  "lists"
  []
  (prn "lists")
  (prn (list 1 2 3))
  ; or quoted
  '(1 2 3)
  (prn (first '(1 2 3)))
  (prn (rest '(1 2 3)))
  ; get first/rest support from other various structures
  (seq #{1 2 3 4 5}))

(defn maps
  "maps"
  []
  (prn "maps")
  ; map literals are hashmaps
  (let [a {:a 1 :b 2}]
    (prn a)
    ; map and symbols are functions
    (prn (:a a))
    (prn (a :a))
    ; join data structures with merging function
    (prn (merge-with + a {:c 3 :d 4}))
    (prn (keys a))
  ))

(defn vectors
  "vectors"
  []
  (prn "vectors")
  ; random access
  (prn [1 2 3])
  (prn ([1 2 3] 2)))

(defn sets
  "sets"
  []
  (prn "sets")
  ; hash literals are hashsets
  (prn (union #{1 2 3} #{3 4 5}))
  (prn #{1 2 3}))

(defn overloaded
  ([a] (overloaded a 2))
  ([a b] (prn '(a b))))

(defn -main [& args]
  (lists)
  (maps)
  (vectors)
  (sets)

  (overloaded 1)
  (overloaded 1 2)

  ; var that is meant to be rebound - the name is convention and
  ; dynamic makes this explicit
  (def ^:dynamic *rebindable* "initial")

  ; without dynamic, optimizations are made since it will not be rebound
  (def static "static")

  ; regex literal
  #","

  'foo ;foo
  `foo ;user/foo
  (def foo 5) ;#'user/foo
  (resolve 'foo) ; #'user/foo

  ; destructuring
  (let [[a b c] [1 2 3]] (prn b))

  ; use or as a fallback if match fails
  (let [{a :a, b :b, :as m :or {a 5 b 7}} {:a 1 :b 2}] (prn b))

  ; build map from vectors
  (into {} (map vector [:a :b :c] [1 2 3]))

  ; anonymous function - ignore parameters with _
  ((fn [x _] x) 2 3)

  (.toLowerCase "AHHHHH")

  ; reference equality
  (identical? 'a 'a)
  ; value equality
  (= 'a 'a)

  ; null
  nil
  ; multimethods
  (defmulti encounter (fn [x y] [(:Species x) (:Species y)]))

  (defmethod encounter [:Bunny :Lion] [b l] :run-away)
  (defmethod encounter [:Lion :Bunny] [l b] :eat)

  (def b {:Species :Bunny})
  (def l {:Species :Lion})

  (prn (encounter b l))
  (prn (encounter l b))

  ; for loop returns another collection
  ; doseq is used for procedures returning nil
  (doseq [x (for [i (range 10)] (+ i 10))]
    (prn x))

  ; metadata
  (def v [1 2 3])
  (def trusted (with-meta v {:source :trusted}))

  ;;; STM - uses Multiversion Concurrency Control

  ;; refs
  ; - shared, synchronous, transactional, atomic
  (def r (ref {:a 1 :b 2 :c 3}))
  ; deref
  @r
  ; read and modify ref - next dereference will have new value
  (dosync (commute r assoc :c 5))

  ;; agents - shared, asynchronous, autonomoous
  ; - can do side effects
  ; dispatches made during an action are held until after the
  ; state of the agent has changed
  (def a (agent {:a 1 :b 2 :c 3}))
  @a
  ; update change asynchronously
  (send a assoc :d 4)
  ; wait for change
  (await a)

  (let [a [1 2 3]
        b {:a 1 :b 2}
        c (list 1 2 3)]
    ;same interface for all collections
    (prn [(conj a 4)
          (conj b [:c 3])
          (conj c 4)
          a b c])))

Add stm snippets

Add stm snippets


(ns build.core
  (:require [markdown.core :refer [md->html]]
            [planck.core :refer [slurp spit]]
            [planck.shell :refer [sh]]))

(def src "src/")
(def target "target/")
(def public (str target "public/"))

(def preamble (slurp (str src "preamble.html")))
(def postamble (slurp (str src "postamble.html")))

(defn wrap-html
  [body]
  (str preamble body postamble))

(defn md-to-html
  [in out]
  (spit out
    (wrap-html
      (md->html (slurp in)))))

(defn process-md
  [in]
  (md-to-html
    (str src in) (str public (subs in 0 (- (count in) 2)) "html")))

(sh "mkdir" target)
(sh "rm" "-rf" public)
(sh "mkdir" public)

(process-md "index.md")
(process-md "roadmap.md")
(process-md "ambly.md")

(sh "cp" "-r" (str src "img") public)
(sh "cp" "-r" (str src "css") public)

(ns build.core
  (:require [markdown.core :refer [md->html]]
            [planck.core :refer [slurp spit]]
            [planck.shell :refer [sh]]))

(def src "src/")
(def target "target/")
(def public (str target "public/"))

(def preamble (slurp (str src "preamble.html")))
(def postamble (slurp (str src "postamble.html")))

(defn wrap-html
  [body]
  (str preamble body postamble))

(defn md-to-html
  [in out]
  (spit out
    (wrap-html
      (md->html (slurp in)))))

(defn process-md
  [in]
  (md-to-html
    (str src in) (str public (subs in 0 (- (count in) 2)) "html")))

(sh "mkdir" "-p" target)
(sh "rm" "-rf" public)
(sh "mkdir" "-p" public)

(process-md "index.md")
(process-md "roadmap.md")
(process-md "ambly.md")

(sh "cp" "-r" (str src "img") public)
(sh "cp" "-r" (str src "css") public)

Fix build scripts in the case that dirs already exist


(ns circle.backend.build.run
  (:require [circle.backend.action :as action])
  (:require [circle.backend.build.config :as config])
  (:require [circle.backend.build.notify :as notify])
  (:require [circle.env :as env])
  (:require [circle.model.build :as build])
  (:require [circle.model.project :as project])
  (:require [clj-time.core :as time])
  (:use [arohner.utils :only (fold)])
  (:use [circle.airbrake :only (with-airbrake)])
  (:use [circle.backend.action.nodes :only (cleanup-nodes)])
  (:use [circle.globals :only (*current-build-url* *current-build-number*)])
  (:use [circle.logging :only (add-file-appender)])
  (:use [circle.util.except :only (throw-if throw-if-not)])
  (:use [circle.util.seq :only (find-first index-of)])
  (:use [circle.util.straight-jacket :only (straight-jacket)])
  (:use [circle.util.time :only (java-now)])
  (:use [clojure.tools.logging :only (with-logs error infof errorf)]))

(def in-progress (ref #{}))

(defn finish-action [b act]
  (dosync
   ;; TODO - make this cleaner somehow, remove the need for index-of
   (let [act-index (index-of (-> @b :actions) act)]
     (throw-if-not (integer? act-index) "couldn't find action")
     (alter b update-in [:actions act-index] assoc :finished true))))

(defn run-action [b act]
  (build/build-log "running %s" (-> act :name))
  (try
    (action/run-action b act)
    (finally
     (finish-action b act)
     (build/update-mongo b))))

(defn next-act
  "Returns the next action to run"
  [b]
  (find-first #(not (:finished %)) (-> @b :actions)))

(defn do-build* [b]
  (while (and (-> @b :continue?)
              (next-act b))
    (run-action b (next-act b)))
  b)

(defn log-result [b]
  (if (build/successful? b)
    (infof "Build %s successful" (build/build-name b))
    (errorf "Build %s failed" (build/build-name b))))

(defn start [b]
  (throw-if-not (-> @b :_id) "build must have an id")
  (infof "starting build: %s, %s" (build/build-name b) (-> @b :_id))
  (dosync
   (alter b assoc :start_time (java-now))
   (alter in-progress conj b))
  (build/update-mongo b))

(defn finished [b]
  (dosync
   (infof "removing build %s from in-progress" (build/build-name b))
   (alter in-progress disj b)
   (alter b assoc :stop_time (-> (time/now) .toDate)))
  (let [project (build/get-project b)]
    (when (and (-> @b :actions (count) (zero?)))
      (project/set-uninferrable project)))
  (build/update-mongo b))

(defn run-build [b & {:keys [cleanup-on-failure]
                      :or {cleanup-on-failure true}}]
  (infof "run-build:" b)
  (binding [*current-build-url* (-> @b :vcs_url)
            *current-build-number* (-> @b :build_num)]
    (with-airbrake
      (try
        (start b)
        (build/with-build-log-ns b
          (do-build* b))
        b
        (catch Exception e
          (println "run-build: except:" b e)
          (error e (format "caught exception on %s" (build/build-name b)))
          (dosync
           (alter b assoc :failed true)
           (alter b assoc :infrastructure_fail true))
          (throw e))
        (finally
         (finished b)

         ;; Send build notifications, but don't let it fuck up anything else.
         (straight-jacket
          (notify/notify-build-results b))

         (log-result b)
         (when (and (-> @b :failed) cleanup-on-failure)
           (cleanup-nodes b)))))))

(defn fetch-run-build [id]
  (run-build (build/fetch-build id)))

(defn run-url [url & {:keys [cleanup-on-failure]}]
  (-> url
      (config/build-from-url)
      (run-build :cleanup-on-failure cleanup-on-failure)))

(defn configure
  "Makes sure the build has run it's configure step (if it has one). Mainly a convenience for testing."
  [build]
  (let [first-act (-> @build :actions (first))]
    (if (and (= config/config-action-name (-> first-act :name))
             (not (-> first-act :finished)))
      (run-action build first-act)))
  build)

(ns circle.backend.build.run
  (:require [circle.backend.action :as action])
  (:require [circle.backend.build.config :as config])
  (:require [circle.backend.build.notify :as notify])
  (:require [circle.env :as env])
  (:require [circle.model.build :as build])
  (:require [circle.model.project :as project])
  (:require [clj-time.core :as time])
  (:use [arohner.utils :only (fold)])
  (:use [circle.airbrake :only (with-airbrake)])
  (:use [circle.backend.action.nodes :only (cleanup-nodes)])
  (:use [circle.globals :only (*current-build-url* *current-build-number*)])
  (:use [circle.logging :only (add-file-appender)])
  (:use [circle.util.except :only (throw-if throw-if-not)])
  (:use [circle.util.seq :only (find-first index-of)])
  (:use [circle.util.straight-jacket :only (straight-jacket)])
  (:use [circle.util.time :only (java-now)])
  (:use [clojure.tools.logging :only (with-logs error infof errorf)]))

(def in-progress (ref #{}))

(defn finish-action [b act]
  (dosync
   ;; TODO - make this cleaner somehow, remove the need for index-of
   (let [act-index (index-of (-> @b :actions) act)]
     (throw-if-not (integer? act-index) "couldn't find action")
     (alter b update-in [:actions act-index] assoc :finished true))))

(defn run-action [b act]
  (build/build-log "running %s" (-> act :name))
  (try
    (action/run-action b act)
    (finally
     (finish-action b act)
     (build/update-mongo b))))

(defn next-act
  "Returns the next action to run"
  [b]
  (find-first #(not (:finished %)) (-> @b :actions)))

(defn do-build* [b]
  (while (and (-> @b :continue?)
              (next-act b))
    (run-action b (next-act b)))
  b)

(defn log-result [b]
  (if (build/successful? b)
    (infof "Build %s successful" (build/build-name b))
    (errorf "Build %s failed" (build/build-name b))))

(defn start [b]
  (throw-if-not (-> @b :_id) "build must have an id")
  (infof "starting build: %s, %s" (build/build-name b) (-> @b :_id))
  (dosync
   (alter b assoc :start_time (java-now))
   (alter in-progress conj b))
  (build/update-mongo b))

(defn finished [b]
  (dosync
   (infof "removing build %s from in-progress" (build/build-name b))
   (alter in-progress disj b)
   (alter b assoc :stop_time (-> (time/now) .toDate)))
  (let [project (build/get-project b)]
    (when (and (-> @b :actions (count) (zero?)))
      (project/set-uninferrable project)))
  (build/update-mongo b))

(defn run-build [b & {:keys [cleanup-on-failure]
                      :or {cleanup-on-failure true}}]
  (infof "run-build:" b)
  (binding [*current-build-url* (-> @b :vcs_url)
            *current-build-number* (-> @b :build_num)]
    (with-airbrake
      (try
        (start b)
        (build/with-build-log-ns b
          (do-build* b))
        b
        (catch Exception e
          (println "run-build: except:" b e)
          (error e (format "caught exception on %s" (build/build-name b)))
          (dosync
           (alter b assoc :failed true)
           (alter b assoc :infrastructure_fail true))
          (throw e))
        (finally
         (finished b)

         ;; Send build notifications, but don't let it fuck up anything else.
         (straight-jacket
          (notify/notify-build-results b))

         (log-result b)
         (when (and (-> @b :failed) cleanup-on-failure)
           (cleanup-nodes b)))))))

(defn fetch-run-build [id]
  (run-build (build/fetch-build id)))

(defn run-url [url & {:keys [cleanup-on-failure job-name]}]
  (-> url
      (config/build-from-url :job-name job-name)
      (run-build :cleanup-on-failure cleanup-on-failure)))

(defn configure
  "Makes sure the build has run it's configure step (if it has one). Mainly a convenience for testing."
  [build]
  (let [first-act (-> @build :actions (first))]
    (if (and (= config/config-action-name (-> first-act :name))
             (not (-> first-act :finished)))
      (run-action build first-act)))
  build)

Add :job-name option to run-url

Add :job-name option to run-url


(ns chili-dog-night.data
  (:require [hiccup.element :as el]))

(def gatherings [{:date "2016/03/02"
                  :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                  :synopsis "March 2nd, 2016: Chili Dogs, Fuller House, The Intern, and Before We Go."
                  :food ["Chili Dogs"
                         "King's Hawaiian Original Sweet Dinner Rolls"
                         "Red Velvet Oreo Sandwich Cookies"
                         "Oreo Mega Stuf Chocolate Sandwich Cookies"
                         "Chips Ahoy! Original Chocolate Chip Cookies"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"
                              "Colin Teal"
                              "Kaia"]
                  :media [{:title "Fuller House" :uri "http://www.imdb.com/title/tt3986586/"}
                          {:title "The Intern" :uri "http://www.imdb.com/title/tt2361509/"}
                          {:title "Before We Go" :uri "http://www.imdb.com/title/tt0443465/"}]
                  :notes [:p
                          (el/link-to "http://www.imdb.com/title/tt3986586/" "Master of None")
                          ", "
                          (el/link-to "http://www.imdb.com/title/tt4061080/" "Love")
                          ", and "
                          (el/link-to "http://www.imdb.com/title/tt3398228/" "BoJack Horseman")
                          ": Hollywood writing what it knows"
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Emerging_adulthood_and_early_adulthood" "Emerging")
                          " "
                          (el/link-to "http://www.apa.org/monitor/jun06/emerging.aspx" "Adulthood")
                          [:br]
                          (el/link-to "http://www.avclub.com/review/netflixs-fuller-house-porn-parody-without-porn-232696" "Fuller House is like a porn parody without the porn")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=fJWmbLS2_ec" "Kokomo")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Red_velvet_cake" "Red Velvet")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=FR3u0WSEcgE" "#eatlikeaking")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=UCJJ1iZuoQ4" "Dekkar")
                          " performs at "
                          (el/link-to "https://www.youtube.com/watch?v=ANNOQWby8R8" "The 4th Annual Live On Cinema Oscar Special")
                          [:br]
                          (el/link-to "http://www.imdb.com/name/nm1913734/" "The")
                          " "
                          (el/link-to "http://www.imdb.com/name/nm0544718/" "Mara")
                          " "
                          (el/link-to "https://en.wikipedia.org/wiki/Tim_Mara" "Family")
                          [:br]
                          (el/link-to "http://www.nytimes.com/2016/03/01/arts/sam-smith-the-only-openly-gay-oscar-winner-not-really.html?_r=0" "Sam Smith")
                          " the "
                          (el/link-to "https://www.youtube.com/watch?v=8jzDnsjYv9A" "Writing's on the Wall")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Neanderthal" "Neanderthals")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=eW5_ZUFaKEw" "Spit Takes")
                          [:br]
                          (el/link-to "http://gawker.com/centennials-are-the-new-millennials-are-the-new-menaces-1705468073" "Centennials")]}
                 {:date "2016/02/24"
                  :address "1808 SW Elmgrove St, Seattle, WA 98106, USA"
                  :synopsis "February 24th, 2016: Pizza plus Worms, Jem and the Holograms, and The Visit."
                  :food ["Pizza from Frelard Pizza Company"
                         "Trolli Sour Brite Crawlers Gummi Candy"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"]
                  :media [{:title "Jem and the Holograms" :uri "http://www.imdb.com/title/tt3614530/"}
                          {:title "The Visit" :uri "http://www.imdb.com/title/tt3567288/"}]
                  :notes [:p
                          (el/link-to "https://www.instagram.com/p/BCMvCdjMX6V/" "Jammers")
                          [:br]
                          (el/link-to "http://jezebel.com/how-we-failed-to-protect-kesha-1760142637?rev=1455919264571" "The Pending Emancipation of Kesha")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Found_footage_(pseudo-documentary)" "Found Footage")
                          " and "
                          (el/link-to "http://www.mediapost.com/publications/article/164602/hasbro-plays-product-placement-game.html#ixzz1hBGO1uEO" "Hasbro Product Placement")
                          [:br]
                          "The assassination of the Republican party by the coward "
                          (el/link-to "http://www.rollingstone.com/politics/news/how-america-made-donald-trump-unstoppable-20160224?page=12" "Donald Trump")]}
                 {:date "2016/02/10"
                  :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                  :synopsis "February 10th, 2016: Sausages and Hot Dogs, Jackie & Ryan, and Insurgent."
                  :food ["Sausages"
                         "Smart Dogs Vegetarian Hot Dogs"
                         "Pringles Pizza"
                         "Chips Ahoy! Chewy Oreo Creme Filled"
                         "Chips Ahoy! Chewy Chocolate Chip Cookies"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"
                              "Colin Teal"
                              "Kaia"]
                  :media [{:title "Jackie & Ryan" :uri "http://www.imdb.com/title/tt3270108/"}
                          {:title "Insurgent" :uri "http://www.imdb.com/title/tt2908446/"}]
                  :notes [:p
                          (el/link-to "http://www.nature.com/news/babylonian-astronomers-used-geometry-to-track-jupiter-1.19261" "Babylonian astronomers used geometry to track Jupiter")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Ancient_astronaut_hypothesis" "Ancient Astronauts")
                          [:br]
                          (el/link-to "http://www.newyorker.com/culture/cultural-comment/hello-again-the-weirdness-of-the-lcd-soundsystem-reunion" "LCD Soundsystem Reunion")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=nWPM1jTnuuo" "The Choice")
                          [:br]
                          (el/link-to "http://www.bbc.com/news/world-us-canada-35552820" "The Oregon Standoff")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/United_States_Postmaster_General" "The highest paid government official")
                          [:br]
                          (el/link-to "https://www.washingtonpost.com/news/federal-eye/wp/2015/08/24/millennials-working-in-government-are-at-their-lowest-levels-in-five-yearsnew-report-finds/" "Erosion of the government workforce")
                          " (which might have to do in part with "
                          (el/link-to "http://www.fbiagentedu.org/careers/fbi-special-agent/" "low pay")
                          ")"
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Chivalric_order" "Chivalric orders")
                          " and "
                          (el/link-to "https://en.wikipedia.org/wiki/The_Man_Who_Would_Be_King" "The Man Who Would Be King")
                          [:br]
                          (el/link-to "http://www.nytimes.com/2014/03/16/science/billionaires-with-big-ideas-are-privatizing-american-science.html" "Private equity supplants government")
                          " while "
                          (el/link-to "https://newrepublic.com/article/121752/trade-deals-give-corporations-power-intimidate-tiny-countries" "corporations morph into states")
                          " ("
                          (el/link-to "http://www.bloomberg.com/news/articles/2015-12-18/amazon-said-to-mull-leasing-planes-to-control-delivery-chain" "Amazon the new behemoth")
                          ")"
                          [:br]
                          (el/link-to "http://www.bloomberg.com/news/articles/2015-12-18/amazon-said-to-mull-leasing-planes-to-control-delivery-chain")
                          (el/link-to "https://en.wikipedia.org/wiki/Jeff_Bezos" "Jeff Bezos")
                          " builds a "
                          (el/link-to "http://www.10000yearclock.net" "10,000 Year Clock")]}
                 {:date "2016/02/03"
                  :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                  :synopsis "February 3rd, 2016: Jake's Birthday, War Room, and Divergent."
                  :food ["Cheese and Pepperoni Pizza from Pagliacci"
                         "Chips Ahoy! Chewy Chocolate Chip Cookies"
                         "Tillamook Chocolate Ice Cream"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"
                              "Matt Beck"
                              "Colin Teal"
                              "Kaia"]
                  :media [{:title "War Room" :uri "http://www.imdb.com/title/tt3832914/"}
                          {:title "Divergent" :uri "http://www.imdb.com/title/tt1840309/"}]
                  :notes [:p
                          (el/link-to "https://www.youtube.com/watch?v=wNNL9FIkF2E" "What if We Don't Want to Be Warm?")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=pXRviuL6vMY&feature=youtu.be" "Blurryface")
                          " and "
                          (el/link-to "https://www.youtube.com/watch?v=Y_rl4ZGdy34&feature=youtu.be" "White Privilege, II")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=XFxjy7f9RpY&feature=youtu.be" "Arden")
                          " "
                          (el/link-to "https://www.youtube.com/watch?v=1E9vj4WmHLM&feature=youtu.be" "Hayes")
                          ": "
                          (el/link-to "https://www.youtube.com/watch?v=jcOHdfbZ4Ok&feature=youtu.be" "genius")
                          [:br]
                          (el/link-to "http://www.affirmfilms.com/" "You are still watching...Blu-Ray")
                          " ("
                          (el/link-to "http://www.affirmfilms.com/resources/" "discussion guides")
                          ")"
                          [:br]
                          (el/link-to "http://www.metafilter.com/156532/freekesha" "#freekesha")
                          [:br]
                          (el/link-to "http://variety.com/2016/tv/news/joseph-fiennes-michael-jackson-casting-diversity-hollywood-whitewashing-1201690020/" "Joseph Fiennes as the King of Pop")
                          [:br]
                          (el/link-to "http://www.wired.com/2012/03/the-damning-backstory-behind-homeless-hotspots-at-sxswi/" "\"Acquiring Hobo...\"")
                          [:br]
                          (el/link-to "http://www.theverge.com/2016/1/28/10864034/windows-phone-is-dead" "Windows phone is dead")
                          [:br]
                          (el/link-to "http://www.rickyancey.com/books/the-5th-wave" "The 5th Wave, by Rick Yancey")
                          [:br]
                          (el/link-to "http://divergent.wikia.com/wiki/Abnegation" "The")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Candor" "Five")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Erudite" "Factions")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Dauntless" "of")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Amity" "Divergent")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Amusing_Ourselves_to_Death" "Amusing Ourselves to Death")
                          [:br]
                          (el/link-to "http://www.jamonexperience.com/en/" "A different kind of Beast Feast")
                          " (for Alex)"
                          [:br]
                          (el/link-to "http://www.beanogas.com/" "Possible remedy for Jason/Kaia")
                          [:br]
                          (el/link-to "https://www.google.com/webhp?sourceid=chrome-instant&ion=1&espv=2&ie=UTF-8#safe=off&q=super+bowl+commercials+2016" "87M results for \"Super Bowl Commercials 2016\"")
                          " ("
                          (el/link-to "http://www.cbsnews.com/media/9-super-bowl-commercials-already-getting-buzz/" "some tips for Greg when he finds himself around the proverbial watercooler")
                          ")"]}])

(ns chili-dog-night.data
  (:require [hiccup.element :as el]))

(def gatherings [{:date "2016/03/02"
                  :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                  :synopsis "March 2nd, 2016: Chili Dogs, Fuller House, The Intern, and Before We Go."
                  :food ["Chili Dogs"
                         "King's Hawaiian Original Sweet Dinner Rolls"
                         "Red Velvet Oreo Sandwich Cookies"
                         "Oreo Mega Stuf Chocolate Sandwich Cookies"
                         "Chips Ahoy! Original Chocolate Chip Cookies"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"
                              "Colin Teal"
                              "Kaia"]
                  :media [{:title "Fuller House" :uri "http://www.imdb.com/title/tt3986586/"}
                          {:title "The Intern" :uri "http://www.imdb.com/title/tt2361509/"}
                          {:title "Before We Go" :uri "http://www.imdb.com/title/tt0443465/"}]
                  :notes [:p
                          (el/link-to "http://www.imdb.com/title/tt4635276/" "Master of None")
                          ", "
                          (el/link-to "http://www.imdb.com/title/tt4061080/" "Love")
                          ", and "
                          (el/link-to "http://www.imdb.com/title/tt3398228/" "BoJack Horseman")
                          ": Hollywood writing what it knows"
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Emerging_adulthood_and_early_adulthood" "Emerging")
                          " "
                          (el/link-to "http://www.apa.org/monitor/jun06/emerging.aspx" "Adulthood")
                          [:br]
                          (el/link-to "http://www.avclub.com/review/netflixs-fuller-house-porn-parody-without-porn-232696" "Fuller House is like a porn parody without the porn")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=fJWmbLS2_ec" "Kokomo")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Red_velvet_cake" "Red Velvet")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=FR3u0WSEcgE" "#eatlikeaking")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=UCJJ1iZuoQ4" "Dekkar")
                          " performs at "
                          (el/link-to "https://www.youtube.com/watch?v=ANNOQWby8R8" "The 4th Annual Live On Cinema Oscar Special")
                          [:br]
                          (el/link-to "http://www.imdb.com/name/nm1913734/" "The")
                          " "
                          (el/link-to "http://www.imdb.com/name/nm0544718/" "Mara")
                          " "
                          (el/link-to "https://en.wikipedia.org/wiki/Tim_Mara" "Family")
                          [:br]
                          (el/link-to "http://www.nytimes.com/2016/03/01/arts/sam-smith-the-only-openly-gay-oscar-winner-not-really.html?_r=0" "Sam Smith")
                          " the "
                          (el/link-to "https://www.youtube.com/watch?v=8jzDnsjYv9A" "Writing's on the Wall")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Neanderthal" "Neanderthals")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=eW5_ZUFaKEw" "Spit Takes")
                          [:br]
                          (el/link-to "http://gawker.com/centennials-are-the-new-millennials-are-the-new-menaces-1705468073" "Centennials")]}
                 {:date "2016/02/24"
                  :address "1808 SW Elmgrove St, Seattle, WA 98106, USA"
                  :synopsis "February 24th, 2016: Pizza plus Worms, Jem and the Holograms, and The Visit."
                  :food ["Pizza from Frelard Pizza Company"
                         "Trolli Sour Brite Crawlers Gummi Candy"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"]
                  :media [{:title "Jem and the Holograms" :uri "http://www.imdb.com/title/tt3614530/"}
                          {:title "The Visit" :uri "http://www.imdb.com/title/tt3567288/"}]
                  :notes [:p
                          (el/link-to "https://www.instagram.com/p/BCMvCdjMX6V/" "Jammers")
                          [:br]
                          (el/link-to "http://jezebel.com/how-we-failed-to-protect-kesha-1760142637?rev=1455919264571" "The Pending Emancipation of Kesha")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Found_footage_(pseudo-documentary)" "Found Footage")
                          " and "
                          (el/link-to "http://www.mediapost.com/publications/article/164602/hasbro-plays-product-placement-game.html#ixzz1hBGO1uEO" "Hasbro Product Placement")
                          [:br]
                          "The assassination of the Republican party by the coward "
                          (el/link-to "http://www.rollingstone.com/politics/news/how-america-made-donald-trump-unstoppable-20160224?page=12" "Donald Trump")]}
                 {:date "2016/02/10"
                  :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                  :synopsis "February 10th, 2016: Sausages and Hot Dogs, Jackie & Ryan, and Insurgent."
                  :food ["Sausages"
                         "Smart Dogs Vegetarian Hot Dogs"
                         "Pringles Pizza"
                         "Chips Ahoy! Chewy Oreo Creme Filled"
                         "Chips Ahoy! Chewy Chocolate Chip Cookies"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"
                              "Colin Teal"
                              "Kaia"]
                  :media [{:title "Jackie & Ryan" :uri "http://www.imdb.com/title/tt3270108/"}
                          {:title "Insurgent" :uri "http://www.imdb.com/title/tt2908446/"}]
                  :notes [:p
                          (el/link-to "http://www.nature.com/news/babylonian-astronomers-used-geometry-to-track-jupiter-1.19261" "Babylonian astronomers used geometry to track Jupiter")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Ancient_astronaut_hypothesis" "Ancient Astronauts")
                          [:br]
                          (el/link-to "http://www.newyorker.com/culture/cultural-comment/hello-again-the-weirdness-of-the-lcd-soundsystem-reunion" "LCD Soundsystem Reunion")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=nWPM1jTnuuo" "The Choice")
                          [:br]
                          (el/link-to "http://www.bbc.com/news/world-us-canada-35552820" "The Oregon Standoff")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/United_States_Postmaster_General" "The highest paid government official")
                          [:br]
                          (el/link-to "https://www.washingtonpost.com/news/federal-eye/wp/2015/08/24/millennials-working-in-government-are-at-their-lowest-levels-in-five-yearsnew-report-finds/" "Erosion of the government workforce")
                          " (which might have to do in part with "
                          (el/link-to "http://www.fbiagentedu.org/careers/fbi-special-agent/" "low pay")
                          ")"
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Chivalric_order" "Chivalric orders")
                          " and "
                          (el/link-to "https://en.wikipedia.org/wiki/The_Man_Who_Would_Be_King" "The Man Who Would Be King")
                          [:br]
                          (el/link-to "http://www.nytimes.com/2014/03/16/science/billionaires-with-big-ideas-are-privatizing-american-science.html" "Private equity supplants government")
                          " while "
                          (el/link-to "https://newrepublic.com/article/121752/trade-deals-give-corporations-power-intimidate-tiny-countries" "corporations morph into states")
                          " ("
                          (el/link-to "http://www.bloomberg.com/news/articles/2015-12-18/amazon-said-to-mull-leasing-planes-to-control-delivery-chain" "Amazon the new behemoth")
                          ")"
                          [:br]
                          (el/link-to "http://www.bloomberg.com/news/articles/2015-12-18/amazon-said-to-mull-leasing-planes-to-control-delivery-chain")
                          (el/link-to "https://en.wikipedia.org/wiki/Jeff_Bezos" "Jeff Bezos")
                          " builds a "
                          (el/link-to "http://www.10000yearclock.net" "10,000 Year Clock")]}
                 {:date "2016/02/03"
                  :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                  :synopsis "February 3rd, 2016: Jake's Birthday, War Room, and Divergent."
                  :food ["Cheese and Pepperoni Pizza from Pagliacci"
                         "Chips Ahoy! Chewy Chocolate Chip Cookies"
                         "Tillamook Chocolate Ice Cream"]
                  :attendees ["Alex Sanchez"
                              "Greg Ryan"
                              "Jason Aumann"
                              "Jacob Dobner"
                              "Matt Beck"
                              "Colin Teal"
                              "Kaia"]
                  :media [{:title "War Room" :uri "http://www.imdb.com/title/tt3832914/"}
                          {:title "Divergent" :uri "http://www.imdb.com/title/tt1840309/"}]
                  :notes [:p
                          (el/link-to "https://www.youtube.com/watch?v=wNNL9FIkF2E" "What if We Don't Want to Be Warm?")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=pXRviuL6vMY&feature=youtu.be" "Blurryface")
                          " and "
                          (el/link-to "https://www.youtube.com/watch?v=Y_rl4ZGdy34&feature=youtu.be" "White Privilege, II")
                          [:br]
                          (el/link-to "https://www.youtube.com/watch?v=XFxjy7f9RpY&feature=youtu.be" "Arden")
                          " "
                          (el/link-to "https://www.youtube.com/watch?v=1E9vj4WmHLM&feature=youtu.be" "Hayes")
                          ": "
                          (el/link-to "https://www.youtube.com/watch?v=jcOHdfbZ4Ok&feature=youtu.be" "genius")
                          [:br]
                          (el/link-to "http://www.affirmfilms.com/" "You are still watching...Blu-Ray")
                          " ("
                          (el/link-to "http://www.affirmfilms.com/resources/" "discussion guides")
                          ")"
                          [:br]
                          (el/link-to "http://www.metafilter.com/156532/freekesha" "#freekesha")
                          [:br]
                          (el/link-to "http://variety.com/2016/tv/news/joseph-fiennes-michael-jackson-casting-diversity-hollywood-whitewashing-1201690020/" "Joseph Fiennes as the King of Pop")
                          [:br]
                          (el/link-to "http://www.wired.com/2012/03/the-damning-backstory-behind-homeless-hotspots-at-sxswi/" "\"Acquiring Hobo...\"")
                          [:br]
                          (el/link-to "http://www.theverge.com/2016/1/28/10864034/windows-phone-is-dead" "Windows phone is dead")
                          [:br]
                          (el/link-to "http://www.rickyancey.com/books/the-5th-wave" "The 5th Wave, by Rick Yancey")
                          [:br]
                          (el/link-to "http://divergent.wikia.com/wiki/Abnegation" "The")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Candor" "Five")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Erudite" "Factions")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Dauntless" "of")
                          " "
                          (el/link-to "http://divergent.wikia.com/wiki/Amity" "Divergent")
                          [:br]
                          (el/link-to "https://en.wikipedia.org/wiki/Amusing_Ourselves_to_Death" "Amusing Ourselves to Death")
                          [:br]
                          (el/link-to "http://www.jamonexperience.com/en/" "A different kind of Beast Feast")
                          " (for Alex)"
                          [:br]
                          (el/link-to "http://www.beanogas.com/" "Possible remedy for Jason/Kaia")
                          [:br]
                          (el/link-to "https://www.google.com/webhp?sourceid=chrome-instant&ion=1&espv=2&ie=UTF-8#safe=off&q=super+bowl+commercials+2016" "87M results for \"Super Bowl Commercials 2016\"")
                          " ("
                          (el/link-to "http://www.cbsnews.com/media/9-super-bowl-commercials-already-getting-buzz/" "some tips for Greg when he finds himself around the proverbial watercooler")
                          ")"]}])

Fix note link

Fix note link


(ns hyphen-keeper.export
  (:require [clojure.java
             [io :as io]
             [shell :refer [sh]]]
            [clojure.string :as string]
            [hyphen-keeper
             [db :as db]
             [hyphenate :as hyphenate]]))

(def dictionaries {0 ["/tmp/whitelist_de_DE_OLDSPELL.txt"
                      "/tmp/hyph_de_DE_OLDSPELL.dic"
                      "dicts/hyph_de_DE_OLDSPELL.dic"]
                   1 ["/tmp/whitelist_de.txt"
                      "/tmp/hyph_de_DE.dic"
                      "dicts/hyph_de_DE.dic"]})

(defn- prepare-for-libhyphen
  "Prepare a hyphenation string for consumption by libhyphen"
  [s]
  (-> s
   (string/replace #"(.)" "$18") ; place "8" between each char
   (string/replace #"^(.*)$" ".$1.") ; suround with .
   (string/replace "8-8" "9") ; give hyphens more weight
   (string/replace "8." "."))) ; drop the last 8

(defn- get-hyphenations [spelling]
  (->>
   ;; get words for given spelling from db
   (db/read-words spelling)
   ;; filter the ones that aren't hyphenated correctly
   (remove
    (fn [{:keys [word hyphenation]}]
      (= (hyphenate/hyphenate spelling word) hyphenation)))
   (map :hyphenation)
   (remove string/blank?) ; drop empty ones
   (filter #(string/includes? % "-")) ; drop hyphenations w/o a hyphen
   (map string/lower-case) ; make sure it's lowercase
   sort
   (map prepare-for-libhyphen)))

(defn- write-file [words file-name original-dict-name]
  (with-open [w (io/writer file-name :encoding "ISO-8859-1")]
    ;; insert the original dict
    (io/copy (io/reader (io/resource original-dict-name) :encoding "ISO-8859-1") w)
    (doseq [word words]
      (.write w word)
      (.newLine w))))

;; I tried to run this in parallel (simply by using (dorun (pmap))
;; instead of (doseq)) but as it turns out the jobs are so uneven,
;; i.e. the first one is very small compared to the second one, we end
;; up waiting the same time.
(defn export []
  (let [program (.getAbsolutePath (io/file (io/resource "perl/substrings.pl")))]
    (doseq [[spelling [white-list dictionary original]] dictionaries]
      (->
       spelling
       get-hyphenations
       (write-file white-list original))
      (sh program white-list dictionary))))

(ns hyphen-keeper.export
  (:require [clojure.java
             [io :as io]
             [shell :refer [sh]]]
            [clojure.string :as string]
            [hyphen-keeper
             [db :as db]
             [hyphenate :as hyphenate]]))

(def dictionaries {0 ["/tmp/whitelist_de_DE_OLDSPELL.txt"
                      "/tmp/hyph_de_DE_OLDSPELL.dic"
                      "dicts/hyph_de_DE_OLDSPELL.dic"]
                   1 ["/tmp/whitelist_de.txt"
                      "/tmp/hyph_de_DE.dic"
                      "dicts/hyph_de_DE.dic"]})

(defn- prepare-for-libhyphen
  "Prepare a hyphenation string for consumption by libhyphen"
  [s]
  (-> s
   (string/replace #"(.)" "$18") ; place "8" between each char
   (string/replace #"^(.*)$" ".$1.") ; suround with .
   (string/replace "8-8" "9") ; give hyphens more weight
   (string/replace "8." "."))) ; drop the last 8

(defn- get-hyphenations [spelling]
  (->>
   ;; get words for given spelling from db
   (db/read-words spelling)
   ;; filter the ones that aren't hyphenated correctly
   (remove
    (fn [{:keys [word hyphenation]}]
      (= (hyphenate/hyphenate spelling word) hyphenation)))
   (map :hyphenation)
   (remove string/blank?) ; drop empty ones
   (filter #(string/includes? % "-")) ; drop hyphenations w/o a hyphen
   (map string/lower-case) ; make sure it's lowercase
   sort
   (map prepare-for-libhyphen)))

(defn- write-file [words file-name original-dict-name]
  (with-open [w (io/writer file-name :encoding "ISO-8859-1")]
    ;; insert the original dict
    (io/copy (io/reader (io/resource original-dict-name) :encoding "ISO-8859-1") w)
    (doseq [word words]
      (.write w word)
      (.newLine w))))

(defn- export*
  "Export all hyphenation patterns from the database and prepare for
  libhyphen consumption, i.e. run them through substrings.pl"
  []
  (let [program (.getAbsolutePath (io/file (io/resource "perl/substrings.pl")))]
    ;; I tried to run this in parallel (simply by using (dorun (pmap))
    ;; instead of (doseq)) but as it turns out the jobs are so uneven,
    ;; i.e. the first one is very small compared to the second one, we
    ;; end up waiting the same time.
    (doseq [[spelling [white-list dictionary original]] dictionaries]
      (->
       spelling
       get-hyphenations
       (write-file white-list original))
      (sh program white-list dictionary))))

Improve some docstrings

Improve some docstrings


(ns caves-of-cljs.game
  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
  (:require [reagent.core :as r :refer [atom]]
            [clojure.set :as set]
            [cljs.core.async :as async :refer [put! chan <!]]
            [goog.dom :as dom]
            [goog.events :as events]
            [goog.events.KeyCodes]
            [goog.history.EventType :as EventType]
            [caves-of-cljs.utils :as utils]
            [caves-of-cljs.world :as world]))

;; -------------------------
;; Constants

(defonce ^:dynamic screen-size {:cols 80 :rows 24})

;; -------------------------
;; Input

(defonce *keys* (-> events/KeyCodes
                    (js->clj :keywordize-keys true)
                    (set/map-invert)))

(defn init-key-handler! [state target]
  (let [key-chan (utils/listen target (.-KEYDOWN events/EventType))]
    (go-loop []
      (when-let [event (<! key-chan)]
        (let [key-code (.. event -keyCode)
              input (get *keys* (if (<= 96 key-code 105)
                                  (- key-code 48)
                                  key-code))]
          (swap! state assoc :input input))
        (recur)))))

(defmulti process-input
  (fn [game input]
    (:kind (last (:uis game)))))

(defmethod process-input nil [game input]
  game)

(defmethod process-input :start [game input]
  (-> game
      (assoc :world (world/random-world))
      (assoc :uis [{:kind :play}])))

(defmethod process-input :win [game input]
  (if (= input :ESC)
    (assoc game :uis [])
    (assoc game :uis [{:kind :start}])))

(defmethod process-input :lose [game input]
  (if (= input :ESC)
    (assoc game :uis [])
    (assoc game :uis [{:kind :start}])))

(defmethod process-input :play [game input]
  (case input
    :ENTER     (assoc game :uis [{:kind :win}])
    :BACKSPACE (assoc game :uis [{:kind :lose}])
    :S         (assoc game :world (world/smooth-world (:world game)))
    game))

(defn handle-input [game]
  (if-let [input (:input game)]
    (-> game
        (process-input input)
        (dissoc :input))
    game))

;; -------------------------
;; Render

(defn draw-world [screen vrows vcols start-x start-y end-x end-y tiles]
  (doseq [[vrow-idx mrow-idx] (map vector
                                   (range 0 vrows)
                                   (range start-y end-y))
          :let [row-tiles (subvec (tiles mrow-idx) start-x end-x)]]
    (doseq [vcol-idx (range vcols)
            :let [{:keys [glyph color]} (row-tiles vcol-idx)]]
      (.draw screen vcol-idx vrow-idx glyph))))

(defmulti draw-ui
  (fn [ui game screen]
    (:kind ui)))

(defmethod draw-ui :start [ui game screen]
  (.drawText screen 0 0 "Welcome to the Caves of Clojure!")
  (.drawText screen 0 1 "Press anything to continue."))

(defmethod draw-ui :win [ui game screen]
  (.drawText screen 0 0 "Congratulations, you win!")
  (.drawText screen 0 1 "Press escape to exit, anything else to restart."))

(defmethod draw-ui :lose [ui game screen]
  (.drawText screen 0 0 "Sorry, better luck next time.")
  (.drawText screen 0 1 "Press escape to exit, anything else to go."))

(defmethod draw-ui :play [ui {{:keys [tiles]} :world :as game} screen]
  (let [world (:world game)
        tiles (:tiles world)
        {:keys [cols rows]} screen-size
        vcols cols
        vrows (dec rows)
        start-x 0
        start-y 0
        end-x (+ start-x vcols)
        end-y (+ start-y vrows)]
    (draw-world screen vrows vcols start-x start-y end-x end-y tiles)))

(defn draw-game [game screen]
  (.clear screen)
  (doseq [ui (:uis game)]
    (draw-ui ui game screen))
  game)

;; -------------------------
;; Main

(defn tick-game [game screen]
  (reset! game (-> @game
                   handle-input
                   (draw-game screen))))

(defn game-loop! [state screen]
  (tick-game state screen)
  (.requestAnimationFrame js/window #(game-loop! state screen)))

(defn init-game! [state screen]
  (init-key-handler! state (.getContainer screen))
  (game-loop! state screen))

(defn view [game]
  (r/create-class
   {:component-did-mount (fn [this]
                           (let [console (js/ROT.Display.
                                          #js {:width (:cols screen-size)
                                               :height (:rows screen-size)})
                                 console-dom (.getContainer console)
                                 node (.getDOMNode this)]
                             (.appendChild node console-dom)
                             (dom/setProperties console-dom #js {:tabIndex 1})
                             (init-game! game console)))
    :component-function (fn [game] [:div])}))

(ns caves-of-cljs.game
  (:require-macros [cljs.core.async.macros :refer [go go-loop]])
  (:require [reagent.core :as r :refer [atom]]
            [clojure.set :as set]
            [cljs.core.async :as async :refer [put! chan <!]]
            [goog.dom :as dom]
            [goog.events :as events]
            [goog.events.KeyCodes]
            [goog.history.EventType :as EventType]
            [caves-of-cljs.utils :as utils]
            [caves-of-cljs.world :as world]))

;; -------------------------
;; Constants

(defonce ^:dynamic screen-size {:cols 80 :rows 24})

;; -------------------------
;; Input

(defonce *keys* (-> events/KeyCodes
                    (js->clj :keywordize-keys true)
                    (set/map-invert)))

(defn init-key-handler! [state target]
  (let [key-chan (utils/listen target (.-KEYDOWN events/EventType))]
    (go-loop []
      (when-let [event (<! key-chan)]
        (let [key-code (.. event -keyCode)
              input (get *keys* (if (<= 96 key-code 105)
                                  (- key-code 48)
                                  key-code))]
          (swap! state assoc :input input))
        (recur)))))

(defmulti process-input
  (fn [game input]
    (:kind (last (:uis game)))))

(defmethod process-input nil [game input]
  game)

(defmethod process-input :start [game input]
  (-> game
      (assoc :world (world/random-world))
      (assoc :uis [{:kind :play}])))

(defmethod process-input :win [game input]
  (if (= input :ESC)
    (assoc game :uis [])
    (assoc game :uis [{:kind :start}])))

(defmethod process-input :lose [game input]
  (if (= input :ESC)
    (assoc game :uis [])
    (assoc game :uis [{:kind :start}])))

(defmethod process-input :play [game input]
  (case input
    :ENTER     (assoc game :uis [{:kind :win}])
    :BACKSPACE (assoc game :uis [{:kind :lose}])
    :S         (assoc game :world (world/smooth-world (:world game)))
    game))

(defn handle-input [game]
  (if-let [input (:input game)]
    (-> game
        (process-input input)
        (dissoc :input))
    game))

;; -------------------------
;; Render

(defn draw-world [screen vrows vcols start-x start-y end-x end-y tiles]
  (doseq [[vrow-idx mrow-idx] (map vector
                                   (range 0 vrows)
                                   (range start-y end-y))
          :let [row-tiles (subvec (tiles mrow-idx) start-x end-x)]]
    (doseq [vcol-idx (range vcols)
            :let [{:keys [glyph color]} (row-tiles vcol-idx)]]
      (.draw screen vcol-idx vrow-idx glyph))))

(defn draw-crosshairs [screen vcols vrows]
  (let [crosshair-x (int (/ vcols 2))
        crosshair-y (int (/ vrows 2))]
    (.drawText screen crosshair-x crosshair-y "%c{red}X")))

(defn get-viewport-coords [game vcols vrows]
  (let [start-x 0
        start-y 0
        end-x (+ start-x vcols)
        end-y (+ start-y vrows)]
    [start-x start-y end-x end-y]))

(defmulti draw-ui
  (fn [ui game screen]
    (:kind ui)))

(defmethod draw-ui :start [ui game screen]
  (.drawText screen 0 0 "Welcome to the Caves of Clojure!")
  (.drawText screen 0 1 "Press anything to continue."))

(defmethod draw-ui :win [ui game screen]
  (.drawText screen 0 0 "Congratulations, you win!")
  (.drawText screen 0 1 "Press escape to exit, anything else to restart."))

(defmethod draw-ui :lose [ui game screen]
  (.drawText screen 0 0 "Sorry, better luck next time.")
  (.drawText screen 0 1 "Press escape to exit, anything else to go."))

(defmethod draw-ui :play [ui {{:keys [tiles]} :world :as game} screen]
  (let [world (:world game)
        tiles (:tiles world)
        {:keys [cols rows]} screen-size
        vcols cols
        vrows (dec rows)
        [start-x start-y end-x end-y] (get-viewport-coords game vcols vrows)]
    (draw-world screen vrows vcols start-x start-y end-x end-y tiles)
    (draw-crosshairs screen vcols vrows)))

(defn draw-game [game screen]
  (.clear screen)
  (doseq [ui (:uis game)]
    (draw-ui ui game screen))
  game)

;; -------------------------
;; Main

(defn tick-game [game screen]
  (reset! game (-> @game
                   handle-input
                   (draw-game screen))))

(defn game-loop! [state screen]
  (tick-game state screen)
  (.requestAnimationFrame js/window #(game-loop! state screen)))

(defn init-game! [state screen]
  (init-key-handler! state (.getContainer screen))
  (game-loop! state screen))

(defn view [game]
  (r/create-class
   {:component-did-mount (fn [this]
                           (let [console (js/ROT.Display.
                                          #js {:width (:cols screen-size)
                                               :height (:rows screen-size)})
                                 console-dom (.getContainer console)
                                 node (.getDOMNode this)]
                             (.appendChild node console-dom)
                             (dom/setProperties console-dom #js {:tabIndex 1})
                             (init-game! game console)))
    :component-function (fn [game] [:div])}))

Add crosshair drawing

Add crosshair drawing


(ns nightcode.window
  (:require [nightcode.cli-args :as cli-args]
            [nightcode.dialogs :as dialogs]
            [nightcode.editors :as editors]
            [nightcode.shortcuts :as shortcuts]
            [nightcode.ui :as ui]
            [seesaw.core :as s])
  (:import [java.awt Window]
           [java.awt.event WindowAdapter]
           [java.lang.reflect InvocationHandler Proxy]
           [org.pushingpixels.substance.api SubstanceLookAndFeel]
           [org.pushingpixels.substance.api.skin GraphiteSkin]))

(defn set-theme!
  "Sets the theme based on the command line arguments."
  [args]
  (s/native!)
  (let [{:keys [shade skin-object theme-resource]} (cli-args/parse-args args)]
    (when theme-resource (reset! editors/theme-resource theme-resource))
    (SubstanceLookAndFeel/setSkin (or skin-object (GraphiteSkin.)))))

(defn confirm-exit-app!
  "Displays a dialog confirming whether the program should shut down."
  []
  (let [unsaved-paths (->> (keys @editors/editors)
                           (filter editors/is-unsaved?)
                           doall)]
    (if (dialogs/show-shut-down-dialog! unsaved-paths)
      (System/exit 0)
      true)))

(defn enable-full-screen!
  "Enables full screen mode on OS X."
  [window]
  (some-> (try (Class/forName "com.apple.eawt.FullScreenUtilities")
            (catch Exception _))
          (.getMethod "setWindowCanFullScreen"
            (into-array Class [Window Boolean/TYPE]))
          (.invoke nil (object-array [window true]))))

(defn add-listener!
  "Sets callbacks for window events."
  [window]
  ; make sure the window listener is called on OS X
  (when-let [quit-class (try (Class/forName "com.apple.eawt.QuitHandler")
                          (catch Exception _))]
    (some-> (try (Class/forName "com.apple.eawt.Application")
              (catch Exception _))
            (.getMethod "getApplication" (into-array Class []))
            (.invoke nil (object-array []))
            (.setQuitHandler
              (Proxy/newProxyInstance (.getClassLoader quit-class)
                                      (into-array Class [quit-class])
                                      (reify InvocationHandler
                                        (invoke [this proxy method args]
                                          (confirm-exit-app!)))))))
  ; create and add the listener
  (.addWindowListener window
    (proxy [WindowAdapter] []
      (windowActivated [e]
        (ui/update-project-tree!)
        (shortcuts/toggle-hints! @ui/root false))
      (windowClosing [e]
        (confirm-exit-app!)))))

(ns nightcode.window
  (:require [nightcode.cli-args :as cli-args]
            [nightcode.dialogs :as dialogs]
            [nightcode.editors :as editors]
            [nightcode.shortcuts :as shortcuts]
            [nightcode.ui :as ui]
            [seesaw.core :as s])
  (:import [java.awt Window]
           [java.awt.event WindowAdapter]
           [java.lang.reflect InvocationHandler Proxy]
           [org.pushingpixels.substance.api SubstanceLookAndFeel]
           [org.pushingpixels.substance.api.skin GraphiteSkin]))

(defn set-theme!
  "Sets the theme based on the command line arguments."
  [args]
  (s/native!)
  (let [{:keys [shade skin-object theme-resource]} (cli-args/parse-args args)]
    (when theme-resource (reset! editors/theme-resource theme-resource))
    (SubstanceLookAndFeel/setSkin (or skin-object (GraphiteSkin.)))))

(defn confirm-exit-app!
  "Displays a dialog confirming whether the program should shut down."
  []
  (let [unsaved-paths (->> (keys @editors/editors)
                           (filter editors/is-unsaved?)
                           doall)]
    (if (dialogs/show-shut-down-dialog! unsaved-paths)
      (System/exit 0)
      true)))

(defn enable-full-screen!
  "Enables full screen mode on OS X."
  [window]
  (some-> (try (Class/forName "com.apple.eawt.FullScreenUtilities")
            (catch Exception _))
          (.getMethod "setWindowCanFullScreen"
            (into-array Class [Window Boolean/TYPE]))
          (.invoke nil (object-array [window true]))))

(defn add-listener!
  "Sets callbacks for window events."
  [window]
  ; make sure the window listener is called on OS X
  (when-let [quit-class (try (Class/forName "com.apple.eawt.QuitHandler")
                          (catch Exception _))]
    (some-> (try (Class/forName "com.apple.eawt.Application")
              (catch Exception _))
            (.getMethod "getApplication" (into-array Class []))
            (.invoke nil (object-array []))
            (.setQuitHandler
              (Proxy/newProxyInstance (.getClassLoader quit-class)
                                      (into-array Class [quit-class])
                                      (reify InvocationHandler
                                        (invoke [this proxy method args]
                                          (confirm-exit-app!)))))))
  ; create and add the listener
  (.addWindowListener window
    (proxy [WindowAdapter] []
      (windowActivated [e]
        (shortcuts/toggle-hints! @ui/root false)
        (ui/update-project-tree!))
      (windowClosing [e]
        (confirm-exit-app!)))))

Change function order to improve refresh behavior


(ns theatralia.thomsky
  (:require [datascript :as d]
            datascript.core
            [cljs-uuid-utils.core :as uuid]
            [re-frame.core :as rf]
            [re-frame.handlers :as handlers]
            [re-frame.middleware :as middleware]
            [plumbing.core :refer [safe-get]]
            [reagent.core :as reagent]))

(defn- single-valued?
  "See http://docs.datomic.com/query.html#find-specifications and
  http://docs.datomic.com/query.html#query."
  [query]
  (let [find-part (if (map? query)
                    (safe-get query :find)
                    (do
                      (assert (= :find (first query)))
                      (take-while #(not (keyword %)) (rest query))))]
    (or (and (vector? find-part)           ; single tuple
             (not= '... (last find-part)))
        (= '. (last find-part)))))         ; single scalar

(defn set-up-datascript!
  "Swaps in a Datascript database with schema ?SCHEMA (default: Datascript
  default schema) for the APP-DB in re-frame. To be used as an event handler."
  ([app-db [_ & [?schema]]]
   (let [conn (d/create-conn (or ?schema datascript.core/default-schema))]
     (reset! app-db @conn)
     (reset-meta! app-db (meta conn)))))

;;; Credits:
;;;  - https://gist.github.com/allgress/11348685, see here for a bit more
;;;    discussion:
;;;    https://groups.google.com/d/topic/clojurescript/o0W57ptvPc8/discussion
;;;  - https://github.com/Day8/re-frame/blob/master/src/re_frame/middleware.cljs
;;;  - https://github.com/Day8/re-frame/blob/master/src/re_frame/core.cljs

;; Note:
;;
;; If the application is getting slow, your first step towards a diagnosis
;; should be to uncomment the line below and watch in the console when and how
;; often bind is called. – If it only gets cold as many times as there are binds
;; in the code and only on application load, your problem lies something else.
;; If it gets called more often than that and while the application runs (for
;; example, when you click or type), there are two likely causes:
;;
;;  - You've wrapped a call to bind in a reagent.ratom/reaction. In this case
;;    bind gets called whenever the app-db changes, which is not what you want.
;;
;;  - You've used a Form-1 component where you should use a Form-2 component.
;;    See https://github.com/Day8/re-frame/wiki/Creating-Reagent-Components.
;;
;; If it wasn't repeated bind calls, you might want to filter out scratch
;; changes. At tag filter-scratch you can find a change that introduced that,
;; but wasn't needed at the time.
(defn bind
  "Returns a ratom containing the result of query Q on the value of the database
  behind CONN with the arguments Q-ARGS."
  [q conn & q-args]
  ;(println "bind called" q) ; Commented out on purpose. – See note above.
  (let [k (uuid/make-random-uuid)
        state (reagent/atom nil)
        res (apply d/q q @conn q-args)]
    (reset! state res)
    (d/listen!
      conn
      k
      (fn [tx-report]
        (let [novelty (apply d/q q (:tx-data tx-report) q-args)]
          ;; Only update if query results actually changed.
          (when (not-empty novelty)
            (reset! state (apply d/q q (:db-after tx-report) q-args))))))
    (set! (.-__key state) k)
    state))

(defn unbind
  "Stops updates on ratom STATE from changes in CONN."
  [conn state]
  (d/unlisten! conn (.-__key state)))

(defn pure-datascript
  "Adaptation of the re-frame middleware 'pure' for Thomsky.

  The HANDLER wrapped with this middleware will receive the current value behind
  CONN and has to return a Datascript transaction data structure that will be
  transact!ed over CONN.

  So, as opposed to re-frame's 'pure', where the HANDLER has to return a whole
  new app state, here the HANDLER only returns transaction data that will be
  used to change the app state."
  [handler]
  (fn pure-datascript-handler [conn event-vec]
    (assert (satisfies? cljs.core/IAtom conn)
            (str "conn has to be an atom. Got: " conn))
    (let [db @conn
          _ (assert (satisfies? datascript.core.IDB db)
                    (str "@conn has to be a Datascript Database. Got: " db))
          txd (handler db event-vec)]
      (assert (sequential? txd)
              (str "Handler has to return sequence of transaction data."
                   "Got: " txd))
      (d/transact! conn txd))))

(defn register-handler
  "Handler registration procedure that provides the right defaults for Theatralia.

  In re-frame, the default handler registration procedure applies only the
  'pure' middleware to a handler. Here we apply the respective 'pure-datascript'
  middleware as well as the 'trim-v' middleware, since we never need this silly
  keyword in our subscription handlers anyway."
  ([id handler] (register-handler id [] handler))
  ([id middleware handler]
   (handlers/register-base id
                           [pure-datascript middleware/trim-v middleware]
                           handler)))

(ns theatralia.thomsky
  (:require [datascript :as d]
            datascript.core
            [cljs-uuid-utils.core :as uuid]
            [re-frame.core :as rf]
            [re-frame.handlers :as handlers]
            [re-frame.middleware :as middleware]
            [plumbing.core :refer [safe-get]]
            [reagent.core :as reagent]))

(defn- single-valued?
  "See http://docs.datomic.com/query.html#find-specifications and
  http://docs.datomic.com/query.html#query."
  [query]
  (let [find-part (if (map? query)
                    (safe-get query :find)
                    (do
                      (assert (= :find (first query)))
                      (take-while #(not (keyword? %)) (rest query))))]
    (or (and (vector? (first find-part))   ; single tuple
             (not= '... (last (first find-part))))
        (= '. (last find-part)))))         ; single scalar

(defn set-up-datascript!
  "Swaps in a Datascript database with schema ?SCHEMA (default: Datascript
  default schema) for the APP-DB in re-frame. To be used as an event handler."
  ([app-db [_ & [?schema]]]
   (let [conn (d/create-conn (or ?schema datascript.core/default-schema))]
     (reset! app-db @conn)
     (reset-meta! app-db (meta conn)))))

;;; Credits:
;;;  - https://gist.github.com/allgress/11348685, see here for a bit more
;;;    discussion:
;;;    https://groups.google.com/d/topic/clojurescript/o0W57ptvPc8/discussion
;;;  - https://github.com/Day8/re-frame/blob/master/src/re_frame/middleware.cljs
;;;  - https://github.com/Day8/re-frame/blob/master/src/re_frame/core.cljs

;; Note:
;;
;; If the application is getting slow, your first step towards a diagnosis
;; should be to uncomment the line below and watch in the console when and how
;; often bind is called. – If it only gets cold as many times as there are binds
;; in the code and only on application load, your problem lies something else.
;; If it gets called more often than that and while the application runs (for
;; example, when you click or type), there are two likely causes:
;;
;;  - You've wrapped a call to bind in a reagent.ratom/reaction. In this case
;;    bind gets called whenever the app-db changes, which is not what you want.
;;
;;  - You've used a Form-1 component where you should use a Form-2 component.
;;    See https://github.com/Day8/re-frame/wiki/Creating-Reagent-Components.
;;
;; If it wasn't repeated bind calls, you might want to filter out scratch
;; changes. At tag filter-scratch you can find a change that introduced that,
;; but wasn't needed at the time.
(defn bind
  "Returns a ratom containing the result of query Q on the value of the database
  behind CONN with the arguments Q-ARGS."
  [q conn & q-args]
  ;(println "bind called" q) ; Commented out on purpose. – See note above.
  (let [k (uuid/make-random-uuid)
        state (reagent/atom nil)
        res (apply d/q q @conn q-args)]
    (reset! state res)
    (d/listen!
      conn
      k
      (fn [tx-report]
        (let [novelty (apply d/q q (:tx-data tx-report) q-args)]
          ;; Only update if query results actually changed.
          (when (not-empty novelty)
            (reset! state (apply d/q q (:db-after tx-report) q-args))))))
    (set! (.-__key state) k)
    state))

(defn unbind
  "Stops updates on ratom STATE from changes in CONN."
  [conn state]
  (d/unlisten! conn (.-__key state)))

(defn pure-datascript
  "Adaptation of the re-frame middleware 'pure' for Thomsky.

  The HANDLER wrapped with this middleware will receive the current value behind
  CONN and has to return a Datascript transaction data structure that will be
  transact!ed over CONN.

  So, as opposed to re-frame's 'pure', where the HANDLER has to return a whole
  new app state, here the HANDLER only returns transaction data that will be
  used to change the app state."
  [handler]
  (fn pure-datascript-handler [conn event-vec]
    (assert (satisfies? cljs.core/IAtom conn)
            (str "conn has to be an atom. Got: " conn))
    (let [db @conn
          _ (assert (satisfies? datascript.core.IDB db)
                    (str "@conn has to be a Datascript Database. Got: " db))
          txd (handler db event-vec)]
      (assert (sequential? txd)
              (str "Handler has to return sequence of transaction data."
                   "Got: " txd))
      (d/transact! conn txd))))

(defn register-handler
  "Handler registration procedure that provides the right defaults for Theatralia.

  In re-frame, the default handler registration procedure applies only the
  'pure' middleware to a handler. Here we apply the respective 'pure-datascript'
  middleware as well as the 'trim-v' middleware, since we never need this silly
  keyword in our subscription handlers anyway."
  ([id handler] (register-handler id [] handler))
  ([id middleware handler]
   (handlers/register-base id
                           [pure-datascript middleware/trim-v middleware]
                           handler)))

Correct single-valued?

thomsky: Correct single-valued?

My tests actually uncovered bugs! Fix them.


(ns com.wsscode.pathom.book.interactive-parser
  (:require [clojure.reader :refer [read-string]]
            [cljs.pprint]
            [cljs.spec.alpha :as s]
            [com.wsscode.pathom.core :as p]
            [com.wsscode.pathom.book.app-types :as app-types]
            [com.wsscode.pathom.book.async.intro]
            [com.wsscode.pathom.book.async.error-propagation]
            [com.wsscode.pathom.book.async.js-promises]
            [com.wsscode.pathom.book.connect.getting-started]
            [com.wsscode.pathom.book.connect.getting-started2]
            [com.wsscode.pathom.book.connect.batch]
            [com.wsscode.pathom.book.connect.batch2]
            [com.wsscode.pathom.book.connect.mutations]
            [com.wsscode.pathom.book.connect.mutation-join]
            [com.wsscode.pathom.book.connect.mutation-join-globals]
            [com.wsscode.pathom.book.connect.mutation-async]
            [com.wsscode.pathom.book.ui.codemirror :as cm]
            [com.wsscode.pathom.fulcro.network :as network]
            [com.wsscode.pathom.specs.query :as s.query]
            [fulcro.client :as fulcro]
            [fulcro.client.localized-dom :as dom]
            [fulcro.client.data-fetch :as df]
            [fulcro.client.mutations :as fm]
            [fulcro.client.primitives :as fp]
            [clojure.string :as str]))

(s/def ::parser ::p/parser)
(s/def ::env ::p/env)

(def parsers
  {"async.intro"                   {::parser com.wsscode.pathom.book.async.intro/parser}
   "async.error-propagation"       {::parser com.wsscode.pathom.book.async.error-propagation/parser}
   "async.js-promises"             {::parser com.wsscode.pathom.book.async.js-promises/parser}
   "connect.batch"                 {::parser com.wsscode.pathom.book.connect.batch/parser}
   "connect.batch2"                {::parser com.wsscode.pathom.book.connect.batch2/parser}
   "connect.getting-started"       {::parser com.wsscode.pathom.book.connect.getting-started/parser
                                    ::ns     "com.wsscode.pathom.book.connect.getting-started"}
   "connect.getting-started2"      {::parser com.wsscode.pathom.book.connect.getting-started2/parser
                                    ::ns     "com.wsscode.pathom.book.connect.getting-started2"}
   "connect.mutations"             {::parser com.wsscode.pathom.book.connect.mutations/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutations"}
   "connect.mutation-join"         {::parser com.wsscode.pathom.book.connect.mutation-join/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutation-join"}
   "connect.mutation-join-globals" {::parser com.wsscode.pathom.book.connect.mutation-join-globals/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutation-join-globals"}
   "connect.mutation-async"        {::parser com.wsscode.pathom.book.connect.mutation-async/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutation-async"}})

(defn safe-read [s]
  (try
    (read-string s)
    (catch :default _ nil)))

(defn load-parser-result [c query]
  (fp/transact! c [(list 'fulcro/load {:target [::id "singleton" ::parser-result]
                                       :marker :loading
                                       :query  [{::parser-result query}]})]))

(defn expand-keywords [s ns]
  (if ns
    (str/replace s #"::(\w+)" (str ":" ns "/$1"))
    s))

(defn compact-keywords [s ns]
  (if ns
    (str/replace s (js/RegExp (str ":" ns "\\/")) "::")
    s))

(fp/defsc InteractiveParser
  [this {:keys [::s.query/query ::parser-result ::ns] :as props}]
  {:initial-state (fn [initial-query]
                    {::s.query/query (or initial-query "[]")
                     ::parser-result {}
                     ::ns            "user"})
   :ident         (fn [] [::id "singleton"])
   :query         [::id ::s.query/query ::parser-result ::ns [df/marker-table :loading]]}
  (let [marker    (get props [df/marker-table :loading])
        query-exp (safe-read (expand-keywords query ns))]
    (dom/div
      (cm/clojure {:value       query
                   :onChange    #(fm/set-value! this ::s.query/query %)
                   ::cm/options {::cm/extraKeys
                                 {"Cmd-Enter"  #(load-parser-result this (-> this fp/props ::s.query/query (expand-keywords ns) safe-read))
                                  "Ctrl-Enter" #(load-parser-result this (-> this fp/props ::s.query/query (expand-keywords ns) safe-read))}}})
      (if (df/loading? marker)
        (dom/button {:disabled "true"} "Running...")
        (dom/button {:disabled (not query-exp)
                     :style    (if query-exp {} {:color "#c00"})
                     :onClick  #(load-parser-result this query-exp)}
          "Parse"))
      (cm/clojure {:value        (or (-> parser-result
                                         (cljs.pprint/pprint)
                                         (with-out-str)
                                         (compact-keywords ns))
                                     "")
                   ::cm/readOnly true}))))

(def reader
  {::parser-result
   (fn [{::keys [parser env] :keys [query]}]
     (parser (or env {}) query))})

(def parser (p/async-parser {}))
(def env {::p/reader reader})

(app-types/register-app "interactive-parser"
  (fn [{:keys [::app-types/node]}]
    (let [parser-name   (.getAttribute node "data-parser")
          initial-query (.-innerText node)]
      (let [iparser (get parsers parser-name)]
        (assert iparser (str "parser " parser-name " not foud"))
        {::app-types/app  (fulcro/new-fulcro-client
                            :initial-state {:ui/root (-> (fp/get-initial-state InteractiveParser initial-query)
                                                         (assoc ::ns (::ns iparser)))}
                            :networking {:remote (network/pathom-remote #(parser (merge env iparser) %2))})
         ::app-types/root (app-types/make-root InteractiveParser (str "interactive-parser-" parser-name))}))))

(ns com.wsscode.pathom.book.interactive-parser
  (:require [com.wsscode.common.async-cljs :refer [go-catch <?]]
            [com.wsscode.pathom.book.app-types :as app-types]
            [com.wsscode.pathom.book.async.intro]
            [com.wsscode.pathom.book.async.error-propagation]
            [com.wsscode.pathom.book.async.js-promises]
            [com.wsscode.pathom.book.connect.getting-started]
            [com.wsscode.pathom.book.connect.getting-started2]
            [com.wsscode.pathom.book.connect.batch]
            [com.wsscode.pathom.book.connect.batch2]
            [com.wsscode.pathom.book.connect.mutations]
            [com.wsscode.pathom.book.connect.mutation-join]
            [com.wsscode.pathom.book.connect.mutation-join-globals]
            [com.wsscode.pathom.book.connect.mutation-async]
            [com.wsscode.pathom.fulcro.network :as network]
            [com.wsscode.pathom.viz.query-editor :as pv.query-editor]
            [fulcro.client :as fulcro]
            [fulcro.client.localized-dom :as dom]
            [fulcro.client.primitives :as fp]
            [clojure.string :as str]))

(def parsers
  {"async.intro"                   {::parser com.wsscode.pathom.book.async.intro/parser}
   "async.error-propagation"       {::parser com.wsscode.pathom.book.async.error-propagation/parser}
   "async.js-promises"             {::parser com.wsscode.pathom.book.async.js-promises/parser}
   "connect.batch"                 {::parser com.wsscode.pathom.book.connect.batch/parser}
   "connect.batch2"                {::parser com.wsscode.pathom.book.connect.batch2/parser}
   "connect.getting-started"       {::parser com.wsscode.pathom.book.connect.getting-started/parser
                                    ::ns     "com.wsscode.pathom.book.connect.getting-started"}
   "connect.getting-started2"      {::parser com.wsscode.pathom.book.connect.getting-started2/parser
                                    ::ns     "com.wsscode.pathom.book.connect.getting-started2"}
   "connect.mutations"             {::parser com.wsscode.pathom.book.connect.mutations/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutations"}
   "connect.mutation-join"         {::parser com.wsscode.pathom.book.connect.mutation-join/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutation-join"}
   "connect.mutation-join-globals" {::parser com.wsscode.pathom.book.connect.mutation-join-globals/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutation-join-globals"}
   "connect.mutation-async"        {::parser com.wsscode.pathom.book.connect.mutation-async/parser
                                    ::ns     "com.wsscode.pathom.book.connect.mutation-async"}})

(defn expand-keywords [s ns]
  (if ns
    (str/replace s #"::(\w+)" (str ":" ns "/$1"))
    s))

(defn compact-keywords [s ns]
  (if ns
    (str/replace s (js/RegExp (str ":" ns "\\/")) "::")
    s))

(fp/defsc QueryEditorWrapper
  [this {:ui/keys [root]}]
  {:initial-state (fn [query]
                    {:ui/root (-> (fp/get-initial-state pv.query-editor/QueryEditor {})
                                  (assoc ::pv.query-editor/query query))})
   :query         [{:ui/root (fp/get-query pv.query-editor/QueryEditor)}]
   :css           [[:.container {:height  "500px"
                                 :display "flex"}]]
   :css-include   [pv.query-editor/QueryEditor]}
  (dom/div :.container
    (pv.query-editor/query-editor root {::pv.query-editor/default-trace-size 200})))

(def query-editor-wrapper (fp/factory QueryEditorWrapper {:keyfn ::id}))

(app-types/register-app "interactive-parser"
  (fn [{::app-types/keys [node]}]
    (let [parser-name   (.getAttribute node "data-parser")
          initial-query (.-innerText node)]
      (let [{::keys [parser ns] :as iparser} (get parsers parser-name)]
        (assert iparser (str "parser " parser-name " not foud"))
        {::app-types/app
         (fulcro/new-fulcro-client
           :initial-state (-> (fp/get-initial-state QueryEditorWrapper initial-query)
                              (assoc :fulcro.inspect.core/app-id (str "query-editor-" parser-name)))

           :networking {pv.query-editor/remote-key
                        (network/pathom-remote
                          (pv.query-editor/client-card-parser parser
                            {::pv.query-editor/wrap-run-query
                             (fn [run-query]
                               (fn [env input]
                                 (go-catch
                                   (-> (run-query env (update input ::pv.query-editor/query #(expand-keywords % ns))) <?
                                       (update ::pv.query-editor/result #(compact-keywords % ns))))))}))})

         ::app-types/root
         QueryEditorWrapper}))))

Use pathom viz query editor for the interactive parser