(ns nightmod.repl
  (:require [nightcode.editors :as editors]
            [nightcode.ui :as ui]
            [nightcode.utils :as nc-utils]
            [nightmod.utils :as u]
            [seesaw.core :as s]))

(defn redirect-io
  [[in out] func]
  (binding [*out* out
            *err* out
            *in* in]
    (func)))

(defn start-thread!*
  [in-out func]
  (->> (fn []
         (try (func)
           (catch Exception e (some-> (.getMessage e) println))
           (finally (println "\n===" (nc-utils/get-string :finished) "==="))))
       (redirect-io in-out)
       (fn [])
       Thread.
       .start))

(defmacro start-thread!
  [in-out & body]
  `(start-thread!* ~in-out (fn [] ~@body)))

(defn run-repl!
  [in-out]
  (start-thread! in-out (clojure.main/repl :init #(in-ns u/game-ns)
                                           :print clojure.pprint/pprint)))

(def ^:dynamic *widgets* [:restart])

(defn create-widgets
  [actions]
  {:restart (ui/button :id :restart
                       :text (nc-utils/get-string :restart)
                       :listen [:action (:restart actions)])})

(defn create-card
  []
  (let [console (editors/create-console u/repl-name)
        run! (fn [& _]
               (run-repl! (ui/get-io! console))
               (s/request-focus! (.getTextArea console)))
        actions {:restart run!}
        widgets (create-widgets actions)
        widget-bar (ui/wrap-panel :items (map #(get widgets % %) *widgets*))]
    (doto (.getTextArea console)
      (s/config! :id :repl-console)
      (nc-utils/set-accessible-name! :repl-console))
    (run!)
    (s/border-panel :north widget-bar :center console)))

(ns nightmod.repl
  (:require [nightcode.editors :as editors]
            [nightcode.ui :as ui]
            [nightcode.utils :as nc-utils]
            [nightmod.utils :as u]
            [seesaw.core :as s]))

(defn redirect-io
  [[in out] func]
  (binding [*out* out
            *err* out
            *in* in]
    (func)))

(defn start-thread!*
  [in-out func]
  (->> (fn []
         (try (func)
           (catch Exception e (some-> (.getMessage e) println))
           (finally (println "\n===" (nc-utils/get-string :finished) "==="))))
       (redirect-io in-out)
       (fn [])
       Thread.
       .start))

(defmacro start-thread!
  [in-out & body]
  `(start-thread!* ~in-out (fn [] ~@body)))

(defn run-repl!
  [in-out]
  (start-thread! in-out (clojure.main/repl :init #(in-ns u/game-ns)
                                           :print clojure.pprint/pprint)))

(def ^:dynamic *widgets* [:restart])

(defn create-widgets
  [actions]
  {:restart (ui/button :id :restart
                       :text (nc-utils/get-string :restart)
                       :listen [:action (:restart actions)])})

(defn create-card
  []
  (let [console (editors/create-console u/repl-name)
        run! (fn [& _]
               (.setText (.getTextArea console) "")
               (run-repl! (ui/get-io! console))
               (s/request-focus! (.getTextArea console)))
        actions {:restart run!}
        widgets (create-widgets actions)
        widget-bar (ui/wrap-panel :items (map #(get widgets % %) *widgets*))]
    (doto (.getTextArea console)
      (s/config! :id :repl-console)
      (nc-utils/set-accessible-name! :repl-console))
    (run!)
    (s/border-panel :north widget-bar :center console)))

Clear REPL text when restarting

Clear REPL text when restarting


(ns bakyeono.litedocx.unit
  "Thinchgs for unit conversion."
  (:require [clojure.string :as str])
  (:use [bakyeono.litedocx.util])
  (:gen-class))

;;; Length units
;;; Base conversion
(defconst cm-per-inch 2.54)
(defconst inch-per-emu 1/914400)
(defconst mm-per-cm 10)
(defconst pt-per-dxa 1/20)
(defconst pt-per-px 3/4)
(defconst px-per-inch 96)

;;; Reversion
(defconst inch-per-cm (/ 1 cm-per-inch))
(defconst emu-per-inch (/ inch-per-emu))
(defconst cm-per-mm (/ 1 mm-per-cm))
(defconst dxa-per-pt (/ pt-per-dxa))
(defconst px-per-pt (/ 1 pt-per-px))
(defconst inch-per-px (/ 1 px-per-inch))

;;; Combination
(defconst cm-per-emu (* cm-per-inch inch-per-emu))
(defconst cm-per-px (* cm-per-inch inch-per-px))
(defconst cm-per-pt (* cm-per-px px-per-pt))
(defconst cm-per-dxa (* cm-per-pt pt-per-dxa))
(defconst inch-per-mm (* inch-per-cm cm-per-mm))
(defconst inch-per-pt (* inch-per-px px-per-pt))
(defconst inch-per-dxa (* inch-per-pt pt-per-dxa))
(defconst mm-per-inch (* mm-per-cm cm-per-inch))
(defconst mm-per-emu (* mm-per-inch inch-per-emu))
(defconst mm-per-px (* mm-per-inch inch-per-px))
(defconst mm-per-pt (* mm-per-px px-per-pt))
(defconst mm-per-dxa (* mm-per-pt pt-per-dxa))
(defconst pt-per-inch (* pt-per-px px-per-inch))
(defconst pt-per-emu (* pt-per-inch inch-per-emu))
(defconst pt-per-cm (* pt-per-inch inch-per-cm))
(defconst pt-per-mm (* pt-per-cm cm-per-mm))
(defconst dxa-per-px (* dxa-per-pt pt-per-px))
(defconst dxa-per-inch (* dxa-per-px px-per-inch))
(defconst dxa-per-emu (* dxa-per-inch inch-per-emu))
(defconst dxa-per-cm (* dxa-per-inch inch-per-cm))
(defconst dxa-per-mm (* dxa-per-cm cm-per-mm))
(defconst px-per-emu (* px-per-inch inch-per-emu))
(defconst px-per-cm (* px-per-inch inch-per-cm))
(defconst px-per-mm (* px-per-cm cm-per-mm))
(defconst px-per-dxa (* px-per-pt pt-per-dxa))
(defconst emu-per-cm (* emu-per-inch inch-per-cm))
(defconst emu-per-mm (* emu-per-cm cm-per-mm))
(defconst emu-per-px (* emu-per-inch inch-per-px))
(defconst emu-per-pt (* emu-per-px px-per-pt))
(defconst emu-per-dxa (* emu-per-pt pt-per-dxa))

;;; Functions
(defn parse-unit
  "Takes a string expression of a number and returns it as a [number unit]
  vector."
  [s]
  (let [s (str/trim s)
        n (Double/parseDouble (re-find #"^-?\d+\.?\d*" s))
        unit (re-find #"[a-z]+$" s)]
    [n unit]))

(defn conversion-rate
  "Returns conversion rate for 'from' unit -> 'to' unit."
  [from to]
  (let [sym (symbol (str "bakyeono.litedocx.unit/" to "-per-" from))]
    (cond (resolve sym) (eval sym)
          (= from to) 1
          true (throw (Exception. (str "Unsupported unit conversion: "
                                       from " -> " to))))))

(defn convert
  "Takes a string expression of a value and its unit and then converts it into
  given to-unit.

  Parameters:
  - value: <string> value with unit.
  - to: <string or keyword> target unit type.

  Examples:
  - (convert \"10px\" \"mm\")
  - (convert \"29.7 cm\" :dxa)

  Supported Unit Types:
  - Length Units: inch, cm, mm, px, pt, dxa, emu"
  [value to]
  (let [[n unit] (parse-unit value)
        rate (conversion-rate unit (name to))]
    (* n rate)))

(ns bakyeono.litedocx.unit
  "Things for unit conversion."
  (:require [clojure.string :as str])
  (:use [bakyeono.litedocx.util])
  (:gen-class))

;;; Conversion rate constants
(defn- reverse-conversion-map
  [m]
  (into {}
    (for [[k v] m]
      [k (/ 1 (k m))])))

(defconst unit-per-inch
  {:cm       2.54
   :dxa      1440
   :emu      914400
   :inch     1
   :km       0.0000254
   :m        0.0254
   :mm       25.4
   :pt       72
   :px       96
   :twip     1440})

(defconst inch-per-unit (reverse-conversion-map unit-per-inch))

(defconst unit-per-m
  {:cm       100
   :dxa      (* (:m inch-per-unit) (inch-per-unit :dxa))
   :emu      (* (:m inch-per-unit) (inch-per-unit :emu))
   :inch     (:m inch-per-unit)
   :km       1/1000
   :m        1
   :mm       1000
   :pt       (* (:m inch-per-unit) (inch-per-unit :pt))
   :px       (* (:m inch-per-unit) (inch-per-unit :px))
   :twip     (* (:m inch-per-unit) (inch-per-unit :twip))})

(defconst m-per-unit (reverse-conversion-map unit-per-m))

;;; Conversion rate map selector
(defconst metric-set #{:cm :km :m :mm})
(defconst inch-set #{:dxa :emu :inch :pt :px :twip})

;;; Functions
(defn- parse-unit
  "Takes a string expression of a number and returns it as a [number unit]
  vector."
  [s]
  (let [s (str/trim s)
        n (Double/parseDouble (re-find #"^-?\d+\.?\d*" s))
        unit (-> (re-find #"[a-z]+$" s) clojure.string/lower-case keyword)]
    [n unit]))

(defn- conversion-medium
  "Takes a keyword of unit and returns its preffered conversion medium."
  [u]
  (cond (metric-set u) [unit-per-m m-per-unit]
        (inch-set u) [unit-per-inch inch-per-unit]))

(defn conversion-rate
  "Returns conversion rate for 'from' unit -> 'to' unit. The parameters should
  be keywords."
  [from to]
  (let [medium (conversion-medium from)
        medium-per-from (from (first medium))
        to-per-medium (to (second medium))]
    (if (and medium-per-from to-per-medium)
      (* medium-per-from to-per-medium)
      (throw (Exception. (str "Unsupported unit conversion: " from " -> " to))))))

(defn convert
  "Takes a string expression of a value and its unit and then converts it into
  given to-unit.

  Parameters:
  - value: <string> value with unit.
  - to: <string or keyword> target unit type.

  Examples:
  - (convert \"10px\" \"mm\")
  - (convert \"29.7 cm\" :dxa)

  Supported Unit Types:
  - Length Units: inch, cm, km, m, mm, px, pt, dxa, emu"
  [value to]
  (let [[n unit] (parse-unit value)
        rate (conversion-rate unit (keyword to))]
    (* n rate)))

Change litedocx.unit package

Change litedocx.unit package


(ns clj-gatling.simulation
  (:require [clj-gatling.httpkit :as http]
            [clj-gatling.simulation-runners :refer :all]
            [clj-gatling.schema :as schema]
            [clj-gatling.simulation-util :refer [weighted-scenarios
                                                 choose-runner]]
            [schema.core :refer [check validate]]
            [clj-time.local :as local-time]
            [clojure.set :refer [rename-keys]]
            [clojure.core.async :as async :refer [go go-loop close! put! <!! alts! <! >!]]))

(set! *warn-on-reflection* true)

(defn- now [] (System/currentTimeMillis))

(defn asynchronize [f ctx]
  (let [parse-response (fn [result]
                         (if (vector? result)
                           {:result (first result) :end-time (now) :context (second result)}
                           {:result result :end-time (now) :context ctx}))]
    (go
      (try
        (let [result (f ctx)]
          (if (instance? clojure.core.async.impl.channels.ManyToManyChannel result)
            (parse-response (<! result))
            (parse-response result)))
        (catch Exception _
          {:result false :end-time (now) :context ctx})))))

(defn async-function-with-timeout [step timeout sent-requests user-id original-context]
  (swap! sent-requests inc)
  (go
    (when-let [sleep-before (:sleep-before step)]
    (<! (async/timeout (sleep-before original-context))))
    (let [original-context-with-user (assoc original-context :user-id user-id)
          start (now)
          return {:name (:name step)
                  :id user-id
                  :start start
                  :context-before original-context-with-user}
          response (asynchronize (:request step) original-context-with-user)
          [{:keys [result end-time context]} c] (alts! [response (async/timeout timeout)])]
      (if (= c response)
        [(assoc return :end end-time
                       :result result
                       :context-after context) context]
        [(assoc return :end (now)
                       :return false
                       :context-after original-context-with-user)
         original-context-with-user]))))

(defn- response->result [scenario result]
  {:name (:name scenario)
   :id (:id (first result))
   :start (:start (first result))
   :end (:end (last result))
   :requests result})

(defn- run-scenario-once [{:keys [runner simulation-start] :as options} scenario user-id]
  (let [timeout (:timeout-in-ms options)
        sent-requests (:sent-requests options)
        result-channel (async/chan)
        skip-next-after-failure? (if (nil? (:skip-next-after-failure? scenario))
                                   true
                                   (:skip-next-after-failure? scenario))
        should-terminate? #(and (:allow-early-termination? scenario)
                                (not (continue-run? runner @sent-requests simulation-start)))
        request-failed? #(not (:result %))]
    (go-loop [steps (:steps scenario)
              context (or (merge (:context options) (:context scenario)) {})
              results []]
             (let [[result new-ctx] (<! (async-function-with-timeout (first steps)
                                                                     timeout
                                                                     sent-requests
                                                                     user-id
                                                                     context))]
               (if (or (should-terminate?)
                       (empty? (rest steps))
                       (and skip-next-after-failure?
                            (request-failed? result)))
                 (>! result-channel (conj results result))
                 (recur (rest steps) new-ctx (conj results result)))))
    result-channel))

(defn- run-scenario-constantly [options scenario user-id]
  (let [c (async/chan)
        runner (:runner options)
        simulation-start (:simulation-start options)
        sent-requests (:sent-requests options)]
    (go-loop []
             (let [result (<! (run-scenario-once options scenario user-id))]
               (>! c result)
               (if (continue-run? runner @sent-requests simulation-start)
                 (recur)
                 (close! c))))
    c))

(defn- print-scenario-info [scenario]
  (println "Running scenario" (:name scenario)
           "with concurrency" (count (:users scenario))))

(defn- convert-legacy-fn [request]
  (let [f (if-let [url (:http request)]
            (partial http/async-http-request url)
            (:fn request))
        c (async/chan)]
    (fn [ctx]
      (f (fn [result & [new-ctx]]
           (if new-ctx
             (put! c [result new-ctx])
             (put! c [result ctx])))
         ctx)
      c)))

(defn- convert-from-legacy [scenarios]
  (let [request->step (fn [request]
                        (-> request
                            (assoc :request (convert-legacy-fn request))
                            (dissoc :fn :http)))]
    (map (fn [scenario]
           (-> scenario
               (update :requests #(map request->step %))
               (rename-keys {:requests :steps})
               (dissoc :concurrency :weight)))
         scenarios)))

(defn- run-scenario [options scenario]
  (print-scenario-info scenario)
  (let [responses (async/merge (map #(run-scenario-constantly options scenario %)
                                    (:users scenario)))
        results (async/chan)]
    (go-loop []
             (if-let [result (<! responses)]
               (do
                 (>! results (response->result scenario result))
                 (recur))
               (close! results)))
    results))

(defn run-scenarios [options scenarios convert-from-legacy?]
  (println "Running simulation with" (runner-info (:runner options)))
  (let [simulation-start (local-time/local-now)
        sent-requests (atom 0)
        runnable-scenarios (validate [schema/RunnableScenario] (if convert-from-legacy?
                                                                 (convert-from-legacy scenarios)
                                                                 scenarios))
        run-scenario-with-opts (partial run-scenario
                                        (assoc options
                                               :simulation-start simulation-start
                                               :sent-requests sent-requests))
        responses (async/merge (map run-scenario-with-opts runnable-scenarios))
        results (async/chan)]
    (go-loop []
             (if-let [result (<! responses)]
               (do
                 (>! results result)
                 (recur))
               (close! results)))
    results))

(defn run [{:keys [scenarios] :as simulation}
           {:keys [concurrency users] :as options}]
  (let [user-ids (or users (range concurrency))]
    (validate schema/Simulation simulation)
    (run-scenarios (assoc options :runner (choose-runner scenarios
                                                         (count user-ids)
                                                         options))
                   (weighted-scenarios user-ids scenarios)
                   false)))

(ns clj-gatling.simulation
  (:require [clj-gatling.httpkit :as http]
            [clj-gatling.simulation-runners :refer :all]
            [clj-gatling.schema :as schema]
            [clj-gatling.simulation-util :refer [weighted-scenarios
                                                 choose-runner]]
            [schema.core :refer [check validate]]
            [clj-time.local :as local-time]
            [clojure.set :refer [rename-keys]]
            [clojure.core.async :as async :refer [go go-loop close! put! <!! alts! <! >!]]
            [clojure.stacktrace :as stacktrace]))

(set! *warn-on-reflection* true)

(defn- now [] (System/currentTimeMillis))

(defn asynchronize [f ctx]
  (let [parse-response (fn [result]
                         (if (vector? result)
                           {:result (first result) :end-time (now) :context (second result)}
                           {:result result :end-time (now) :context ctx}))]
    (go
      (try
        (let [result (f ctx)]
          (if (instance? clojure.core.async.impl.channels.ManyToManyChannel result)
            (parse-response (<! result))
            (parse-response result)))
        (catch Exception e
          (stacktrace/print-cause-trace e)
          {:result false :end-time (now) :context ctx})))))

(defn async-function-with-timeout [step timeout sent-requests user-id original-context]
  (swap! sent-requests inc)
  (go
    (when-let [sleep-before (:sleep-before step)]
    (<! (async/timeout (sleep-before original-context))))
    (let [original-context-with-user (assoc original-context :user-id user-id)
          start (now)
          return {:name (:name step)
                  :id user-id
                  :start start
                  :context-before original-context-with-user}
          response (asynchronize (:request step) original-context-with-user)
          [{:keys [result end-time context]} c] (alts! [response (async/timeout timeout)])]
      (if (= c response)
        [(assoc return :end end-time
                       :result result
                       :context-after context) context]
        [(assoc return :end (now)
                       :return false
                       :context-after original-context-with-user)
         original-context-with-user]))))

(defn- response->result [scenario result]
  {:name (:name scenario)
   :id (:id (first result))
   :start (:start (first result))
   :end (:end (last result))
   :requests result})

(defn- run-scenario-once [{:keys [runner simulation-start] :as options} scenario user-id]
  (let [timeout (:timeout-in-ms options)
        sent-requests (:sent-requests options)
        result-channel (async/chan)
        skip-next-after-failure? (if (nil? (:skip-next-after-failure? scenario))
                                   true
                                   (:skip-next-after-failure? scenario))
        should-terminate? #(and (:allow-early-termination? scenario)
                                (not (continue-run? runner @sent-requests simulation-start)))
        request-failed? #(not (:result %))]
    (go-loop [steps (:steps scenario)
              context (or (merge (:context options) (:context scenario)) {})
              results []]
             (let [[result new-ctx] (<! (async-function-with-timeout (first steps)
                                                                     timeout
                                                                     sent-requests
                                                                     user-id
                                                                     context))]
               (if (or (should-terminate?)
                       (empty? (rest steps))
                       (and skip-next-after-failure?
                            (request-failed? result)))
                 (>! result-channel (conj results result))
                 (recur (rest steps) new-ctx (conj results result)))))
    result-channel))

(defn- run-scenario-constantly [options scenario user-id]
  (let [c (async/chan)
        runner (:runner options)
        simulation-start (:simulation-start options)
        sent-requests (:sent-requests options)]
    (go-loop []
             (let [result (<! (run-scenario-once options scenario user-id))]
               (>! c result)
               (if (continue-run? runner @sent-requests simulation-start)
                 (recur)
                 (close! c))))
    c))

(defn- print-scenario-info [scenario]
  (println "Running scenario" (:name scenario)
           "with concurrency" (count (:users scenario))))

(defn- convert-legacy-fn [request]
  (let [f (if-let [url (:http request)]
            (partial http/async-http-request url)
            (:fn request))
        c (async/chan)]
    (fn [ctx]
      (f (fn [result & [new-ctx]]
           (if new-ctx
             (put! c [result new-ctx])
             (put! c [result ctx])))
         ctx)
      c)))

(defn- convert-from-legacy [scenarios]
  (let [request->step (fn [request]
                        (-> request
                            (assoc :request (convert-legacy-fn request))
                            (dissoc :fn :http)))]
    (map (fn [scenario]
           (-> scenario
               (update :requests #(map request->step %))
               (rename-keys {:requests :steps})
               (dissoc :concurrency :weight)))
         scenarios)))

(defn- run-scenario [options scenario]
  (print-scenario-info scenario)
  (let [responses (async/merge (map #(run-scenario-constantly options scenario %)
                                    (:users scenario)))
        results (async/chan)]
    (go-loop []
             (if-let [result (<! responses)]
               (do
                 (>! results (response->result scenario result))
                 (recur))
               (close! results)))
    results))

(defn run-scenarios [options scenarios convert-from-legacy?]
  (println "Running simulation with" (runner-info (:runner options)))
  (let [simulation-start (local-time/local-now)
        sent-requests (atom 0)
        runnable-scenarios (validate [schema/RunnableScenario] (if convert-from-legacy?
                                                                 (convert-from-legacy scenarios)
                                                                 scenarios))
        run-scenario-with-opts (partial run-scenario
                                        (assoc options
                                               :simulation-start simulation-start
                                               :sent-requests sent-requests))
        responses (async/merge (map run-scenario-with-opts runnable-scenarios))
        results (async/chan)]
    (go-loop []
             (if-let [result (<! responses)]
               (do
                 (>! results result)
                 (recur))
               (close! results)))
    results))

(defn run [{:keys [scenarios] :as simulation}
           {:keys [concurrency users] :as options}]
  (let [user-ids (or users (range concurrency))]
    (validate schema/Simulation simulation)
    (run-scenarios (assoc options :runner (choose-runner scenarios
                                                         (count user-ids)
                                                         options))
                   (weighted-scenarios user-ids scenarios)
                   false)))

Add stacktrace printing to failed simulation


(ns parkour.io.dux
  (:require [clojure.edn :as edn]
            [clojure.core.reducers :as r]
            [pjstadig.scopes :as s]
            [parkour (conf :as conf) (wrapper :as w) (cstep :as cstep)
                     (mapreduce :as mr)]
            [parkour.mapreduce (sink :as snk)]
            [parkour.io (dseq :as dseq) (dsink :as dsink) (mux :as mux)]
            [parkour.util :refer [returning prev-reset!]])
  (:import [clojure.lang IFn]
           [org.apache.hadoop.conf Configurable]
           [org.apache.hadoop.mapreduce Job TaskInputOutputContext]
           [org.apache.hadoop.mapreduce OutputFormat RecordWriter Counter]
           [org.apache.hadoop.mapreduce TaskAttemptContext]
           [parkour.hadoop Dux$OutputFormat]))

(def ^:private ^:const confs-key
  "parkour.dux.confs")

(defn ^:private dux-output?
  "True iff `job` is configured for demultiplex output."
  [job] (->> (conf/get-class job "mapreduce.outputformat.class" nil)
             (identical? Dux$OutputFormat)))

(defn ^:private dux-empty
  "Clone of `job` with empty demultiplex sub-configurations map."
  [job] (-> job mr/job (conf/assoc! confs-key "{}")))

(defn get-subconfs
  "Get map of `job` demultiplex sub-configuration diffs."
  [job]
  (or (if (dux-output? job)
        (some->> (conf/get job confs-key) (edn/read-string)))
      {}))

(defn add-subconf
  "Add demultiplex output `subconf` to `job` as `name`."
  [^Job job name subconf]
  (let [diff (-> job (conf/diff subconf) (dissoc confs-key))
        diffs (-> (get-subconfs job) (assoc name diff))]
    (doto job
      (.setOutputKeyClass Object)
      (.setOutputValueClass Object)
      (.setOutputFormatClass Dux$OutputFormat)
      (conf/assoc! confs-key (pr-str diffs)))))

(defn add-substep
  "Add configuration changes produced by `step` as a demultiplex
sub-configuration of `job`."
  [^Job job name step]
  (add-subconf job name (-> job dux-empty (cstep/apply! step))))

(defn dsink
  "Demultiplexing distributed sink, for other distributed sinks `dsinks`,
a map of names to dsinks.  The distributed sequence of the resulting sink is the
multiplex distributed sequence of all component sinks' sequences."
  [dsinks]
  (dsink/dsink
   (apply mux/dseq (map dsink/dsink-dseq (vals dsinks)))
   (fn [^Job job]
     (reduce (partial apply add-substep) job dsinks))))

(defmethod dsink/output-paths* Dux$OutputFormat
  [^Job job]
  (->> job get-subconfs vals
       (r/mapcat #(dsink/output-paths (conf/merge! (mr/job job) %)))
       (into [])))

(defn ^:private dux-state
  "Extract demultiplexing output state from `context`."
  [^TaskInputOutputContext context]
  @(.getOutputCommitter context))

(defn ^:private set-output-name
  "Set all known named output bases for `job` to `base`."
  [job base]
  (conf/assoc! job
    "mapreduce.output.basename" base
    "avro.mo.config.namedOutput" base))

(defn ^:private get-counter
  "Get dux counter for output `oname`."
  {:tag `Counter}
  [^TaskInputOutputContext context oname]
  (.getCounter context "Demultiplexing Output" (name oname)))

(defn ^:private new-rw
  "Return new demultiplexing output sink for output `oname` and file output
basename `base`."
  [context oname base]
  (let [[jobs ofs rws] (dux-state context)
        of (get ofs oname), ^Job job (get jobs oname)
        conf (-> job conf/clone (cond-> base (set-output-name base)))
        tac (mr/tac conf context), c (get-counter context oname)
        ckey (.getOutputKeyClass job), cval (.getOutputValueClass job)
        rw (.getRecordWriter ^OutputFormat of tac)]
    (->> (reify
           Configurable (getConf [_] conf)
           w/Wrapper (unwrap [_] rw)
           snk/TupleSink
           (-key-class [_] ckey)
           (-val-class [_] cval)
           (-close [_] (.close rw context))
           (-emit-keyval [_ key val]
             (.write rw key val)
             (.increment c 1)))
         (snk/wrap-sink)
         (s/scoped!))))

(defn get-sink
  "Get sink for named output `oname` and optional (file output format only) file
basename `base`."
  ([context oname] (get-sink context oname nil))
  ([context oname base]
     (let [[jobs ofs rws] (dux-state context), rwkey [oname base]]
       @(or (get-in @rws rwkey)
            (let [new-rw (partial new-rw context oname base)
                  add-rw (fn [rws]
                           (if rws
                             (if-let [rw (get-in rws rwkey)]
                               rw
                               (assoc-in rws rwkey (delay (new-rw))))))]
              (-> rws (swap! add-rw) (get-in rwkey)))))))

(defn write
  "Write `key` and `val` to named output `oname` and optional (file output
format only) file basename `base`."
  ([context oname key val] (write context oname nil key val))
  ([context oname base key val]
     (-> context (get-sink oname base) (snk/emit-keyval key val))))

(defn map-output
  "Sink as (reducer-bound) base map output, as `mr/sink-as` kind `kind`."
  [kind] kind)

(defn combine-output
  "Sink as (reducer-bound) base combiner output, as `mr/sink-as` kind `kind`."
  [kind] kind)

(defn ^:private named
  "Base function for `named-`* functions."
  ([f oname]
     (fn [context coll]
       (let [sink (if (identical? ::mr/map-output oname)
                    (mr/wrap-sink context)
                    (get-sink context oname))]
         (reduce (fn [_ t]
                   (f sink t))
                 nil coll))))
  ([f context coll]
     (let [wcontext (mr/wrap-sink context)]
       (reduce (fn [_ [oname k v :as x]]
                 (let [t (if (= 2 (count x)) k [k v])
                       sink (if (identical? ::mr/map-output oname)
                              wcontext
                              (get-sink context oname))]
                   (f sink t)))
               nil coll))))

(def ^{:arglists '([oname] [context coll])}
  named-keyvals
  "Sink as key-val pairs to named output, with name provided as `oname` or as
first element of three-element tuples."
  (partial named snk/emit-keyval))

(def ^{:arglists '([oname] [context coll])}
  named-keys
  "Sink as keys to named output, with name provided as `oname` or as first
element of two-element tuples."
  (partial named snk/emit-key))

(def ^{:arglists '([oname] [context coll])}
  named-vals
  "Sink as values to named output, with name provided as `oname` or as first
element of two-element tuples."
  (partial named snk/emit-val))

(defn ^:private prefix
  "Base function for `prefix-`* functions."
  ([f oname]
     (fn [context coll]
       (reduce (fn [_ [base k v :as x]]
                 (let [t (if (= 2 (count x)) k [k v])
                       sink (get-sink context oname base)]
                   (f sink t)))
               nil coll)))
  ([f context coll]
     (reduce (fn [_ [oname base k v :as x]]
               (let [t (if (= 3 (count x)) k [k v])
                     sink (get-sink context oname base)]
                 (f sink t)))
             nil coll)))

(def ^{:arglists '([oname])}
  prefix-keyvals
  "Sink as key-val pairs to named output `oname`, with file prefix as first
element of three-element tuples."
  (partial prefix snk/emit-keyval))

(def ^{:arglists '([oname])}
  prefix-keys
  "Sink as keys to named output `oname`, with file prefix as first element of
two-element tuples."
  (partial prefix snk/emit-key))

(def ^{:arglists '([oname])}
  prefix-vals
  "Sink as values to named output `oname`, with file prefix as first element of
two-element tuples."
  (partial prefix snk/emit-val))

(ns parkour.io.dux
  (:require [clojure.edn :as edn]
            [clojure.core.reducers :as r]
            [pjstadig.scopes :as s]
            [parkour (conf :as conf) (wrapper :as w) (cstep :as cstep)
                     (mapreduce :as mr)]
            [parkour.mapreduce (sink :as snk)]
            [parkour.io (dseq :as dseq) (dsink :as dsink) (mux :as mux)]
            [parkour.util :refer [returning prev-reset!]])
  (:import [clojure.lang IFn]
           [org.apache.hadoop.conf Configurable]
           [org.apache.hadoop.mapreduce Job TaskInputOutputContext]
           [org.apache.hadoop.mapreduce OutputFormat RecordWriter Counter]
           [org.apache.hadoop.mapreduce TaskAttemptContext]
           [parkour.hadoop Dux$OutputFormat]))

(def ^:private ^:const confs-key
  "parkour.dux.confs")

(defn ^:private dux-output?
  "True iff `job` is configured for demultiplex output."
  [job] (->> (conf/get-class job "mapreduce.outputformat.class" nil)
             (identical? Dux$OutputFormat)))

(defn ^:private dux-empty
  "Clone of `job` with empty demultiplex sub-configurations map."
  [job] (-> job mr/job (conf/assoc! confs-key "{}")))

(defn get-subconfs
  "Get map of `job` demultiplex sub-configuration diffs."
  [job]
  (or (if (dux-output? job)
        (some->> (conf/get job confs-key) (edn/read-string)))
      {}))

(defn add-subconf
  "Add demultiplex output `subconf` to `job` as `name`."
  [^Job job name subconf]
  (let [diff (-> job (conf/diff subconf) (dissoc confs-key))
        diffs (-> (get-subconfs job) (assoc name diff))]
    (doto job
      (.setOutputKeyClass Object)
      (.setOutputValueClass Object)
      (.setOutputFormatClass Dux$OutputFormat)
      (conf/assoc! confs-key (pr-str diffs)))))

(defn add-substep
  "Add configuration changes produced by `step` as a demultiplex
sub-configuration of `job`."
  [^Job job name step]
  (add-subconf job name (-> job dux-empty (cstep/apply! step))))

(defn dsink
  "Demultiplexing distributed sink, for other distributed sinks `dsinks`,
a map of names to dsinks.  The distributed sequence of the resulting sink is the
multiplex distributed sequence of all component sinks' sequences."
  [dsinks]
  (dsink/dsink
   (apply mux/dseq (map dsink/dsink-dseq (vals dsinks)))
   (fn [^Job job]
     (reduce (partial apply add-substep) job dsinks))))

(defmethod dsink/output-paths* Dux$OutputFormat
  [^Job job]
  (->> job get-subconfs vals
       (r/mapcat #(dsink/output-paths (conf/merge! (mr/job job) %)))
       (into [])))

(defn ^:private dux-state
  "Extract demultiplexing output state from `context`."
  [^TaskInputOutputContext context]
  @(.getOutputCommitter context))

(defn ^:private set-output-name
  "Set all known named output bases for `job` to `base`."
  [job base]
  (conf/assoc! job
    "mapreduce.output.basename" base
    "avro.mo.config.namedOutput" base))

(defn ^:private get-counter
  "Get dux counter for output `oname`."
  {:tag `Counter}
  [^TaskInputOutputContext context oname]
  (.getCounter context "Demultiplexing Output" (name oname)))

(defn ^:private new-rw
  "Return new demultiplexing output sink for output `oname` and file output
basename `base`."
  [context oname base]
  (let [[jobs ofs rws] (dux-state context)
        of (get ofs oname), ^Job job (get jobs oname)
        conf (-> job conf/clone (cond-> base (set-output-name base)))
        tac (mr/tac conf context), c (get-counter context oname)
        ckey (.getOutputKeyClass job), cval (.getOutputValueClass job)
        rw (.getRecordWriter ^OutputFormat of tac)]
    (->> (reify
           Configurable (getConf [_] conf)
           w/Wrapper (unwrap [_] rw)
           snk/TupleSink
           (-key-class [_] ckey)
           (-val-class [_] cval)
           (-close [_] (.close rw context))
           (-emit-keyval [_ key val]
             (.write rw key val)
             (.increment c 1)))
         (snk/wrap-sink)
         (s/scoped!))))

(defn get-sink
  "Get sink for named output `oname` and optional (file output format only) file
basename `base`."
  ([context oname] (get-sink context oname nil))
  ([context oname base]
     (let [[jobs ofs rws] (dux-state context), rwkey [oname base]]
       @(or (get-in @rws rwkey)
            (let [new-rw (partial new-rw context oname base)
                  add-rw (fn [rws]
                           (if rws
                             (if-let [rw (get-in rws rwkey)]
                               rws
                               (assoc-in rws rwkey (delay (new-rw))))))]
              (-> rws (swap! add-rw) (get-in rwkey)))))))

(defn write
  "Write `key` and `val` to named output `oname` and optional (file output
format only) file basename `base`."
  ([context oname key val] (write context oname nil key val))
  ([context oname base key val]
     (-> context (get-sink oname base) (snk/emit-keyval key val))))

(defn map-output
  "Sink as (reducer-bound) base map output, as `mr/sink-as` kind `kind`."
  [kind] kind)

(defn combine-output
  "Sink as (reducer-bound) base combiner output, as `mr/sink-as` kind `kind`."
  [kind] kind)

(defn ^:private named
  "Base function for `named-`* functions."
  ([f oname]
     (fn [context coll]
       (let [sink (if (identical? ::mr/map-output oname)
                    (mr/wrap-sink context)
                    (get-sink context oname))]
         (reduce (fn [_ t]
                   (f sink t))
                 nil coll))))
  ([f context coll]
     (let [wcontext (mr/wrap-sink context)]
       (reduce (fn [_ [oname k v :as x]]
                 (let [t (if (= 2 (count x)) k [k v])
                       sink (if (identical? ::mr/map-output oname)
                              wcontext
                              (get-sink context oname))]
                   (f sink t)))
               nil coll))))

(def ^{:arglists '([oname] [context coll])}
  named-keyvals
  "Sink as key-val pairs to named output, with name provided as `oname` or as
first element of three-element tuples."
  (partial named snk/emit-keyval))

(def ^{:arglists '([oname] [context coll])}
  named-keys
  "Sink as keys to named output, with name provided as `oname` or as first
element of two-element tuples."
  (partial named snk/emit-key))

(def ^{:arglists '([oname] [context coll])}
  named-vals
  "Sink as values to named output, with name provided as `oname` or as first
element of two-element tuples."
  (partial named snk/emit-val))

(defn ^:private prefix
  "Base function for `prefix-`* functions."
  ([f oname]
     (fn [context coll]
       (reduce (fn [_ [base k v :as x]]
                 (let [t (if (= 2 (count x)) k [k v])
                       sink (get-sink context oname base)]
                   (f sink t)))
               nil coll)))
  ([f context coll]
     (reduce (fn [_ [oname base k v :as x]]
               (let [t (if (= 3 (count x)) k [k v])
                     sink (get-sink context oname base)]
                 (f sink t)))
             nil coll)))

(def ^{:arglists '([oname])}
  prefix-keyvals
  "Sink as key-val pairs to named output `oname`, with file prefix as first
element of three-element tuples."
  (partial prefix snk/emit-keyval))

(def ^{:arglists '([oname])}
  prefix-keys
  "Sink as keys to named output `oname`, with file prefix as first element of
two-element tuples."
  (partial prefix snk/emit-key))

(def ^{:arglists '([oname])}
  prefix-vals
  "Sink as values to named output `oname`, with file prefix as first element of
two-element tuples."
  (partial prefix snk/emit-val))

Fix typo.

Fix typo.


; Copyright © 2013 - 2016 Dr. Thomas Schank <Thomas.Schank@AlgoCon.ch>
; Licensed under the terms of the GNU Affero General Public License v3.
; See the "LICENSE.txt" file provided with this software.

(ns cider-ci.dispatcher.task
  (:require
    [clojure.core.memoize :as core.memoize]
    [cider-ci.dispatcher.job :as job]
    [cider-ci.dispatcher.result :as result]
    [cider-ci.dispatcher.stateful-entity :as stateful-entity]
    [cider-ci.utils.map :refer [convert-to-array]]
    [cider-ci.utils.messaging :as messaging]
    [cider-ci.utils.rdbms :as rdbms]
    [clj-logging-config.log4j :as logging-config]
    [clojure.java.jdbc :as jdbc]
    [clojure.tools.logging :as logging]
    [logbug.catcher :as catcher]
    [logbug.debug :as debug]
    [logbug.thrown :as thrown]
    [cider-ci.dispatcher.scripts :refer [create-scripts]]
    ))

;### utils ####################################################################
(defonce terminal-states #{"aborted" "failed" "passed"})

(defn get-task [id]
  (first (jdbc/query (rdbms/get-ds)
                                ["SELECT * FROM tasks
                                 WHERE id = ?" id])))

(defn get-task-spec [task-id]
  (let [ task_specifications (jdbc/query (rdbms/get-ds)
                                ["SELECT task_specifications.data FROM task_specifications
                                 JOIN tasks ON tasks.task_specification_id = task_specifications.id
                                 WHERE tasks.id = ?" task-id])
        spec (clojure.walk/keywordize-keys (:data (first task_specifications)))]
    spec))

(defn- get-trial-states [task]
  (let [id (:id task)]
    (map :state
         (jdbc/query (rdbms/get-ds)
                     ["SELECT state FROM trials
                      WHERE task_id = ? ORDER BY created_at ASC" id]))))

(defn- get-job-for-task [task]
  (->> (jdbc/query (rdbms/get-ds)
                   ["SELECT jobs.* FROM jobs
                    JOIN tasks ON tasks.job_id = jobs.id
                    WHERE tasks.id = ? " (:id task)]) first))

;### get task spec data #######################################################

(defn- _get-task-spec-data [id]
  (or (-> (jdbc/query (rdbms/get-ds)
                      ["SELECT data FROM task_specifications WHERE id = ?" id])
          first
          :data)
      (throw (ex-info "Do not cache" {:msg :do-not-cache}))))

(def _get-task-spec-data-memoized
  (core.memoize/lru _get-task-spec-data))

(defn- get-task-spec-data [id]
  (try (_get-task-spec-data-memoized id)
       (catch clojure.lang.ExceptionInfo e
         (if (= (-> e ex-data :msg) :do-not-cache)
           nil
           (throw e)))))

;(get-task-spec-data "2b1b1ac7-bfda-54c6-b1c3-78e54ec27f52")
;(get-task-spec-data-memoized_ "2b1b1ac7-bfda-54c6-b1c3-78e54ec27f52")
;(get-task-spec-data "2b1b1ac7-bfda-54c6-b1c3-78e54ec27f53")

;### re-evaluate  #############################################################

(defn- eval-new-state [task trial-states]
  (let [spec (-> task :task_specification_id get-task-spec-data)]
    (if (= "satisfy-last" (-> spec :aggregate_state))
      (or (last trial-states) "defective")
      (cond (empty? trial-states) "defective"
            (some #{"passed"} trial-states) "passed"
            (some #{"executing" "dispatching"} trial-states) "executing"
            (= (last trial-states) "aborted") "aborted"
            (every? #{"defective"} trial-states) "defective"
            (some #{"pending"} trial-states) "pending"
            (some #{"aborting"} trial-states) "aborting"
            (some #{"failed"} trial-states) "failed"
            :else (do (logging/warn 'eval-new-state "Unmatched condition"
                                    {:task task :trial-states trial-states})
                      "defective")))))

(defn- evaluate-trials-and-update
  "Returns a truthy value when the state of the task has changed."
  [task]
  (catcher/with-logging {}
    (let [id (:id task)
          task (get-task id)
          trial-states (get-trial-states task)
          new-state (eval-new-state task trial-states)]
      (result/update-task-and-job-result id)
      (stateful-entity/update-state :tasks id new-state {:assert-existence true}))))

;### create trial #############################################################

(defn create-trial [task params]
  (catcher/with-logging {}
    (let [trial (jdbc/with-db-transaction [tx (rdbms/get-ds)]
                  (let [task-id (:id task)
                        spec (get-task-spec task-id)
                        scripts (:scripts spec)]
                    (let [trial (-> (jdbc/insert! tx :trials
                                                  (merge params
                                                         {:task_id task-id}))
                                    first)]
                      (create-scripts tx trial scripts)
                      trial)))]
      (when (evaluate-trials-and-update task)
        (job/evaluate-and-update (:job_id task)))
      trial)))

(defn- create-trials [task]
  (let [id (:id task)
        job (get-job-for-task task)
        spec (get-task-spec id)
        states (get-trial-states task)
        finished-count (->> states (filter #(terminal-states %)) count)
        in-progress-count (- (count states) finished-count)
        create-new-trials-count (min (- (or (:eager_trials spec) 1) in-progress-count)
                                     (- (or (:max_trials spec) 2) (count states)))
        _range (range 0 create-new-trials-count)]
    (logging/debug "CREATE-TRIALS"
                   {:id id :spec spec :states states
                    :finished-count finished-count
                    :in-progress-count in-progress-count
                    :create-new-trials-count create-new-trials-count
                    :_range _range
                    })
    (when-not (or (some #{"passed"} states)
                  (some #{(:state job)} ["aborted" "aborting"]))
      (logging/debug "seqing and creating trials" )
      (doseq [_ _range]
        (try
          (create-trial task {})
          (catch Exception e
            (let [row-data  {:job_id (:id job)
                             :title "Error when creating trial and scripts."
                             :description (thrown/stringify e)}]
              (logging/warn row-data)
              (jdbc/insert! (rdbms/get-ds) "job_issues" row-data))))))))

;### eval and create trials ###################################################

(defn evaluate-and-create-trials
  "Evaluate task, evaluate state of trials and adjust state of task.
  Send \"task.state-changed\" message if state changed.
  Create trials according to max_trials and eager_trials properties
  if task is not in terminal state. The argument task must be a map
  including an :id key"
  [task_]
  (let [task (if (:job_id task_) task_ (get-task (:id task_)))]
    (create-trials task)
    (when (evaluate-trials-and-update task)
      (messaging/publish "task.state-changed" task)
      (job/evaluate-and-update (:job_id (get-task (:id task)))))))

;### initialize ###############################################################

(defn initialize []
  (catcher/with-logging {}
    (messaging/listen "task.create-trials"
                      #'create-trials
                      "task.create-trials")))

;(messaging/publish "task.create-trials" {:id "de10e33c-c13f-5aba-94aa-db1dca1e5932"})

;#### debug ###################################################################
;(logging-config/set-logger! :level :debug)
;(logging-config/set-logger! :level :info)
;(debug/debug-ns *ns*)
;(debug/wrap-with-log-debug #'evaluate-and-create-trials)
;(debug/wrap-with-log-debug #'eval-new-state)
;(debug/re-apply-last-argument #'get-trial-states)

; Copyright © 2013 - 2016 Dr. Thomas Schank <Thomas.Schank@AlgoCon.ch>
; Licensed under the terms of the GNU Affero General Public License v3.
; See the "LICENSE.txt" file provided with this software.

(ns cider-ci.dispatcher.task
  (:require
    [clojure.core.memoize :as core.memoize]
    [cider-ci.dispatcher.job :as job]
    [cider-ci.dispatcher.result :as result]
    [cider-ci.dispatcher.stateful-entity :as stateful-entity]
    [cider-ci.utils.map :refer [convert-to-array]]
    [cider-ci.utils.messaging :as messaging]
    [cider-ci.utils.rdbms :as rdbms]
    [clj-logging-config.log4j :as logging-config]
    [clojure.java.jdbc :as jdbc]
    [clojure.tools.logging :as logging]
    [logbug.catcher :as catcher]
    [logbug.debug :as debug]
    [logbug.thrown :as thrown]
    [cider-ci.dispatcher.scripts :refer [create-scripts]]
    ))

;### utils ####################################################################
(defonce terminal-states #{"aborted" "failed" "passed"})

(defn get-task [id]
  (first (jdbc/query (rdbms/get-ds)
                                ["SELECT * FROM tasks
                                 WHERE id = ?" id])))

(defn get-task-spec [task-id]
  (let [ task_specifications (jdbc/query (rdbms/get-ds)
                                ["SELECT task_specifications.data FROM task_specifications
                                 JOIN tasks ON tasks.task_specification_id = task_specifications.id
                                 WHERE tasks.id = ?" task-id])
        spec (clojure.walk/keywordize-keys (:data (first task_specifications)))]
    spec))

(defn- get-trial-states [task]
  (let [id (:id task)]
    (map :state
         (jdbc/query (rdbms/get-ds)
                     ["SELECT state FROM trials
                      WHERE task_id = ? ORDER BY created_at ASC" id]))))

(defn- get-job-for-task [task]
  (->> (jdbc/query (rdbms/get-ds)
                   ["SELECT jobs.* FROM jobs
                    JOIN tasks ON tasks.job_id = jobs.id
                    WHERE tasks.id = ? " (:id task)]) first))

;### get task spec data #######################################################

(defn- _get-task-spec-data [id]
  (or (-> (jdbc/query (rdbms/get-ds)
                      ["SELECT data FROM task_specifications WHERE id = ?" id])
          first
          :data)
      (throw (ex-info "Do not cache" {:msg :do-not-cache}))))

(def _get-task-spec-data-memoized
  (core.memoize/lru _get-task-spec-data))

(defn- get-task-spec-data [id]
  (try (_get-task-spec-data-memoized id)
       (catch clojure.lang.ExceptionInfo e
         (if (= (-> e ex-data :msg) :do-not-cache)
           nil
           (throw e)))))

;(get-task-spec-data "2b1b1ac7-bfda-54c6-b1c3-78e54ec27f52")
;(get-task-spec-data-memoized_ "2b1b1ac7-bfda-54c6-b1c3-78e54ec27f52")
;(get-task-spec-data "2b1b1ac7-bfda-54c6-b1c3-78e54ec27f53")

;### re-evaluate  #############################################################

(defn- eval-new-state [task trial-states]
  (let [spec (-> task :task_specification_id get-task-spec-data)]
    (logging/debug 'spec spec)
    (if (= "satisfy-last" (-> spec :aggregate_state))
      (let [state (or (last trial-states) "defective")]
        (case state
          "dispatching" "executing"
          state))
      (cond (empty? trial-states) "defective"
            (some #{"passed"} trial-states) "passed"
            (some #{"executing" "dispatching"} trial-states) "executing"
            (= (last trial-states) "aborted") "aborted"
            (every? #{"defective"} trial-states) "defective"
            (some #{"pending"} trial-states) "pending"
            (some #{"aborting"} trial-states) "aborting"
            (some #{"failed"} trial-states) "failed"
            :else (do (logging/warn 'eval-new-state "Unmatched condition"
                                    {:task task :trial-states trial-states})
                      "defective")))))

(defn- evaluate-trials-and-update
  "Returns a truthy value when the state of the task has changed."
  [task]
  (catcher/with-logging {}
    (let [id (:id task)
          task (get-task id)
          trial-states (get-trial-states task)
          new-state (eval-new-state task trial-states)]
      (result/update-task-and-job-result id)
      (stateful-entity/update-state :tasks id new-state {:assert-existence true}))))

;### create trial #############################################################

(defn create-trial [task params]
  (catcher/with-logging {}
    (let [trial (jdbc/with-db-transaction [tx (rdbms/get-ds)]
                  (let [task-id (:id task)
                        spec (get-task-spec task-id)
                        scripts (:scripts spec)]
                    (let [trial (-> (jdbc/insert! tx :trials
                                                  (merge params
                                                         {:task_id task-id}))
                                    first)]
                      (create-scripts tx trial scripts)
                      trial)))]
      (when (evaluate-trials-and-update task)
        (job/evaluate-and-update (:job_id task)))
      trial)))

(defn- create-trials [task]
  (let [id (:id task)
        job (get-job-for-task task)
        spec (get-task-spec id)
        states (get-trial-states task)
        finished-count (->> states (filter #(terminal-states %)) count)
        in-progress-count (- (count states) finished-count)
        create-new-trials-count (min (- (or (:eager_trials spec) 1) in-progress-count)
                                     (- (or (:max_trials spec) 2) (count states)))
        _range (range 0 create-new-trials-count)]
    (logging/debug "CREATE-TRIALS"
                   {:id id :spec spec :states states
                    :finished-count finished-count
                    :in-progress-count in-progress-count
                    :create-new-trials-count create-new-trials-count
                    :_range _range
                    })
    (when-not (or (some #{"passed"} states)
                  (some #{(:state job)} ["aborted" "aborting"]))
      (logging/debug "seqing and creating trials" )
      (doseq [_ _range]
        (try
          (create-trial task {})
          (catch Exception e
            (let [row-data  {:job_id (:id job)
                             :title "Error when creating trial and scripts."
                             :description (thrown/stringify e)}]
              (logging/warn row-data)
              (jdbc/insert! (rdbms/get-ds) "job_issues" row-data))))))))

;### eval and create trials ###################################################

(defn evaluate-and-create-trials
  "Evaluate task, evaluate state of trials and adjust state of task.
  Send \"task.state-changed\" message if state changed.
  Create trials according to max_trials and eager_trials properties
  if task is not in terminal state. The argument task must be a map
  including an :id key"
  [task_]
  (let [task (if (:job_id task_) task_ (get-task (:id task_)))]
    (create-trials task)
    (when (evaluate-trials-and-update task)
      (messaging/publish "task.state-changed" task)
      (job/evaluate-and-update (:job_id (get-task (:id task)))))))

;### initialize ###############################################################

(defn initialize []
  (catcher/with-logging {}
    (messaging/listen "task.create-trials"
                      #'create-trials
                      "task.create-trials")))

;(messaging/publish "task.create-trials" {:id "de10e33c-c13f-5aba-94aa-db1dca1e5932"})

;#### debug ###################################################################
;(logging-config/set-logger! :level :debug)
;(logging-config/set-logger! :level :info)
;(debug/debug-ns *ns*)
;(debug/wrap-with-log-debug #'evaluate-and-create-trials)
;(debug/wrap-with-log-debug #'eval-new-state)
;(debug/re-apply-last-argument #'get-trial-states)

Handle "dispatching" trial state properly when aggregate-state is satisfy-last


(ns clj-templates.logger
  (:require [integrant.core :as ig]
            [taoensso.timbre :as timbre]
            [taoensso.timbre.appenders.core :as appenders]))

(defmethod ig/init-key :logger/timbre [_ {:keys [appenders]}]
  (println (str "Initializing logging appenders: " (keys appenders)))
  (timbre/merge-config! {:appenders {:println (when-let [opts (:println appenders)] (appenders/println-appender opts))
                                     :spit    (when-let [opts (:spit appenders)] (appenders/spit-appender opts))}}))

(ns clj-templates.logger
  (:require [integrant.core :as ig]
            [taoensso.timbre :as timbre]
            [taoensso.timbre.appenders.core :as appenders])
  (:import (java.util Locale TimeZone)))

(defmethod ig/init-key :logger/timbre [_ {:keys [appenders]}]
  (println (str "Initializing logging appenders: " (keys appenders)))
  (timbre/merge-config! {:appenders      {:println (when-let [opts (:println appenders)] (appenders/println-appender opts))
                                          :spit    (when-let [opts (:spit appenders)] (appenders/spit-appender opts))}
                         :timestamp-opts {:pattern  "yyyy-MM-dd HH:mm:ss"
                                          :timezone (TimeZone/getDefault)
                                          :locale   (Locale. "en")}}))

Update logger format config.

Update logger format config.


(ns hsm.controllers.coll
  (:require
    [cheshire.core :refer :all]
    [clojure.tools.logging :as log]
    [hiccup.def                   :refer [defhtml]]
    [hsm.actions :as actions]
    [hsm.views :refer [layout panel render-user left-menu panelx]]
    [hsm.ring :refer [json-resp html-resp redirect]]
    [hsm.utils :refer :all]))

(defn add-p-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        id (BigInteger. (id-of request))
        body (body-of request)
        project-form-param (get (:form-params request) "project")
        project-to-add (if-not (nil? project-form-param) project-form-param (get body "project"))
        coll (first (actions/get-collection db id))]
    (log/warn (:form-params request))
    (let [items (or (:items coll) {})
          new-items (assoc items project-to-add "1")]
      (log/debug "Before" items)
      (log/debug "After" new-items)
      (actions/update-collection db id new-items)
      (redirect (format "/collections/%s%s" id (if is-json "?json=1" ""))))))

(defn rm-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        id (BigInteger. (id-of request))]
    (actions/delete-collection db id)
    (if is-json
      (json-resp {:ok 1})
      (redirect "/collections" ))
  ))

(defn del-p-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        id (BigInteger. (id-of request))
        body (body-of request)
        project-form-param (get (:form-params request) "project")
        project-to-rm (if-not (nil? project-form-param) project-form-param (get body "project"))
        coll (first (actions/get-collection db id))]
    (log/warn (:form-params request))
    (let [items (:items coll)
          new-items (dissoc items project-to-rm )]
      (log/debug "Before" items)
      (log/debug "After" new-items)
      (actions/update-collection db id new-items)
      (redirect (format "/collections/%s%s" id (if is-json "?json=1" ""))))))

(def submit-form "$(this).parent('form').submit();return false;")

(defn render-delete-action-button
  [id item]
  [:form {:method "POST" :action (format "/collections/%s/delete" id)}
    [:input {:type "hidden" :name :project :value item}]
    [:a.btn.btn-default.btn-xs.pull-right {:href "#" :onclick submit-form }
      [:i.fa.fa-minus-circle.red]]])

(defhtml render-collection
  [c projects detailed]
    [:div.panel.panel-default
      [:div.panel-heading
        [:h3 {:style "display:inline;"}
          [:a {:href (str "/collections/" (:id c))} (:name c)]
        [:div.button-group.pull-right.actions
          [:form { :action (str "/collections/" (:id c) "/star") :data-remote "true"  :method "POST" }
            [:a.gh-btn {:href "#" :onclick submit-form}
              [:i.fa.fa-star] " Star "]]

          [:a.gh-count {:style "display:block" :href (str "/collections/" (:id c) "/stargazers")} (:stargazers c)]
          [:form { :action (str "/collections/" (:id c) "/fork") :data-remote "true" :data-redirect :true :method "POST" }
            [:a.gh-btn {:href "#" :onclick submit-form}
              [:i.fa.fa-code-fork]
              [:span.gh-text "Fork"]]]
          [:a.gh-count {:style "display:block" :href (str "/collections/" (:id c) "/forks")} (:forks c)]]]]

      [:div.panel-body
        [:p (:description c)]
        (for [item (keys (:items c))]
          (let [el (get item (:items c))
                proj (get projects item)]
            [:div.row.coll-row
              [:div.col-lg-12
                [:h4
                  [:a.pull-left.gray {:href (str "/p/" (str item el))} (str item el) ]]
                  (render-delete-action-button (:id c) item)]
            [:div.col-lg-8
                [:p [:b (:watchers proj)] " follows this project"]
                [:p (:description proj)]
                [:hr]
                ]
                  ))]
        [:div.panel-footer
          [:a.green {:href "#" :onclick "$(this).parent().find('form').toggle()"} "Add New"]
          [:form {:method "POST" :action (format "/collections/%s/add" (:id c)) :style "display:none;"}
            [:div#remote
              [:input.typeahead {:type "text" :name :project :placeholder "Type to find project"}]]
              [:a.btn.btn-default {:href "#" :rel "nofollow" :onclick submit-form} "Add"]]

          [:a.red.pull-right {:href (format "/collections/%s/rm" (:id c)) :rel "nofollow" } "Delete"]
              ]])

(defn load-projects-of-collections
  [db project-items]
  (let [projects (vec (keys project-items))]
    (log/warn project-items)
    (log/warn projects)
    (let [project-map (apply merge (map #(hash-map (:full_name %) %) (actions/load-projects-by-id db projects)))]
      (log/warn project-map)
      project-map
    ))
  )

(defn get-coll
  [{:keys [db event-chan redis conf]} request]
  (let [{:keys [host id body json? user platform
                req-id limit-by url hosted-pl]} (common-of request)
        id (BigInteger. id)
        coll (first (actions/get-collection db id))
        coll-extra (actions/get-collection-extra db id)
        coll (merge coll {:stargazers (count (:stargazers coll-extra)) :forks  (count (:forks coll-extra))})
        coll-followers (partial actions/load-users-by-id db)
        projects (load-projects-of-collections db (:items coll))
        coll-name (:name coll)]
    (log/warn coll-extra)
    (if json?
      (json-resp coll)
      (layout {:website host :title (format "%s - Collections of %s projects" coll-name platform)
                :keywords (format "Developer Community, Top Projects, Top %s Projects, Projects of %s" platform coll-name) }
        [:div.row
          [:div.col-lg-6
            (render-collection coll projects true)]
        [:div.col-lg-6
        (let [stargazers (coll-followers (vec (:stargazers coll-extra)))]
          (panelx "Stargazers" [:a {:href (format "/collections/%s/stargazers" id) :style "text-align:center;display:block;"} "See more"] ""
            [:div.row.user-list
              (for [x (reverse (sort-by :followers stargazers))]
                [:div.col-lg-6.user-thumb
                  (render-user x)])]))]]))))

(defn create-coll
  [{:keys [db event-chan redis conf]} request]
  (let [body (body-of request)
        data (select-keys (mapkeyw body) [:name])
        new-id (id-generate)]
    (actions/create-collection db (merge {:id new-id} data))
    (json-resp {:id (str new-id)
                :url (format "/collections/%s" new-id) } )))

(defn find-extra-of
  [coll-extras x]
  (let [candidate (first (filter #(= (:id %) (:id x)) coll-extras))
        data (or candidate { :stargazers #{} :forks #{}})]

    (merge x {:stargazers (count (:stargazers data))
              :forks (count (:forks data))})))

(defn load-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        hosted-pl     (host->pl->lang host)
        platform      (or (or hosted-pl (pl->lang (id-of request :platform)) ) "Python")
        colls (actions/load-collections db 10)
        coll-extras (actions/get-collection-extras-by-id db (map :id colls))]
    (let [colls (map (partial find-extra-of coll-extras) colls)]
      (log/warn colls)
      (if is-json
        (json-resp colls)
        (layout {:website host :title (format "Collections of %s projects" platform)}
          [:div.row
            [:div.col-lg-3
              (left-menu host platform "collections")
            ]
            [:div.col-lg-9
              [:div.jumbotron
                [:h3 "Create a List/Collection to group your projects together "]
                [:form {:action "/collections/create" :method "POST" :data-remote "true" :data-redirect "true" :id :create-coll}
                  [:div.form-group
                  [:input.form-control {:type :text :name :name }]
                  [:input {:type :hidden :name :test :value 1}]]
                  [:button.btn.btn-primary {:type :submit} "Create"]]]
              [:div.row
                (for [c colls]
                  [:div.col-lg-6
                    (render-collection c {} false)])]]])))))

(defn star-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json? (type-of request :json)
        id (BigInteger. (id-of request))
        user-id (str (whois request))
        coll (first (actions/get-collection db id))
        user-set #{user-id}]
    (log/warn "[STAR]" id user-id user-set)
    (when (!nil? coll)
      (actions/star-collection db id user-set))
    (json-resp {:ok 1})
  ))

(defn fork-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json? (type-of request :json)
        id (BigInteger. (id-of request))
        user-id (whois request)]
    (if-let [coll (first (actions/get-collection db id))]
      (let [new-id (id-generate)
            new-coll (merge coll {:id new-id :user_id user-id})]
        (actions/create-collection db new-coll)
        (actions/add-collection-fork db id new-id)
        (json-resp {:id new-id :url (str "/collections/" new-id) }))
      (json-resp {:ok 1}))))

(defn coll-stargazers
  [{:keys [db event-chan redis conf]} request])

(defn coll-forks
  [{:keys [db event-chan redis conf]} request])

(ns hsm.controllers.coll
  (:require
    [cheshire.core :refer :all]
    [clojure.tools.logging :as log]
    [hiccup.def                   :refer [defhtml]]
    [hsm.actions :as actions]
    [hsm.views :refer [layout panel render-user left-menu panelx]]
    [hsm.ring :refer [json-resp html-resp redirect]]
    [hsm.utils :refer :all]))

(defn add-p-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        id (BigInteger. (id-of request))
        body (body-of request)
        project-form-param (get (:form-params request) "project")
        project-to-add (if-not (nil? project-form-param) project-form-param (get body "project"))
        coll (first (actions/get-collection db id))]
    (log/warn (:form-params request))
    (let [items (or (:items coll) {})
          new-items (assoc items project-to-add "1")]
      (log/debug "Before" items)
      (log/debug "After" new-items)
      (actions/update-collection db id new-items)
      (redirect (format "/collections/%s%s" id (if is-json "?json=1" ""))))))

(defn rm-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        id (BigInteger. (id-of request))]
    (actions/delete-collection db id)
    (if is-json
      (json-resp {:ok 1})
      (redirect "/collections" ))
  ))

(defn del-p-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        id (BigInteger. (id-of request))
        body (body-of request)
        project-form-param (get (:form-params request) "project")
        project-to-rm (if-not (nil? project-form-param) project-form-param (get body "project"))
        coll (first (actions/get-collection db id))]
    (log/warn (:form-params request))
    (let [items (:items coll)
          new-items (dissoc items project-to-rm )]
      (log/debug "Before" items)
      (log/debug "After" new-items)
      (actions/update-collection db id new-items)
      (redirect (format "/collections/%s%s" id (if is-json "?json=1" ""))))))

(def submit-form "$(this).parent('form').submit();return false;")

(defn render-delete-action-button
  [id item]
  [:form {:method "POST" :action (format "/collections/%s/delete" id)}
    [:input {:type "hidden" :name :project :value item}]
    [:a.btn.btn-default.btn-xs.pull-right {:href "#" :onclick submit-form }
      [:i.fa.fa-minus-circle.red]]])

(defhtml render-collection
  [c projects detailed]
    [:div.panel.panel-default
      [:div.panel-heading
        [:h3 {:style "display:inline;"}
          [:a {:href (str "/collections/" (:id c))} (:name c)]
        [:div.button-group.pull-right.actions
          [:form { :action (str "/collections/" (:id c) "/star") :data-remote "true"  :method "POST" }
            [:a.gh-btn {:href "#" :onclick submit-form}
              [:i.fa.fa-star] " Star "]]

          [:a.gh-count {:style "display:block" :href (str "/collections/" (:id c) "/stargazers")} (:stargazers c)]
          [:form { :action (str "/collections/" (:id c) "/fork") :data-remote "true" :data-redirect :true :method "POST" }
            [:a.gh-btn {:href "#" :onclick submit-form}
              [:i.fa.fa-code-fork]
              [:span.gh-text "Fork"]]]
          [:a.gh-count {:style "display:block" :href (str "/collections/" (:id c) "/forks")} (:forks c)]]]]

      [:div.panel-body
        [:p (:description c)]
        (for [item (keys (:items c))]
          (let [el (get item (:items c))
                proj (get projects item)]
            [:div.row.coll-row
              [:div.col-lg-12
                [:h4
                  [:a.pull-left.gray {:href (str "/p/" (str item el))} (str item el) ]]
                  (render-delete-action-button (:id c) item)]
            [:div.col-lg-8
                [:p [:b (:watchers proj)] " follows this project"]
                [:p (:description proj)]
                [:hr]
                ]
                  ]))
        [:div.panel-footer
          [:a.green {:href "#" :onclick "$(this).parent().find('form').toggle()"} "Add New"]
          [:form {:method "POST" :action (format "/collections/%s/add" (:id c)) :style "display:none;"}
            [:div#remote
              [:input.typeahead {:type "text" :name :project :placeholder "Type to find project"}]]
              [:a.btn.btn-default {:href "#" :rel "nofollow" :onclick submit-form} "Add"]]

          [:a.red.pull-right {:href (format "/collections/%s/rm" (:id c)) :rel "nofollow" } "Delete"]
              ]])

(defn load-projects-of-collections
  [db project-items]
  (let [projects (vec (keys project-items))]
    (log/warn project-items)
    (log/warn projects)
    (let [project-map (apply merge (map #(hash-map (:full_name %) %) (actions/load-projects-by-id db projects)))]
      (log/warn project-map)
      project-map
    ))
  )

(defn get-coll
  [{:keys [db event-chan redis conf]} request]
  (let [{:keys [host id body json? user platform
                req-id limit-by url hosted-pl]} (common-of request)
        id (BigInteger. id)
        coll (first (actions/get-collection db id))
        coll-extra (actions/get-collection-extra db id)
        coll (merge coll {:stargazers (count (:stargazers coll-extra)) :forks  (count (:forks coll-extra))})
        coll-followers (partial actions/load-users-by-id db)
        projects (load-projects-of-collections db (:items coll))
        coll-name (:name coll)]
    (log/warn coll-extra)
    (if json?
      (json-resp coll)
      (layout {:website host :title (format "%s - Collections of %s projects" coll-name platform)
                :keywords (format "Developer Community, Top Projects, Top %s Projects, Projects of %s" platform coll-name) }
        [:div.row
          [:div.col-lg-6
            (render-collection coll projects true)]
        [:div.col-lg-6
        (let [stargazers (coll-followers (vec (:stargazers coll-extra)))]
          (panelx "Stargazers" [:a {:href (format "/collections/%s/stargazers" id) :style "text-align:center;display:block;"} "See more"] ""
            [:div.row.user-list
              (for [x (reverse (sort-by :followers stargazers))]
                [:div.col-lg-6.user-thumb
                  (render-user x)])]))]]))))

(defn create-coll
  [{:keys [db event-chan redis conf]} request]
  (let [body (body-of request)
        data (select-keys (mapkeyw body) [:name])
        new-id (id-generate)]
    (actions/create-collection db (merge {:id new-id} data))
    (json-resp {:id (str new-id)
                :url (format "/collections/%s" new-id) } )))

(defn find-extra-of
  [coll-extras x]
  (let [candidate (first (filter #(= (:id %) (:id x)) coll-extras))
        data (or candidate { :stargazers #{} :forks #{}})]

    (merge x {:stargazers (count (:stargazers data))
              :forks (count (:forks data))})))

(defn load-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json (type-of request :json)
        hosted-pl     (host->pl->lang host)
        platform      (or (or hosted-pl (pl->lang (id-of request :platform)) ) "Python")
        colls (actions/load-collections db 10)
        coll-extras (actions/get-collection-extras-by-id db (map :id colls))]
    (let [colls (map (partial find-extra-of coll-extras) colls)]
      (log/warn colls)
      (if is-json
        (json-resp colls)
        (layout {:website host :title (format "Collections of %s projects" platform)}
          [:div.row
            [:div.col-lg-3
              (left-menu host platform "collections")
            ]
            [:div.col-lg-9
              [:div.jumbotron
                [:h3 "Create a List/Collection to group your projects together "]
                [:form {:action "/collections/create" :method "POST" :data-remote "true" :data-redirect "true" :id :create-coll}
                  [:div.form-group
                  [:input.form-control {:type :text :name :name }]
                  [:input {:type :hidden :name :test :value 1}]]
                  [:button.btn.btn-primary {:type :submit} "Create"]]]
              [:div.row
                (for [c colls]
                  [:div.col-lg-6
                    (render-collection c {} false)])]]])))))

(defn star-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json? (type-of request :json)
        id (BigInteger. (id-of request))
        user-id (str (whois request))
        coll (first (actions/get-collection db id))
        user-set #{user-id}]
    (log/warn "[STAR]" id user-id user-set)
    (when (!nil? coll)
      (actions/star-collection db id user-set))
    (json-resp {:ok 1})
  ))

(defn fork-coll
  [{:keys [db event-chan redis conf]} request]
  (let [host (host-of request)
        is-json? (type-of request :json)
        id (BigInteger. (id-of request))
        user-id (whois request)]
    (if-let [coll (first (actions/get-collection db id))]
      (let [new-id (id-generate)
            new-coll (merge coll {:id new-id :user_id user-id})]
        (actions/create-collection db new-coll)
        (actions/add-collection-fork db id new-id)
        (json-resp {:id new-id :url (str "/collections/" new-id) }))
      (json-resp {:ok 1}))))

(defn coll-stargazers
  [{:keys [db event-chan redis conf]} request])

(defn coll-forks
  [{:keys [db event-chan redis conf]} request])

fix paranthesis

fix paranthesis


; Copyright © 2012 Alexander Yakushev.
; All rights reserved.
;
; This program and the accompanying materials are made available under the
; terms of the Eclipse Public License v1.0 which accompanies this distribution,
; and is available at <http://www.eclipse.org/legal/epl-v10.html>.
;
; By using this software in any fashion, you are agreeing to be bound by the
; terms of this license.  You must not remove this notice, or any other, from
; this software.

(ns neko.application
  "Contains tools to create and manipulate Application instances."
  (:require neko.context neko.init)
  (:use [neko.-utils :only [simple-name]]
        [neko.resource :only [package-name]]
        [neko.threading :only [init-threading]])
  (:import android.app.Application
           android.content.Context))

(defmacro defapplication
  [& args]
  (throw (Exception. "defapplication is deprecated, please define
  Application class from Java. Default `:on-create` moved to
  `init-application`.")))

(defn init-application
  "Performs necessary preparations for Neko and REPL development."
  [context & {:keys [extends prefix on-create nrepl-port]
              :or {extends android.app.Application
                   prefix (str (simple-name name) "-")}}]
  (alter-var-root #'neko.context/context (constantly context))
  (alter-var-root #'package-name (constantly (.getPackageName context)))
  (neko.init/init context :port (or nrepl-port 9999))
  (init-threading))

; Copyright © 2012 Alexander Yakushev.
; All rights reserved.
;
; This program and the accompanying materials are made available under the
; terms of the Eclipse Public License v1.0 which accompanies this distribution,
; and is available at <http://www.eclipse.org/legal/epl-v10.html>.
;
; By using this software in any fashion, you are agreeing to be bound by the
; terms of this license.  You must not remove this notice, or any other, from
; this software.

(ns neko.application
  "Contains tools to create and manipulate Application instances."
  (:require neko.context neko.init)
  (:use [neko.-utils :only [simple-name]]
        [neko.resource :only [package-name]]
        [neko.threading :only [init-threading]])
  (:import android.app.Application
           android.content.Context))

(defmacro defapplication
  [& args]
  (throw (Exception. "defapplication is deprecated, please define
  Application class from Java. Default `:on-create` moved to
  `init-application`.")))

(def ^{:doc "Represents if initialization was already performed."
       :private true}
  initialized? (atom false))

(defn init-application
  "Performs necessary preparations for Neko and REPL development."
  [context & {:keys [extends prefix on-create nrepl-port]
              :or {extends android.app.Application
                   prefix (str (simple-name name) "-")}}]
  (when-not @initialized?
    (alter-var-root #'neko.context/context (constantly context))
    (alter-var-root #'package-name (constantly (.getPackageName context)))
    (neko.init/init context :port (or nrepl-port 9999))
    (init-threading)
    (reset! initialized? true)))

Allow initialization to be performed only once


(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 disable-quit-handler!
  "Disables the default quit handler 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])))))))

(defn add-listener!
  "Sets callbacks for window events."
  [window]
  (disable-quit-handler!)
  (.addWindowListener window
    (proxy [WindowAdapter] []
      (windowActivated [e]
        (shortcuts/toggle-hint! @editors/tabs false)
        (shortcuts/toggle-hints! @ui/root false)
        (ui/update-project-tree!))
      (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 disable-quit-handler!
  "Disables the default quit handler 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])))))))

(defn add-listener!
  "Sets callbacks for window events."
  [window]
  (disable-quit-handler!)
  (.addWindowListener window
    (proxy [WindowAdapter] []
      (windowActivated [e]
        ; force hints to hide
        (reset! shortcuts/is-down? false)
        (shortcuts/toggle-hint! @editors/tabs false)
        (shortcuts/toggle-hints! @ui/root false)
        ; update the tree to reflect any changes in the filesystem
        (ui/update-project-tree!))
      (windowClosing [e]
        (confirm-exit-app!)))))

Fix tab displaying when they shouldn't

Fix tab displaying when they shouldn't


(ns metabase.api.meta.field
  (:require [compojure.core :refer [GET PUT POST]]
            [medley.core :as medley]
            [metabase.api.common :refer :all]
            [metabase.db :refer :all]
            [metabase.db.metadata-queries :as metadata]
            (metabase.models [hydrate :refer [hydrate]]
                             [field :refer [Field] :as field]
                             [field-values :refer [FieldValues create-field-values create-field-values-if-needed field-should-have-field-values?]]
                             [foreign-key :refer [ForeignKey] :as fk])
            [metabase.util :as u]))

(defannotation FieldSpecialType
  "Param must be a valid `Field` special type."
  [symb value :nillable]
  (checkp-contains? field/special-types symb (keyword value)))

(defannotation FieldType
  "Param must be a valid `Field` base type."
  [symb value :nillable]
  (checkp-contains? field/field-types symb (keyword value)))

(defannotation ForeignKeyRelationship
  "Param must be a valid `ForeignKey` relationship: one of `1t1` (one-to-one)m
   `Mt1` (many-to-one), or `MtM` (many-to-many)."
  [symb value :nillable]
  (checkp-contains? fk/relationships symb (keyword value)))

(defendpoint GET "/:id"
  "Get `Field` with ID."
  [id]
  (->404 (sel :one Field :id id)
         read-check
         (hydrate [:table :db])))

(defendpoint PUT "/:id"
  "Update `Field` with ID."
  [id :as {{:keys [field_type special_type preview_display description]} :body}]
  {field_type FieldType
   special_type FieldSpecialType}
  (write-check Field id)
  (check-500 (upd-non-nil-keys Field id
               :field_type      field_type
               :special_type    special_type
               :preview_display preview_display
               :description     description))
  (sel :one Field :id id))

(defendpoint GET "/:id/summary"
  "Get the count and distinct count of `Field` with ID."
  [id]
  (let-404 [field (sel :one Field :id id)]
    (read-check field)
    [[:count     (metadata/field-count field)]
     [:distincts (metadata/field-distinct-count field)]]))

(defendpoint GET "/:id/foreignkeys"
  "Get `ForeignKeys` whose origin is `Field` with ID."
  [id]
  (read-check Field id)
  (-> (sel :many ForeignKey :origin_id id)
      (hydrate [:origin :table] [:destination :table])))

(defendpoint POST "/:id/foreignkeys"
  "Create a new `ForeignKey` relationgship with `Field` with ID as the origin."
  [id :as {{:keys [target_field relationship]} :body}]
  {target_field Required, relationship [Required ForeignKeyRelationship]}
  (write-check Field id)
  (write-check Field target_field)
  (-> (ins ForeignKey
        :origin_id id
        :destination_id target_field
        :relationship relationship)
      (hydrate [:origin :table] [:destination :table])))

(defendpoint GET "/:id/values"
  "If `Field`'s special type is `category`/`city`/`state`/`country`, or its base type is `BooleanField`, return
   all distinct values of the field, and a map of human-readable values defined by the user."
  [id]
  (let-404 [field (sel :one Field :id id)]
    (read-check field)
    (if-not (field-should-have-field-values? field)
      {:values {} :human_readable_values {}}
      (create-field-values-if-needed field))))

(defendpoint POST "/:id/value_map_update"
  "Update the human-readable values for a `Field` whose special type is `category`/`city`/`state`/`country`
   or whose base type is `BooleanField`."
  [id :as {{:keys [fieldId values_map]} :body}] ; WTF is the reasoning behind client passing fieldId in POST params?
  {values_map [Required Dict]}
  (let-404 [field (sel :one Field :id id)]
    (write-check field)
    (check (field-should-have-field-values? field)
      [400 "You can only update the mapped values of a Field whose 'special_type' is 'category'/'city'/'state'/'country' or whose 'base_type' is 'BooleanField'."])
    (if-let [field-values-id (sel :one :id FieldValues :field_id id)]
      (check-500 (upd FieldValues field-values-id
                   :human_readable_values values_map))
      (create-field-values field values_map)))
  {:status :success})

(define-routes)

(ns metabase.api.meta.field
  (:require [compojure.core :refer [GET PUT POST]]
            [medley.core :as medley]
            [metabase.api.common :refer :all]
            [metabase.db :refer :all]
            [metabase.db.metadata-queries :as metadata]
            (metabase.models [hydrate :refer [hydrate]]
                             [field :refer [Field] :as field]
                             [field-values :refer [FieldValues create-field-values create-field-values-if-needed field-should-have-field-values?]]
                             [foreign-key :refer [ForeignKey] :as fk])
            [metabase.util :as u]))

(defannotation FieldSpecialType
  "Param must be a valid `Field` special type."
  [symb value :nillable]
  (checkp-contains? field/special-types symb (keyword value)))

(defannotation FieldType
  "Param must be a valid `Field` base type."
  [symb value :nillable]
  (checkp-contains? field/field-types symb (keyword value)))

(defannotation ForeignKeyRelationship
  "Param must be a valid `ForeignKey` relationship: one of `1t1` (one-to-one)m
   `Mt1` (many-to-one), or `MtM` (many-to-many)."
  [symb value :nillable]
  (checkp-contains? fk/relationships symb (keyword value)))

(defendpoint GET "/:id"
  "Get `Field` with ID."
  [id]
  (->404 (sel :one Field :id id)
         read-check
         (hydrate [:table :db])))

(defendpoint PUT "/:id"
  "Update `Field` with ID."
  [id :as {{:keys [field_type special_type preview_display description]} :body}]
  {field_type FieldType
   special_type FieldSpecialType}
  (write-check Field id)
  (check-500 (upd Field id
               :field_type      field_type
               :special_type    special_type
               :preview_display preview_display
               :description     description))
  (sel :one Field :id id))

(defendpoint GET "/:id/summary"
  "Get the count and distinct count of `Field` with ID."
  [id]
  (let-404 [field (sel :one Field :id id)]
    (read-check field)
    [[:count     (metadata/field-count field)]
     [:distincts (metadata/field-distinct-count field)]]))

(defendpoint GET "/:id/foreignkeys"
  "Get `ForeignKeys` whose origin is `Field` with ID."
  [id]
  (read-check Field id)
  (-> (sel :many ForeignKey :origin_id id)
      (hydrate [:origin :table] [:destination :table])))

(defendpoint POST "/:id/foreignkeys"
  "Create a new `ForeignKey` relationgship with `Field` with ID as the origin."
  [id :as {{:keys [target_field relationship]} :body}]
  {target_field Required, relationship [Required ForeignKeyRelationship]}
  (write-check Field id)
  (write-check Field target_field)
  (-> (ins ForeignKey
        :origin_id id
        :destination_id target_field
        :relationship relationship)
      (hydrate [:origin :table] [:destination :table])))

(defendpoint GET "/:id/values"
  "If `Field`'s special type is `category`/`city`/`state`/`country`, or its base type is `BooleanField`, return
   all distinct values of the field, and a map of human-readable values defined by the user."
  [id]
  (let-404 [field (sel :one Field :id id)]
    (read-check field)
    (if-not (field-should-have-field-values? field)
      {:values {} :human_readable_values {}}
      (create-field-values-if-needed field))))

(defendpoint POST "/:id/value_map_update"
  "Update the human-readable values for a `Field` whose special type is `category`/`city`/`state`/`country`
   or whose base type is `BooleanField`."
  [id :as {{:keys [fieldId values_map]} :body}] ; WTF is the reasoning behind client passing fieldId in POST params?
  {values_map [Required Dict]}
  (let-404 [field (sel :one Field :id id)]
    (write-check field)
    (check (field-should-have-field-values? field)
      [400 "You can only update the mapped values of a Field whose 'special_type' is 'category'/'city'/'state'/'country' or whose 'base_type' is 'BooleanField'."])
    (if-let [field-values-id (sel :one :id FieldValues :field_id id)]
      (check-500 (upd FieldValues field-values-id
                   :human_readable_values values_map))
      (create-field-values field values_map)))
  {:status :success})

(define-routes)

allow `Field.special_type` to be unset via API :unamused:


(ns ^{:author "Vladislav Bauer"}
  lein-typescript.plugin
  (:require [leiningen.compile]
            [lein-npm.plugin :as npm]
            [robert.hooke :as hooke]
            [lein-typescript.core :as core]))

; Internal API: Configuration

(def ^:private DEF_TYPESCRIPT_DEP "typescript")
(def ^:private DEF_TYPESCRIPT_VER ">=1.5.4")

; Internal API: Middlewares

(defn- typescript? [dep]
  (= (str (first dep)) DEF_TYPESCRIPT_DEP))

(defn- find-typescript-deps [deps]
  (keep-indexed #(when (typescript? %2) %1) deps))

(defn- ensure-typescript [deps version]
  (let [typescript-matches (find-typescript-deps deps)
        new-dep [DEF_TYPESCRIPT_DEP (or version DEF_TYPESCRIPT_VER)]]
    (if (empty? typescript-matches)
      (conj deps new-dep) deps)))

; External API: Middlewares

(defn middleware [project]
  (let [version (get-in project [:typescript :version])]
    (update-in project [:node-dependencies]
               #(vec (ensure-typescript % version)))))

; External API: Hooks

(defn compile-hook [task project & args]
  (let [res (apply task project args)]
    (core/typescript project args)
    res))

(defn activate []
  (npm/hooks)
  (hooke/add-hook #'leiningen.compile/compile #'compile-hook))

(ns ^{:author "Vladislav Bauer"}
  lein-typescript.plugin
  (:require [leiningen.compile]
            [lein-npm.plugin :as npm]
            [robert.hooke :as hooke]
            [lein-typescript.core :as core]))

; Internal API: Configuration

(def ^:private DEF_TYPESCRIPT_DEP "typescript")
(def ^:private DEF_TYPESCRIPT_VER ">=1.6.2")

; Internal API: Middlewares

(defn- typescript? [dep]
  (= (str (first dep)) DEF_TYPESCRIPT_DEP))

(defn- find-typescript-deps [deps]
  (keep-indexed #(when (typescript? %2) %1) deps))

(defn- ensure-typescript [deps version]
  (let [typescript-matches (find-typescript-deps deps)
        new-dep [DEF_TYPESCRIPT_DEP (or version DEF_TYPESCRIPT_VER)]]
    (if (empty? typescript-matches)
      (conj deps new-dep) deps)))

; External API: Middlewares

(defn middleware [project]
  (let [version (get-in project [:typescript :version])]
    (update-in project [:node-dependencies]
               #(vec (ensure-typescript % version)))))

; External API: Hooks

(defn compile-hook [task project & args]
  (let [res (apply task project args)]
    (core/typescript project args)
    res))

(defn activate []
  (npm/hooks)
  (hooke/add-hook #'leiningen.compile/compile #'compile-hook))

Update Typescript (1.6.2)

Update Typescript (1.6.2)


(ns klangmeister.processing
  (:require
    [klangmeister.eval :as eval]
    [klangmeister.music :as music]
    [klangmeister.instruments :as instrument]
    [klangmeister.actions :as action]
    [klangmeister.framework :as framework]
    [cljs.js :as cljs]))

(extend-protocol framework/Action
  action/Refresh
  (process [{expr-str :text} _ {original-music :music :as state}]
    (let [{:keys [value error]} (eval/uate expr-str)
          music (or value original-music)]
      (-> state
          (assoc :error error)
          (assoc :text expr-str)
          (assoc :music music))))

  action/Stop
  (process [_ handle! state]
    (assoc state :looping? false))

  action/Play
  (process [this handle! state]
    (framework/process (action/->Loop) handle! (assoc state :looping? true)))

  action/Loop
  (process [this handle! {notes :music :as state}]
    (when (:looping? state)
      (music/play-on! instrument/beep! notes)
      (let [duration (->> notes (map :duration) (reduce +) (* 1000))]
        (js/setTimeout #(handle! this) duration)))
    state))

(ns klangmeister.processing
  (:require
    [klangmeister.eval :as eval]
    [klangmeister.music :as music]
    [klangmeister.instruments :as instrument]
    [klangmeister.actions :as action]
    [klangmeister.framework :as framework]
    [cljs.js :as cljs]))

(extend-protocol framework/Action
  action/Refresh
  (process [{expr-str :text} _ {original-music :music :as state}]
    (let [{:keys [value error]} (eval/uate expr-str)
          music (or value original-music)]
      (-> state
          (assoc :error error)
          (assoc :text expr-str)
          (assoc :music music))))

  action/Stop
  (process [_ handle! state]
    (assoc state :looping? false))

  action/Play
  (process [this handle! state]
    (framework/process (action/->Loop) handle! (assoc state :looping? true)))

  action/Loop
  (process [this handle! {notes :music :as state}]
    (when (:looping? state)
      (music/play-on! instrument/beep! notes)
      (let [duration (->> notes
                          (map (fn [{:keys [time duration]}] (+ time duration)))
                          (apply max)
                          (* 1000))]
        (js/setTimeout #(handle! this) duration)))
    state))

Adjust duration calculation for polyphony.