(ns cruncher.views
  (:require [om.next :as om :refer-macros [defui]]
            [om.dom :as dom :include-macros true]
            [goog.dom :as gdom]
            [cruncher.communication.auth :as auth]
            [cruncher.communication.main :as com]
            [cruncher.communication.progress :as progress]
            [cruncher.shredder.main :as shredder]
            [cruncher.utils.extensions]
            [cruncher.utils.lib :as lib]
            [cruncher.utils.views :as vlib]))

;;;; Controls
(defui Controls
  Object
  (render [this]
    (dom/div nil
             (dom/span #js {:className "pull-right"} (vlib/loader (om/props this)))
             (vlib/button-primary #(com/route :get-all-pokemon) "Get all Pokemon")
             " "
             (vlib/button-primary #(shredder/power-on this) (vlib/fa-icon "fa-eraser") " Crunch selected Pokemon")
             (dom/br nil)
             (dom/br nil)
             (dom/div nil (progress/progress-bar (om/props this))))))
(def controls (om/factory Controls))

;;;; Messages
(defui ErrorMessage
  Object
  (render [this]
    (when (lib/error?)
      (dom/div #js {:className "alert alert-warning"}
               (dom/a #js {:href         "#"
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (dom/strong nil "Error: ")
               (lib/get-error)))))
(def error-message (om/factory ErrorMessage))

(defui InfoMessage
  Object
  (render [this]
    (when (lib/info?)
      (dom/div #js {:className "alert alert-success"}
               (dom/a #js {:href         "#"
                           :onClick      #(lib/info! nil)
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (lib/get-info)))))
(def info-message (om/factory InfoMessage))

;;;; Poketable
(defui PokeTableEntry
  Object
  (render [this]
    (let [pokemon (om/props this)]
      (dom/tr nil
              (dom/td nil
                      (dom/div #js {:className "checkbox"}
                               (dom/label nil
                                          (dom/input #js {:className "poketable-checkbox"
                                                          :type      "checkbox"
                                                          :value     (:id pokemon)}))))
              (dom/td nil (if (:favorite pokemon) (vlib/fa-icon "fa-star") (vlib/fa-icon "fa-star-o")))
              (dom/td nil (:pokemon_id pokemon))
              (dom/td nil (:name pokemon))
              (dom/td nil (:nickname pokemon))
              (dom/td nil (:cp pokemon))
              (dom/td nil (:health pokemon))
              (dom/td nil (:individual_percentage pokemon))
              (dom/td nil (:individual_attack pokemon))
              (dom/td nil (:individual_defense pokemon))
              (dom/td nil (:individual_stamina pokemon))))))
(def poketable-entry (om/factory PokeTableEntry {}))

(defui PokeTable
  Object
  (render [this]
    (dom/div #js {:id "poketable"}
             (dom/div nil (controls (om/props this)))
             (dom/br nil)
             (dom/table #js {:className "table table-hover"}
                        (dom/thead nil
                                   (dom/tr nil
                                           (dom/th nil "")
                                           (vlib/sortable-table-header :favorite "Fav.")
                                           (vlib/sortable-table-header :pokemon_id "#")
                                           (vlib/sortable-table-header :name "Name")
                                           (vlib/sortable-table-header :nickname "Nickname")
                                           (vlib/sortable-table-header :cp "CP")
                                           (vlib/sortable-table-header :health "Health")
                                           (vlib/sortable-table-header :individual_percentage "IV % Perfect")
                                           (vlib/sortable-table-header :individual_attack "IV Attack")
                                           (vlib/sortable-table-header :individual_defense "IV Defense")
                                           (vlib/sortable-table-header :individual_stamina "IV Stamina")))
                        (apply dom/tbody nil
                               (map #(poketable-entry (lib/merge-react-key %)) (lib/inventory-pokemon))))
             #_(let [jquery (js* "$")]
               (.stickyTableHeaders (jquery "#poketable"))))))
(def poketable (om/factory PokeTable {}))

;;;; Other
(defui Header
  Object
  (render [this]
    (dom/div nil
             (dom/div #js {:className "page-header"}
                      (dom/div #js {:className "pull-right"}
                               (vlib/login-indicator (om/props this)))
                      (dom/h1 nil "Poké-Cruncher"))
             (dom/ul nil
                     (dom/li nil
                             "If you have 2-factor Auth enabled in your Google Account, please add an "
                             (dom/a #js {:href   "https://security.google.com/settings/security/apppasswords?pli=1"
                                         :target "_blank"}
                                    "app-password")
                             " to your account")
                     (dom/li nil "Click on the table headers to sort the data")
                     (dom/li nil "Crunching Pokemon really means you're sending them away -- "
                             (dom/strong nil "there is no possibility to get them back!!!"))
                     (dom/li nil "Enter a location near you to prevent a softban.")
                     (dom/li nil "Automated Pokemon crunching takes between 2 and 3 seconds per pokemon to prevent robotic behaviour."))
             (dom/hr nil))))
(def header (om/factory Header))

(defn commit-component-state
  "Set local state of view, parse the value of the target of val."
  [this key val]
  (cond
    (= (type val) js/Event) (om/update-state! this assoc key (.. val -target -value))
    (= (type val) js/String) (om/update-state! this assoc key val)
    :else (om/update-state! this assoc key (.. val -target -value))))

(defn google-ptc-switch [this]
  (dom/form #js {:id   "google-ptc-switch"
                 :role "form"}
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(commit-component-state this :service "google")
                                       :name    "google-ptc-switch"})
                       "Google")
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(commit-component-state this :service "ptc")
                                       :name    "google-ptc-switch"})
                       "Pokemon Trainer Club")))

(defui Login
  Object
  (render [this]
    ;; TODO return empty string if om/get-state is empty
    (let [email (om/get-state this :email)
          password (om/get-state this :password)
          location (om/get-state this :location)
          service (om/get-state this :service)]
      (dom/div #js {:className "row"}
               (dom/div #js {:className "col-md-6 col-md-offset-3"}
                        (vlib/panel-wrapper
                          (dom/div nil
                                   (dom/h5 #js {:className "text-center"} "Login")
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-user fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(commit-component-state this :email %)
                                                            :value       email
                                                            :placeholder "email / PTC Username"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-key fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(commit-component-state this :password %)
                                                            :value       password
                                                            :type        "password"
                                                            :placeholder "password"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-map-marker fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(commit-component-state this :location %)
                                                            :value       location
                                                            :placeholder "Düsseldorf, Germany"}))
                                   (google-ptc-switch this)
                                   (vlib/button-primary #(auth/login email password location service) "Login"))))))))
(def login (om/factory Login))

(defn view-dispatcher
  "Dispatch current template in main view by the app state."
  [this]
  (let [view (lib/current-view)]
    (cond
      (= view :login) (login (om/props this))
      (not (lib/logged-in?)) (login (om/props this))
      :else (poketable (om/props this)))))

(defui Main
  Object
  (render [this]
    (dom/div nil
             (dom/div nil (header (om/props this)))
             (dom/div nil (error-message (om/props this)))
             (dom/div nil (info-message (om/props this)))
             (view-dispatcher this)
             #_(dom/div nil (poketable (om/props this)))
             #_(dom/div nil (login)))))

(ns cruncher.views
  (:require [om.next :as om :refer-macros [defui]]
            [om.dom :as dom :include-macros true]
            [goog.dom :as gdom]
            [cruncher.communication.auth :as auth]
            [cruncher.communication.main :as com]
            [cruncher.communication.progress :as progress]
            [cruncher.shredder.main :as shredder]
            [cruncher.utils.extensions]
            [cruncher.utils.lib :as lib]
            [cruncher.utils.views :as vlib]))

;;;; Controls
(defui Controls
  Object
  (render [this]
    (dom/div nil
             (dom/span #js {:className "pull-right"} (vlib/loader (om/props this)))
             (vlib/button-primary #(com/route :get-all-pokemon) "Get all Pokemon")
             " "
             (vlib/button-primary #(shredder/power-on this) (vlib/fa-icon "fa-eraser") " Crunch selected Pokemon")
             (dom/br nil)
             (dom/br nil)
             (dom/div nil (progress/progress-bar (om/props this))))))
(def controls (om/factory Controls))

;;;; Messages
(defui ErrorMessage
  Object
  (render [this]
    (when (lib/error?)
      (dom/div #js {:className "alert alert-warning"}
               (dom/a #js {:href         "#"
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (dom/strong nil "Error: ")
               (lib/get-error)))))
(def error-message (om/factory ErrorMessage))

(defui InfoMessage
  Object
  (render [this]
    (when (lib/info?)
      (dom/div #js {:className "alert alert-success"}
               (dom/a #js {:href         "#"
                           :onClick      #(lib/info! nil)
                           :className    "close"
                           :data-dismiss "alert"
                           :aria-label   "close"}
                      (vlib/safe-html "×"))
               (lib/get-info)))))
(def info-message (om/factory InfoMessage))

;;;; Poketable
(defui PokeTableEntry
  Object
  (render [this]
    (let [pokemon (om/props this)]
      (dom/tr nil
              (dom/td nil
                      (dom/div #js {:className "checkbox"}
                               (dom/label nil
                                          (dom/input #js {:className "poketable-checkbox"
                                                          :type      "checkbox"
                                                          :value     (:id pokemon)}))))
              (dom/td nil (if (:favorite pokemon) (vlib/fa-icon "fa-star") (vlib/fa-icon "fa-star-o")))
              (dom/td nil (:pokemon_id pokemon))
              (dom/td nil (:name pokemon))
              (dom/td nil (:nickname pokemon))
              (dom/td nil (:cp pokemon))
              (dom/td nil (:health pokemon))
              (dom/td nil (:individual_percentage pokemon))
              (dom/td nil (:individual_attack pokemon))
              (dom/td nil (:individual_defense pokemon))
              (dom/td nil (:individual_stamina pokemon))))))
(def poketable-entry (om/factory PokeTableEntry {}))

(defui PokeTable
  Object
  (render [this]
    (dom/div #js {:id "poketable"}
             (dom/div nil (controls (om/props this)))
             (dom/br nil)
             (dom/table #js {:className "table table-hover"}
                        (dom/thead nil
                                   (dom/tr nil
                                           (dom/th nil "")
                                           (vlib/sortable-table-header :favorite "Fav.")
                                           (vlib/sortable-table-header :pokemon_id "#")
                                           (vlib/sortable-table-header :name "Name")
                                           (vlib/sortable-table-header :nickname "Nickname")
                                           (vlib/sortable-table-header :cp "CP")
                                           (vlib/sortable-table-header :health "Health")
                                           (vlib/sortable-table-header :individual_percentage "IV % Perfect")
                                           (vlib/sortable-table-header :individual_attack "IV Attack")
                                           (vlib/sortable-table-header :individual_defense "IV Defense")
                                           (vlib/sortable-table-header :individual_stamina "IV Stamina")))
                        (apply dom/tbody nil
                               (map #(poketable-entry (lib/merge-react-key %)) (lib/inventory-pokemon))))
             #_(let [jquery (js* "$")]
                 (.stickyTableHeaders (jquery "#poketable"))))))
(def poketable (om/factory PokeTable {}))

;;;; Other
(defui Header
  Object
  (render [this]
    (dom/div nil
             (dom/div #js {:className "page-header"}
                      (dom/div #js {:className "pull-right"}
                               (vlib/login-indicator (om/props this)))
                      (dom/h1 nil "Poké-Cruncher"))
             (dom/ul nil
                     (dom/li nil
                             "If you have 2-factor Auth enabled in your Google Account, please add an "
                             (dom/a #js {:href   "https://security.google.com/settings/security/apppasswords?pli=1"
                                         :target "_blank"}
                                    "app-password")
                             " to your account")
                     (dom/li nil "Click on the table headers to sort the data")
                     (dom/li nil "Crunching Pokemon really means you're sending them away -- "
                             (dom/strong nil "there is no possibility to get them back!!!"))
                     (dom/li nil "Enter a location near you to prevent a softban.")
                     (dom/li nil "Automated Pokemon crunching takes between 2 and 3 seconds per pokemon to prevent robotic behaviour."))
             (dom/hr nil))))
(def header (om/factory Header))

(defn commit-component-state
  "Set local state of view, parse the value of the target of val."
  [this key val]
  (cond
    (= (type val) js/Event) (om/update-state! this assoc key (.. val -target -value))
    (= (type val) js/String) (om/update-state! this assoc key val)
    :else (om/update-state! this assoc key (.. val -target -value))))

(defn google-ptc-switch [this]
  (dom/form #js {:id   "google-ptc-switch"
                 :role "form"}
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(commit-component-state this :service "google")
                                       :name    "google-ptc-switch"})
                       "Google")
            (dom/label #js {:className "radio-inline"}
                       (dom/input #js {:type    "radio"
                                       :onClick #(commit-component-state this :service "ptc")
                                       :name    "google-ptc-switch"})
                       "Pokemon Trainer Club")))

(defn validate-login-button
  "Show Login button and disable it when one of these fields is empty."
  [email password location service]
  (let [not-empty? (and
                     (pos? (count email))
                     (pos? (count password))
                     (pos? (count location))
                     (pos? (count service)))]
    (vlib/button-primary #(auth/login email password location service) not-empty? "Login")))

(defui Login
  Object
  (render [this]
    ;; TODO return empty string if om/get-state is empty
    (let [email (om/get-state this :email)
          password (om/get-state this :password)
          location (om/get-state this :location)
          service (om/get-state this :service)]
      (dom/div #js {:className "row"}
               (dom/div #js {:className "col-md-6 col-md-offset-3"}
                        (vlib/panel-wrapper
                          (dom/div nil
                                   (dom/h5 #js {:className "text-center"} "Login")
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-user fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(commit-component-state this :email %)
                                                            :value       email
                                                            :placeholder "email / PTC Username"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-key fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(commit-component-state this :password %)
                                                            :value       password
                                                            :type        "password"
                                                            :placeholder "password"}))
                                   (dom/div #js {:className "input-group"}
                                            (dom/span #js {:className "input-group-addon"}
                                                      (vlib/fa-icon "fa-map-marker fa-fw"))
                                            (dom/input #js {:className   "form-control"
                                                            :onChange    #(commit-component-state this :location %)
                                                            :value       location
                                                            :placeholder "Düsseldorf, Germany"}))
                                   (google-ptc-switch this)
                                   (validate-login-button email password location service))))))))
(def login (om/factory Login))

(defn view-dispatcher
  "Dispatch current template in main view by the app state."
  [this]
  (let [view (lib/current-view)]
    (cond
      (= view :login) (login (om/props this))
      (not (lib/logged-in?)) (login (om/props this))
      :else (poketable (om/props this)))))

(defui Main
  Object
  (render [this]
    (dom/div nil
             (dom/div nil (header (om/props this)))
             (dom/div nil (error-message (om/props this)))
             (dom/div nil (info-message (om/props this)))
             (view-dispatcher this)
             #_(dom/div nil (poketable (om/props this)))
             #_(dom/div nil (login)))))

Disable login button when input is missing


(ns cavm.jdbc
  (:import [java.sql PreparedStatement])
  (:require [clojure.java.jdbc :as jdbc]))

(extend-protocol jdbc/ISQLParameter
  clojure.lang.PersistentVector
  (set-parameter [v ^PreparedStatement s ^long i]
    (.setObject s i (to-array v))))

(ns cavm.jdbc
  (:import [java.sql PreparedStatement])
  (:require [clojure.java.jdbc :as jdbc]))

(extend-protocol jdbc/ISQLParameter
  clojure.lang.Seqable
  (set-parameter [v ^PreparedStatement s ^long i]
    (.setObject s i (to-array v))))

Extend array params to all Seqable.

Extend array params to all Seqable.


(ns app.ctl
  (:require [cljs.core.async :refer [put! chan <! mult tap]]
            [dragonmark.web.core :as dw :refer [xf xform to-hiccup to-doc-frag]]
            [cljs.reader]
            [markdown.core :refer [md->html]]
            [cljsjs.mousetrap]
            [reagent.core :as reagent :refer [atom]]
            [re-com.core  :refer [h-box v-box box gap line label checkbox
                                  radio-button button single-dropdown
                                  input-textarea modal-panel
                                  popover-content-wrapper popover-anchor-wrapper]]
            [re-com.util :refer [deref-or-value]]
            [re-frame.core :refer [dispatch-sync
                                   subscribe
                                   ]])
  (:require-macros [app.templates :refer [deftmpl]]
                   [reagent.ratom :refer [reaction]]
                   [cljs.core.async.macros :refer [go]]))

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

(deftmpl ctl-tpl "controls.html")

(deftmpl help-tpl "help.html")

(deftmpl dataview-tpl "dataview.html")

(defn import-component-body-func
  [submit-dialog cancel-dialog dialog-data]
  (fn []
    [v-box
     :children [[label
                 :class "help-text"
                 :label "Type (or paste) text into the text area (one item per line) and hit import."]
                [gap :size "15px"]
                [input-textarea
                 :model            dialog-data
                 :width            "100%"
                 :rows             10
                 :placeholder      "Enter items, one per line"
                 :on-change        #(reset! dialog-data %)
                 :change-on-blur?  true]
                [gap :size "20px"]
                [line]
                [gap :size "10px"]
                [h-box
                 :gap      "10px"
                 :children [[button
                             :label    [:span [:i {:class "zmdi zmdi-check" }] "Import"]
                             :on-click #(submit-dialog @dialog-data)
                             :class    "btn-primary"]]]]]))

(defn export-component-body-func
  [submit-dialog cancel-dialog dialog-data]
  (fn []
    [v-box
     :children [[label
                 :class "help-text"
                 :label "Copy paste the tab-indented plain string to your destination of choice."]
                [gap :size "15px"]
                (with-meta ;; TODO focus doesn't work
                  [input-textarea
                   :model            dialog-data
                   :width            "100%"
                   :rows             10
                   :on-change        #(reset! dialog-data %)
                   :change-on-blur?  true]
                  {:component-did-mount #(do (.focus (reagent/dom-node %))
                                             (.select (reagent/dom-node %)))})
                [gap :size "20px"]
                [line]
                [gap :size "10px"]
                [h-box
                 :gap      "10px"
                 :children [[button
                             :label    [:span [:i {:class "zmdi zmdi-check" }] "OK"]
                             :on-click #(submit-dialog @dialog-data)
                             :class    "btn-primary"]]]]]))

(defn popover-body-import
  [showing? position dialog-data on-change]
  (let [dialog-data   (reagent/atom (deref-or-value dialog-data))
        submit-dialog (fn [new-dialog-data]
                        (reset! showing? false)
                        (on-change new-dialog-data))
        cancel-dialog #(reset! showing? false)]
    (fn []
      [popover-content-wrapper
       :showing?         showing?
       :on-cancel        cancel-dialog
       :position         position
       :width            "400px"
       :backdrop-opacity 0.3
       :title            "Import items"
       :body             [(import-component-body-func submit-dialog cancel-dialog dialog-data)]])))

(defn popover-body-export
  [showing? position dialog-data on-change]
  (let [dialog-data   (reagent/atom (deref-or-value dialog-data))
        submit-dialog (fn [new-dialog-data]
                        (reset! showing? false)
                        (on-change new-dialog-data))
        cancel-dialog #(reset! showing? false)]
    (fn []
      [popover-content-wrapper
       :showing?         showing?
       :on-cancel        cancel-dialog
       :position         position
       :width            "400px"
       :backdrop-opacity 0.3
       :title            "Export all items"
       :body             [(export-component-body-func submit-dialog cancel-dialog dialog-data)]])))

(defn import-dlg [active-channel]
  (let [showing? (atom false)
        dlg-data (atom "")
        on-change #(dispatch-sync [:import % @active-channel])]
    (fn []
      [popover-anchor-wrapper
       :showing? showing?
       :position :right-below
       :anchor [button
                :label "Import"
                :on-click #(reset! showing? true)]
       :popover [popover-body-import showing? :right-below dlg-data on-change]])))

(defn channels->string
  "All items to tab-indented plain string list"
  [channels]
  (reduce (fn [%1 %2] (str %1
                           (:title %2)
                           "\n"
                           (reduce #(str %1 "\t" %2 "\n")
                                   ""
                                   (:items %2))))
          ""
          channels))

(defn export-dlg
  "Export all items from all channels, as tab-indented plain string list"
  [channels]
  (let [showing? (atom false)
        on-change #()]
    (fn [channels]
      [popover-anchor-wrapper
       :showing? showing?
       :position :right-below
       :anchor [button
                :label "Export"
                :tooltip "Export items from all channels as plain text list"
                :on-click #(reset! showing? true)]
       :popover [popover-body-export
                 showing?
                 :right-below
                 (channels->string @channels)
                 on-change]])))

(defn help-dlg
  "Overlay help text"
  []
  (let [show? (reagent/atom false)]
    (fn []
      [v-box
       :children [[:span {:class "help glyphicon glyphicon-question-sign"
                          :on-click #(reset! show? true)}]
                  (when @show?
                    [modal-panel
                     :backdrop-on-click #(reset! show? false)
                     :child
                     (xform (str "<div>" (md->html help-tpl) "</div>"))])]])))

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

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

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

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

(defn data-item
  "Single item in single channel. Editable, deletable."
  [item channel]
  (let [editing (atom false)]
    (fn [item channel]
      [:div {:class "channel-item"}
       (if @editing
         [title-edit {:title item
                      :on-save #(dispatch-sync [:channel-update-item @channel item %])
                      :on-stop #(reset! editing false)}]
         [:span {:on-click #(reset! editing (not @editing))} item])
       [:button {:class "btn btn-xs"
                 :on-click #(dispatch-sync [:delete item @channel])}
        [:span {:class "glyphicon glyphicon-remove"}]]])))

(defn data-items [items channel]
  [:ul
   (for [item items]
     [data-item item channel])])

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

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

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

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

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

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

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

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

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

             ["#ipm" {:value (Math/floor (* 60  (:items-per-sec @player)))
                      :on-change (fn [evt]
                                   (dispatch-sync [:set-ipm
                                                   (cljs.reader/read-string (.. evt -target -value ))])
                                   (dispatch-sync [:start]))}]
             ["#doRandomize" (if (:randomize? @player) {:checked "true"} {})]
                                        ;           ["#doRandomize" {:on-click #(println (.. % -target -checked))}]
             ["#doRandomize" {:on-click #(dispatch-sync [:set-randomize (.. % -target -checked)])}]
             ["#control-panel" :*> [:div {:class "form-group"} [help-dlg]] ]))))

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

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

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

(ns app.ctl
  (:require [cljs.core.async :refer [put! chan <! mult tap]]
            [dragonmark.web.core :as dw :refer [xf xform to-hiccup to-doc-frag]]
            [cljs.reader]
            [markdown.core :refer [md->html]]
            [cljsjs.mousetrap]
            [reagent.core :as reagent :refer [atom]]
            [re-com.core  :refer [h-box v-box box gap line label checkbox
                                  radio-button button single-dropdown
                                  input-textarea modal-panel
                                  popover-content-wrapper popover-anchor-wrapper]]
            [re-com.util :refer [deref-or-value]]
            [re-frame.core :refer [dispatch-sync
                                   subscribe
                                   ]])
  (:require-macros [app.templates :refer [deftmpl]]
                   [reagent.ratom :refer [reaction]]
                   [cljs.core.async.macros :refer [go]]))

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

(deftmpl ctl-tpl "controls.html")

(deftmpl help-tpl "help.html")

(deftmpl dataview-tpl "dataview.html")

(defn import-component-body-func
  [submit-dialog cancel-dialog dialog-data]
  (fn []
    [v-box
     :children [[label
                 :class "help-text"
                 :label "Type (or paste) text into the text area (one item per line) and hit import."]
                [gap :size "15px"]
                [input-textarea
                 :model            dialog-data
                 :width            "100%"
                 :rows             10
                 :placeholder      "Enter items, one per line"
                 :on-change        #(reset! dialog-data %)
                 :change-on-blur?  true]
                [gap :size "20px"]
                [line]
                [gap :size "10px"]
                [h-box
                 :gap      "10px"
                 :children [[button
                             :label    [:span [:i {:class "zmdi zmdi-check" }] "Import"]
                             :on-click #(submit-dialog @dialog-data)
                             :class    "btn-primary"]]]]]))

(defn export-component-body-func
  [submit-dialog cancel-dialog dialog-data]
  (fn []
    [v-box
     :children [[label
                 :class "help-text"
                 :label "Copy paste the tab-indented plain string to your destination of choice."]
                [gap :size "15px"]
                (with-meta ;; TODO focus doesn't work
                  [input-textarea
                   :model            dialog-data
                   :width            "100%"
                   :rows             10
                   :on-change        #(reset! dialog-data %)
                   :change-on-blur?  true]
                  {:component-did-mount #(do (.focus (reagent/dom-node %))
                                             (.select (reagent/dom-node %)))})
                [gap :size "20px"]
                [line]
                [gap :size "10px"]
                [h-box
                 :gap      "10px"
                 :children [[button
                             :label    [:span [:i {:class "zmdi zmdi-check" }] "OK"]
                             :on-click #(submit-dialog @dialog-data)
                             :class    "btn-primary"]]]]]))

(defn popover-body-import
  [showing? position dialog-data on-change]
  (let [dialog-data   (reagent/atom (deref-or-value dialog-data))
        submit-dialog (fn [new-dialog-data]
                        (reset! showing? false)
                        (on-change new-dialog-data))
        cancel-dialog #(reset! showing? false)]
    (fn []
      [popover-content-wrapper
       :showing?         showing?
       :on-cancel        cancel-dialog
       :position         position
       :width            "400px"
       :backdrop-opacity 0.3
       :title            "Import items"
       :body             [(import-component-body-func submit-dialog cancel-dialog dialog-data)]])))

(defn popover-body-export
  [showing? position dialog-data on-change]
  (let [dialog-data   (reagent/atom (deref-or-value dialog-data))
        submit-dialog (fn [new-dialog-data]
                        (reset! showing? false)
                        (on-change new-dialog-data))
        cancel-dialog #(reset! showing? false)]
    (fn []
      [popover-content-wrapper
       :showing?         showing?
       :on-cancel        cancel-dialog
       :position         position
       :width            "400px"
       :backdrop-opacity 0.3
       :title            "Export all items"
       :body             [(export-component-body-func submit-dialog cancel-dialog dialog-data)]])))

(defn import-dlg [active-channel]
  (let [showing? (atom false)
        dlg-data (atom "")
        on-change #(dispatch-sync [:import % @active-channel])]
    (fn []
      [popover-anchor-wrapper
       :showing? showing?
       :position :right-below
       :anchor [button
                :label "Import"
                :on-click #(reset! showing? true)]
       :popover [popover-body-import showing? :right-below dlg-data on-change]])))

(defn channels->string
  "All items to tab-indented plain string list"
  [channels]
  (reduce (fn [%1 %2] (str %1
                           (:title %2)
                           "\n"
                           (reduce #(str %1 "\t" %2 "\n")
                                   ""
                                   (:items %2))))
          ""
          channels))

(defn export-dlg
  "Export all items from all channels, as tab-indented plain string list"
  [channels]
  (let [showing? (atom false)
        on-change #()]
    (fn [channels]
      [popover-anchor-wrapper
       :showing? showing?
       :position :right-below
       :anchor [button
                :label "Export"
                :tooltip "Export items from all channels as plain text list"
                :on-click #(reset! showing? true)]
       :popover [popover-body-export
                 showing?
                 :right-below
                 (channels->string @channels)
                 on-change]])))

(defn help-dlg
  "Overlay help text"
  []
  (let [show? (reagent/atom false)]
    (fn []
      [v-box
       :children [[:span {:class "help glyphicon glyphicon-question-sign"
                          :on-click #(reset! show? true)}]
                  (when @show?
                    [modal-panel
                     :backdrop-on-click #(reset! show? false)
                     :child
                     (xform (str "<div>" (md->html help-tpl) "</div>"))])]])))

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

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

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

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

(defn data-item
  "Single item in single channel. Editable, deletable."
  [item channel]
  (let [editing (atom false)]
    (fn [item channel]
      [:div {:class "channel-item"}
       (if @editing
         [title-edit {:title item
                      :on-save #(dispatch-sync [:channel-update-item @channel item %])
                      :on-stop #(reset! editing false)}]
         [:span {:on-click #(reset! editing (not @editing))} item])
       [:button {:class "btn btn-xs"
                 :on-click #(dispatch-sync [:delete item @channel])}
        [:span {:class "glyphicon glyphicon-remove"}]]])))

(defn data-items [items channel]
  [:ul
   (for [item items]
     [data-item item channel])])

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

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

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

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

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

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

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

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

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

             ["#ipm" {:value (Math/floor (* 60  (:items-per-sec @player)))
                      :on-change (fn [evt]
                                   (dispatch-sync [:set-ipm
                                                   (cljs.reader/read-string (.. evt -target -value ))])
                                   (dispatch-sync [:start]))}]
             ["#doRandomize" (if (:randomize? @player) {:checked "true"} {})]
                                        ;           ["#doRandomize" {:on-click #(println (.. % -target -checked))}]
             ["#doRandomize" {:on-click #(dispatch-sync [:set-randomize (.. % -target -checked)])}]
             ["#control-panel" :*> [:div {:class "form-group"} [help-dlg]] ]))))

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

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

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

Fix data->channel drag-drop

Fix data->channel drag-drop


;;
;; Copyright (c) Two Sigma Open Source, LLC
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;  http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
(defproject cook "1.42.6"
  :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
  :license {:name "Apache License, Version 2.0"}
  :dependencies [[org.clojure/clojure "1.8.0"]

                 ;;Data marshalling
                 [org.clojure/data.codec "0.1.0"]
                 ^:displace [cheshire "5.3.1"]
                 [byte-streams "0.1.4"]
                 [org.clojure/data.json "0.2.2"]
                 [circleci/clj-yaml "0.5.5"]
                 [camel-snake-kebab "0.4.0"]
                 [com.rpl/specter "1.0.1"]

                 ;;Utility
                 [com.google.guava/guava "17.0"]
                 [amalloy/ring-buffer "1.1"]
                 [listora/ring-congestion "0.1.2"]
                 [lonocloud/synthread "1.0.4"]
                 [org.clojure/tools.namespace "0.2.4"]
                 [org.clojure/core.cache "0.8.2"]
                 [org.clojure/core.memoize "0.5.8"]
                 [clj-time "0.12.0"]
                 [org.clojure/core.async "0.3.442" :exclusions [org.clojure/tools.reader]]
                 [org.clojure/tools.cli "0.3.5"]
                 [prismatic/schema "1.1.3"]
                 [clojure-miniprofiler "0.4.0"]
                 [jarohen/chime "0.1.6"]
                 [org.clojure/data.priority-map "0.0.5"]
                 [swiss-arrows "1.0.0"]
                 [riddley "0.1.10"]
                 ^:displace [com.netflix.fenzo/fenzo-core "0.10.0"
                             :exclusions [org.apache.mesos/mesos
                                          com.fasterxml.jackson.core/jackson-core
                                          org.slf4j/slf4j-api
                                          org.slf4j/slf4j-simple]]

                 ;;Logging
                 [org.clojure/tools.logging "0.2.6"]
                 [clj-logging-config "1.9.10"
                  :exclusions [log4j]]
                 [org.slf4j/slf4j-log4j12 "1.7.12"]
                 [com.draines/postal "1.11.0"
                  :exclusions [commons-codec]]
                 [prismatic/plumbing "0.5.3"]
                 [log4j "1.2.17"]
                 [instaparse "1.4.0"]
                 [org.codehaus.jsr166-mirror/jsr166y "1.7.0"]
                 [clj-pid "0.1.1"]
                 [jarohen/chime "0.1.6"]

                 ;;Networking
                 [twosigma/clj-http "2.0.0-ts1"]
                 [io.netty/netty "3.10.1.Final"]
                 [cc.qbits/jet "0.6.4" :exclusions [org.eclipse.jetty/jetty-io
                                                    org.eclipse.jetty/jetty-security
                                                    org.eclipse.jetty/jetty-server
                                                    org.eclipse.jetty/jetty-http
                                                    cheshire]]
                 [org.eclipse.jetty/jetty-server "9.2.6.v20141205"]
                 [org.eclipse.jetty/jetty-security "9.2.6.v20141205"]

                 ;;Metrics
                 [metrics-clojure "2.6.1"
                  :exclusions [io.netty/netty org.clojure/clojure]]
                 [metrics-clojure-ring "2.3.0" :exclusions [com.codahale.metrics/metrics-core
                                                            org.clojure/clojure io.netty/netty]]
                 [metrics-clojure-jvm "2.6.1"]
                 [io.dropwizard.metrics/metrics-graphite "3.1.2"]
                 [com.aphyr/metrics3-riemann-reporter "0.4.0"
                  :exclusions [com.google.protobuf/protobuf-java
                               com.amazonaws/aws-java-sdk]] ; Brings in a lot of dependencies

                 ;;External system integrations
                 [org.clojure/tools.nrepl "0.2.3"]

                 ;;Ring
                 [ring/ring-core "1.4.0"]
                 [ring/ring-devel "1.4.0" :exclusions [org.clojure/tools.namespace]]
                 [compojure "1.4.0"]
                 [metosin/compojure-api "1.1.8"]
                 [hiccup "1.0.5"]
                 [ring/ring-json "0.2.0"]
                 [ring-edn "0.1.0"]
                 [com.duelinmarkers/ring-request-logging "0.2.0"]
                 [liberator "0.15.0"]

                 ;;Databases
                 [org.apache.curator/curator-framework "2.7.1"
                  :exclusions [io.netty/netty]]
                 [org.apache.curator/curator-recipes "2.7.1"
                  :exclusions [org.slf4j/slf4j-log4j12
                               org.slf4j/log4j
                               log4j]]
                 [org.apache.curator/curator-test "2.7.1"]

                 ;; Dependency management
                 [mount "0.1.12"]

                 ;; Kubernetes
                 [io.kubernetes/client-java "7.0.0"]
                 [com.google.auth/google-auth-library-oauth2-http "0.16.2"]]

  :repositories {"maven2" {:url "https://files.couchbase.com/maven2/"}
                 "sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"}

  :filespecs [{:type :fn
               :fn (fn [_]
                     {:type :bytes
                      :path "git-log"
                      :bytes (.trim (:out (clojure.java.shell/sh
                                            "git" "rev-parse" "HEAD")))})}
              {:type :fn
               :fn (fn [{:keys [version]}]
                     {:type :bytes
                      :path "version"
                      :bytes version})}]

  :java-source-paths ["java"]

  :profiles
  {; By default, activate the :oss profile (explained below)
   :default [:base :system :user :provided :dev :oss]

   ; The :oss profile exists so that Cook can be built with a more
   ; appropriate set of dependencies for a specific environment than
   ; the ones defined here (by using `lein with-profile -oss` ...)
   :oss
   {:dependencies [
                   ; For example, one could drop in the datomic-pro
                   ; library instead of the datomic-free library, by
                   ; using a profiles.clj file that defines a profile
                   ; which pulls in datomic-pro
                   [com.datomic/datomic-free "0.9.5206"
                    :exclusions [com.fasterxml.jackson.core/jackson-core
                                 joda-time
                                 org.slf4j/jcl-over-slf4j
                                 org.slf4j/jul-to-slf4j
                                 org.slf4j/log4j-over-slf4j
                                 org.slf4j/slf4j-api
                                 org.slf4j/slf4j-nop
                                 com.amazonaws/aws-java-sdk]]
                   ; Similarly, one could use an older version of the
                   ; mesomatic library in environments that require it
                   [twosigma/mesomatic "1.5.0-r4"]]}

   :uberjar
   {:aot [cook.components]
    :dependencies [[com.datomic/datomic-free "0.9.5206"
                    :exclusions [com.fasterxml.jackson.core/jackson-core
                                 joda-time
                                 org.slf4j/jcl-over-slf4j
                                 org.slf4j/jul-to-slf4j
                                 org.slf4j/log4j-over-slf4j
                                 org.slf4j/slf4j-api
                                 org.slf4j/slf4j-nop
                                 com.amazonaws/aws-java-sdk]]]} ; aws brings in a lot of dependencies.

   :dev
   {:dependencies [[criterium "0.4.4"]
                   [log4j/log4j "1.2.17" :exclusions [javax.mail/mail
                                                      javax.jms/jms
                                                      com.sun.jdmk/jmxtools
                                                      com.sun.jmx/jmxri]]
                   [ring/ring-jetty-adapter "1.5.0"]]
    :jvm-opts ["-Xms2G"
               "-XX:-OmitStackTraceInFastThrow"
               "-Xmx2G"
               "-Dcom.sun.management.jmxremote.authenticate=false"
               "-Dcom.sun.management.jmxremote.ssl=false"]
    :resource-paths ["test-resources"]
    :source-paths []}

   :test
   {:dependencies [[criterium "0.4.4"]
                   [org.clojure/test.check "0.6.1"]
                   [org.mockito/mockito-core "1.10.19"]
                   [twosigma/cook-jobclient "0.5.1-SNAPSHOT"]]}

   :test-console
   [:test {:jvm-opts ["-Dcook.test.logging.console"]}]

   :override-maven {:local-repo ~(System/getenv "COOK_SCHEDULER_MAVEN_LOCAL_REPO")}

   :docker
   ; avoid calling javac in docker
   ; (.java sources are only used for unit test support)
   {:java-source-paths ^:replace []}}

  :plugins [[lein-exec "0.3.7"]
            [lein-print "0.1.0"]]

  :test-selectors {:all (constantly true)
                   :all-but-benchmark (complement :benchmark)
                   :benchmark :benchmark
                   :default (complement #(or (:integration %) (:benchmark %)))
                   :integration :integration}

  :main cook.components
  :jvm-opts ["-Dpython.cachedir.skip=true"
             ;"-Dsun.security.jgss.native=true"
             ;"-Dsun.security.jgss.lib=/opt/mitkrb5/lib/libgssapi_krb5.so"
             ;"-Djavax.security.auth.useSubjectCredsOnly=false"
             "-verbose:gc"
             "-XX:+PrintGCDetails"
             "-Xloggc:gclog"
             "-XX:+UseGCLogFileRotation"
             "-XX:NumberOfGCLogFiles=20"
             "-XX:GCLogFileSize=128M"
             "-XX:+PrintGCDateStamps"
             "-XX:+HeapDumpOnOutOfMemoryError"])

;;
;; Copyright (c) Two Sigma Open Source, LLC
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;  http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.
;;
(defproject cook "1.42.7-SNAPSHOT"
  :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
  :license {:name "Apache License, Version 2.0"}
  :dependencies [[org.clojure/clojure "1.8.0"]

                 ;;Data marshalling
                 [org.clojure/data.codec "0.1.0"]
                 ^:displace [cheshire "5.3.1"]
                 [byte-streams "0.1.4"]
                 [org.clojure/data.json "0.2.2"]
                 [circleci/clj-yaml "0.5.5"]
                 [camel-snake-kebab "0.4.0"]
                 [com.rpl/specter "1.0.1"]

                 ;;Utility
                 [com.google.guava/guava "17.0"]
                 [amalloy/ring-buffer "1.1"]
                 [listora/ring-congestion "0.1.2"]
                 [lonocloud/synthread "1.0.4"]
                 [org.clojure/tools.namespace "0.2.4"]
                 [org.clojure/core.cache "0.8.2"]
                 [org.clojure/core.memoize "0.5.8"]
                 [clj-time "0.12.0"]
                 [org.clojure/core.async "0.3.442" :exclusions [org.clojure/tools.reader]]
                 [org.clojure/tools.cli "0.3.5"]
                 [prismatic/schema "1.1.3"]
                 [clojure-miniprofiler "0.4.0"]
                 [jarohen/chime "0.1.6"]
                 [org.clojure/data.priority-map "0.0.5"]
                 [swiss-arrows "1.0.0"]
                 [riddley "0.1.10"]
                 ^:displace [com.netflix.fenzo/fenzo-core "0.10.0"
                             :exclusions [org.apache.mesos/mesos
                                          com.fasterxml.jackson.core/jackson-core
                                          org.slf4j/slf4j-api
                                          org.slf4j/slf4j-simple]]

                 ;;Logging
                 [org.clojure/tools.logging "0.2.6"]
                 [clj-logging-config "1.9.10"
                  :exclusions [log4j]]
                 [org.slf4j/slf4j-log4j12 "1.7.12"]
                 [com.draines/postal "1.11.0"
                  :exclusions [commons-codec]]
                 [prismatic/plumbing "0.5.3"]
                 [log4j "1.2.17"]
                 [instaparse "1.4.0"]
                 [org.codehaus.jsr166-mirror/jsr166y "1.7.0"]
                 [clj-pid "0.1.1"]
                 [jarohen/chime "0.1.6"]

                 ;;Networking
                 [twosigma/clj-http "2.0.0-ts1"]
                 [io.netty/netty "3.10.1.Final"]
                 [cc.qbits/jet "0.6.4" :exclusions [org.eclipse.jetty/jetty-io
                                                    org.eclipse.jetty/jetty-security
                                                    org.eclipse.jetty/jetty-server
                                                    org.eclipse.jetty/jetty-http
                                                    cheshire]]
                 [org.eclipse.jetty/jetty-server "9.2.6.v20141205"]
                 [org.eclipse.jetty/jetty-security "9.2.6.v20141205"]

                 ;;Metrics
                 [metrics-clojure "2.6.1"
                  :exclusions [io.netty/netty org.clojure/clojure]]
                 [metrics-clojure-ring "2.3.0" :exclusions [com.codahale.metrics/metrics-core
                                                            org.clojure/clojure io.netty/netty]]
                 [metrics-clojure-jvm "2.6.1"]
                 [io.dropwizard.metrics/metrics-graphite "3.1.2"]
                 [com.aphyr/metrics3-riemann-reporter "0.4.0"
                  :exclusions [com.google.protobuf/protobuf-java
                               com.amazonaws/aws-java-sdk]] ; Brings in a lot of dependencies

                 ;;External system integrations
                 [org.clojure/tools.nrepl "0.2.3"]

                 ;;Ring
                 [ring/ring-core "1.4.0"]
                 [ring/ring-devel "1.4.0" :exclusions [org.clojure/tools.namespace]]
                 [compojure "1.4.0"]
                 [metosin/compojure-api "1.1.8"]
                 [hiccup "1.0.5"]
                 [ring/ring-json "0.2.0"]
                 [ring-edn "0.1.0"]
                 [com.duelinmarkers/ring-request-logging "0.2.0"]
                 [liberator "0.15.0"]

                 ;;Databases
                 [org.apache.curator/curator-framework "2.7.1"
                  :exclusions [io.netty/netty]]
                 [org.apache.curator/curator-recipes "2.7.1"
                  :exclusions [org.slf4j/slf4j-log4j12
                               org.slf4j/log4j
                               log4j]]
                 [org.apache.curator/curator-test "2.7.1"]

                 ;; Dependency management
                 [mount "0.1.12"]

                 ;; Kubernetes
                 [io.kubernetes/client-java "7.0.0"]
                 [com.google.auth/google-auth-library-oauth2-http "0.16.2"]]

  :repositories {"maven2" {:url "https://files.couchbase.com/maven2/"}
                 "sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"}

  :filespecs [{:type :fn
               :fn (fn [_]
                     {:type :bytes
                      :path "git-log"
                      :bytes (.trim (:out (clojure.java.shell/sh
                                            "git" "rev-parse" "HEAD")))})}
              {:type :fn
               :fn (fn [{:keys [version]}]
                     {:type :bytes
                      :path "version"
                      :bytes version})}]

  :java-source-paths ["java"]

  :profiles
  {; By default, activate the :oss profile (explained below)
   :default [:base :system :user :provided :dev :oss]

   ; The :oss profile exists so that Cook can be built with a more
   ; appropriate set of dependencies for a specific environment than
   ; the ones defined here (by using `lein with-profile -oss` ...)
   :oss
   {:dependencies [
                   ; For example, one could drop in the datomic-pro
                   ; library instead of the datomic-free library, by
                   ; using a profiles.clj file that defines a profile
                   ; which pulls in datomic-pro
                   [com.datomic/datomic-free "0.9.5206"
                    :exclusions [com.fasterxml.jackson.core/jackson-core
                                 joda-time
                                 org.slf4j/jcl-over-slf4j
                                 org.slf4j/jul-to-slf4j
                                 org.slf4j/log4j-over-slf4j
                                 org.slf4j/slf4j-api
                                 org.slf4j/slf4j-nop
                                 com.amazonaws/aws-java-sdk]]
                   ; Similarly, one could use an older version of the
                   ; mesomatic library in environments that require it
                   [twosigma/mesomatic "1.5.0-r4"]]}

   :uberjar
   {:aot [cook.components]
    :dependencies [[com.datomic/datomic-free "0.9.5206"
                    :exclusions [com.fasterxml.jackson.core/jackson-core
                                 joda-time
                                 org.slf4j/jcl-over-slf4j
                                 org.slf4j/jul-to-slf4j
                                 org.slf4j/log4j-over-slf4j
                                 org.slf4j/slf4j-api
                                 org.slf4j/slf4j-nop
                                 com.amazonaws/aws-java-sdk]]]} ; aws brings in a lot of dependencies.

   :dev
   {:dependencies [[criterium "0.4.4"]
                   [log4j/log4j "1.2.17" :exclusions [javax.mail/mail
                                                      javax.jms/jms
                                                      com.sun.jdmk/jmxtools
                                                      com.sun.jmx/jmxri]]
                   [ring/ring-jetty-adapter "1.5.0"]]
    :jvm-opts ["-Xms2G"
               "-XX:-OmitStackTraceInFastThrow"
               "-Xmx2G"
               "-Dcom.sun.management.jmxremote.authenticate=false"
               "-Dcom.sun.management.jmxremote.ssl=false"]
    :resource-paths ["test-resources"]
    :source-paths []}

   :test
   {:dependencies [[criterium "0.4.4"]
                   [org.clojure/test.check "0.6.1"]
                   [org.mockito/mockito-core "1.10.19"]
                   [twosigma/cook-jobclient "0.5.1-SNAPSHOT"]]}

   :test-console
   [:test {:jvm-opts ["-Dcook.test.logging.console"]}]

   :override-maven {:local-repo ~(System/getenv "COOK_SCHEDULER_MAVEN_LOCAL_REPO")}

   :docker
   ; avoid calling javac in docker
   ; (.java sources are only used for unit test support)
   {:java-source-paths ^:replace []}}

  :plugins [[lein-exec "0.3.7"]
            [lein-print "0.1.0"]]

  :test-selectors {:all (constantly true)
                   :all-but-benchmark (complement :benchmark)
                   :benchmark :benchmark
                   :default (complement #(or (:integration %) (:benchmark %)))
                   :integration :integration}

  :main cook.components
  :jvm-opts ["-Dpython.cachedir.skip=true"
             ;"-Dsun.security.jgss.native=true"
             ;"-Dsun.security.jgss.lib=/opt/mitkrb5/lib/libgssapi_krb5.so"
             ;"-Djavax.security.auth.useSubjectCredsOnly=false"
             "-verbose:gc"
             "-XX:+PrintGCDetails"
             "-Xloggc:gclog"
             "-XX:+UseGCLogFileRotation"
             "-XX:NumberOfGCLogFiles=20"
             "-XX:GCLogFileSize=128M"
             "-XX:+PrintGCDateStamps"
             "-XX:+HeapDumpOnOutOfMemoryError"])

Bump to 1.42.7-SNAPSHOT

Bump to 1.42.7-SNAPSHOT


; Copyright (C) 2013, 2014 Dr. Thomas Schank  (DrTom@schank.ch, 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.exec
  (:import
    [java.io File]
    [java.util UUID]
    [org.apache.commons.exec ExecuteWatchdog]
    )
  (:require
    [clj-commons-exec :as commons-exec]
    [clj-time.core :as time]
    [clojure.string :as string]
    [clojure.tools.logging :as logging]
    [cider-ci.util :as util]
    )
  (:use
    [clj-logging-config.log4j :only (set-logger!)]
    [clojure.java.shell :as shell]
    [clojure.stacktrace :only (print-stack-trace)]
    ))

;(set-logger! :level :debug)
;(clojure.pprint/pprint @(commons-exec/sh ["bash" "-l" "-c" "load_rbenv && rbenv shell ruby-2.0.0 && ruby -v"] {:env (System/getenv) }))
;(clojure.pprint/pprint @(commons-exec/sh ["sh" "-l" "-c" "bash -l -c \"env |sort\""] {:env {}}))
;(shell/sh "bash" "-l" "-c" "env" :env {})

(def conf (atom {:environment_variables {}}))

(def defaul-system-interpreter
  (condp = (clojure.string/lower-case (System/getProperty "os.name"))
    "windows" ["cmd.exe" "/c"]
    ["bash" "-l"]))

(defn prepare-script-file [script]
  (let [script-file (File/createTempFile "cider-ci_", ".script")]
    (.deleteOnExit script-file)
    (spit script-file script)
    (.setExecutable script-file true)
    script-file))

(defn ^:private prepare-env-variables [{ex-uuid :cider_ci_execution_id
                                        trial-uuid :cider_ci_trial_id
                                        task-uuid :cider_ci_task_id :as params}]
  ; TODO pull-up the complete params here; there is some duplication
  (logging/debug "prepare-env-variables :cider-ci_execution_id " ex-uuid ":cider-ci_trial_id " trial-uuid " params: " params)
  (let [res (util/upper-case-keys
              (util/rubyize-keys
                 (conj params
                       (:environment_variables @conf)
                       { })))]
                 (logging/debug "prepare-env-variables res: " res)
    res))

(defn exec-script-for-params [params]

  (logging/info (str "exec-script-for-params" (select-keys params [:name])))
  (logging/debug "exec-script-for-params params:" params)
  (try
    (let [started {:started_at (time/now)}
          working-dir (:working_dir params)
          env-variables (prepare-env-variables (conj {:cider-ci_working_dir working-dir}
                                                     (or (:ports params) {})
                                                     (:environment_variables params)))
          timeout (or (:timeout params) 200)
          interpreter (or (:interpreter params) defaul-system-interpreter)
          script-file (prepare-script-file (:body params))
          command (conj interpreter (.getAbsolutePath script-file))
          exec-res (deref (commons-exec/sh command
                                           {:env (conj {} (System/getenv) env-variables)
                                            :dir working-dir
                                            :watchdog (* 1000 timeout)}))]
      (conj params
            started
            {:finished_at (time/now)
             :exit_status (:exit exec-res)
             :state (condp = (:exit exec-res)
                      0 "success"
                      "failed")
             :stdout (:out exec-res)
             :stderr (:err exec-res)
             :error (:error exec-res)
             :interpreter interpreter
             }))
    (catch Exception e
      (do
        (logging/error (with-out-str (print-stack-trace e)))
        (conj params
              {:state "failed"
               :error (with-out-str (print-stack-trace e))
               })))))

(defn start-service-process [params]
  (try
    (let [started {:started_at (time/now)}
          working-dir (:working_dir params)
          env-variables (prepare-env-variables
                          (conj {:cider-ci_working_dir working-dir}
                                (or (:ports params) {})
                                (:environment_variables params)))
          timeout (or (when-let [s (:timeout params)] (* 1000 s))  ExecuteWatchdog/INFINITE_TIMEOUT)
          watchdog (ExecuteWatchdog. timeout)
          interpreter (or (:interpreter params) defaul-system-interpreter)
          script-file (prepare-script-file (:body params))
          command (conj interpreter (.getAbsolutePath script-file))
          exec-promise (commons-exec/sh command
                                        {:env (conj {} (System/getenv) env-variables)
                                         :dir working-dir
                                         :watchdog watchdog})]
      (conj params
            started
            {:finished_at (time/now)
             :exit_status 0
             :state "success"
             :stdout ""
             :stderr ""
             :error ""
             :interpreter interpreter }
            {:watchdog watchdog
             :exec_promise exec-promise
             }))
    (catch Exception e
      (logging/error (with-out-str (print-stack-trace e)))
      (conj params
            {:state "failed"
             :error (with-out-str (print-stack-trace e))
             }))))

(defn stop-service [params]
  (.destroyProcess (:watchdog params))
  (let [exec-res (deref (:exec_promise params))]
    (conj params
          {:finished_at (time/now)
           :exit_status (:exit exec-res)
           :stdout (:out exec-res)
           :stderr (:err exec-res)
           :error (:error exec-res)
           })))

; Copyright (C) 2013, 2014 Dr. Thomas Schank  (DrTom@schank.ch, 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.exec
  (:import
    [java.io File]
    [java.util UUID]
    [org.apache.commons.exec ExecuteWatchdog]
    )
  (:require
    [clj-commons-exec :as commons-exec]
    [clj-time.core :as time]
    [clojure.string :as string]
    [clojure.tools.logging :as logging]
    [cider-ci.util :as util]
    )
  (:use
    [clj-logging-config.log4j :only (set-logger!)]
    [clojure.java.shell :as shell]
    [clojure.stacktrace :only (print-stack-trace)]
    ))

;(set-logger! :level :debug)
;(clojure.pprint/pprint @(commons-exec/sh ["bash" "-l" "-c" "load_rbenv && rbenv shell ruby-2.0.0 && ruby -v"] {:env (System/getenv) }))
;(clojure.pprint/pprint @(commons-exec/sh ["sh" "-l" "-c" "bash -l -c \"env |sort\""] {:env {}}))
;(shell/sh "bash" "-l" "-c" "env" :env {})

(def conf (atom {:environment_variables {}}))

(def defaul-system-interpreter
  (condp = (clojure.string/lower-case (System/getProperty "os.name"))
    "windows" ["cmd.exe" "/c"]
    ["bash" "--login" "-i" ]))

(defn prepare-script-file [script]
  (let [script-file (File/createTempFile "cider-ci_", ".script")]
    (.deleteOnExit script-file)
    (spit script-file script)
    (.setExecutable script-file true)
    script-file))

(defn ^:private prepare-env-variables [{ex-uuid :cider_ci_execution_id
                                        trial-uuid :cider_ci_trial_id
                                        task-uuid :cider_ci_task_id :as params}]
  ; TODO pull-up the complete params here; there is some duplication
  (logging/debug "prepare-env-variables :cider-ci_execution_id " ex-uuid ":cider-ci_trial_id " trial-uuid " params: " params)
  (let [res (util/upper-case-keys
              (util/rubyize-keys
                 (conj params
                       (:environment_variables @conf)
                       { })))]
                 (logging/debug "prepare-env-variables res: " res)
    res))

(defn exec-script-for-params [params]

  (logging/info (str "exec-script-for-params" (select-keys params [:name])))
  (logging/debug "exec-script-for-params params:" params)
  (try
    (let [started {:started_at (time/now)}
          working-dir (:working_dir params)
          env-variables (prepare-env-variables (conj {:cider-ci_working_dir working-dir}
                                                     (or (:ports params) {})
                                                     (:environment_variables params)))
          timeout (or (:timeout params) 200)
          interpreter (or (:interpreter params) defaul-system-interpreter)
          script-file (prepare-script-file (:body params))
          command (conj interpreter (.getAbsolutePath script-file))
          exec-res (deref (commons-exec/sh command
                                            ; add (System/getenv) to see inherited env vars ; either is bad:
                                            ;   without: we loose job control
                                            ;   with: wee see a bunch vars from starting the executor
                                           {:env (conj {} (System/getenv) env-variables)
                                            :dir working-dir
                                            :watchdog (* 1000 timeout)}))]
      (conj params
            started
            {:finished_at (time/now)
             :exit_status (:exit exec-res)
             :state (condp = (:exit exec-res)
                      0 "success"
                      "failed")
             :stdout (:out exec-res)
             :stderr (:err exec-res)
             :error (:error exec-res)
             :interpreter interpreter
             }))
    (catch Exception e
      (do
        (logging/error (with-out-str (print-stack-trace e)))
        (conj params
              {:state "failed"
               :error (with-out-str (print-stack-trace e))
               })))))

(defn start-service-process [params]
  (try
    (let [started {:started_at (time/now)}
          working-dir (:working_dir params)
          env-variables (prepare-env-variables
                          (conj {:cider-ci_working_dir working-dir}
                                (or (:ports params) {})
                                (:environment_variables params)))
          timeout (or (when-let [s (:timeout params)] (* 1000 s))  ExecuteWatchdog/INFINITE_TIMEOUT)
          watchdog (ExecuteWatchdog. timeout)
          interpreter (or (:interpreter params) defaul-system-interpreter)
          script-file (prepare-script-file (:body params))
          command (conj interpreter (.getAbsolutePath script-file))
          exec-promise (commons-exec/sh command
                                        {:env (conj {} (System/getenv) env-variables)
                                         :dir working-dir
                                         :watchdog watchdog})]
      (conj params
            started
            {:finished_at (time/now)
             :exit_status 0
             :state "success"
             :stdout ""
             :stderr ""
             :error ""
             :interpreter interpreter }
            {:watchdog watchdog
             :exec_promise exec-promise
             }))
    (catch Exception e
      (logging/error (with-out-str (print-stack-trace e)))
      (conj params
            {:state "failed"
             :error (with-out-str (print-stack-trace e))
             }))))

(defn stop-service [params]
  (.destroyProcess (:watchdog params))
  (let [exec-res (deref (:exec_promise params))]
    (conj params
          {:finished_at (time/now)
           :exit_status (:exit exec-res)
           :stdout (:out exec-res)
           :stderr (:err exec-res)
           :error (:error exec-res)
           })))

Use interactive bash by default

Use interactive bash by default

Squashed commit of the following:

commit 60bd342bee103dbdb001421be2626b432f79df2c
Author: Thomas Schank <DrTom@schank.ch>
Date:   Tue May 6 09:19:51 2014 +0200

    Use interactive shell (and inherit env vars)

commit 09d55ed942b97ebee602d6b995da9d9b7f407427
Author: Thomas Schank <DrTom@schank.ch>
Date:   Mon May 5 08:46:31 2014 +0200

    Use interactive login shell by default; but do not inherit variables


(ns analysis.core
  (:import java.lang.Math)
  (:require [clojure.java.io :as io]
            [clojure.string :as s]
            [cosmos.core :as cosmos]))

(defrecord
  ;;"Data structure for defining a single log."
  Log [insts params reports summary])

(defn- make-inst [inst-chunk]
  (-> inst-chunk
      (s/split #":")
      (second)
      (read-string)))

(defn- make-params [param-chunk]
  (->> param-chunk
       (map #(s/split % #"="))
       (map #(vector (s/trim (% 0)) (s/trim (% 1))))
       (reduce #(assoc %1 (%2 0) (%2 1)) (sorted-map))))

(defn- make-reports [reports-chunk]
  (let [pred #(.contains % ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")]
    (let [reports (for [chunk (remove pred (partition-by pred reports-chunk))]
                    (->> chunk
                         (map #(s/split % #":"))
                         (remove #(not= 2 (count %)))
                         (flatten)
                         (map s/trim)
                         (apply sorted-map)))
          max-attributes (apply max (map count reports))]
      (filter #(= max-attributes (count %)) reports))))

(defn- make-summary [summary-chunk]
  (let [outcome (re-find #"SUCCESS|FAILURE" (first summary-chunk))
        final-gen (re-find #"[0-9]+" (first summary-chunk))
        smap (->> summary-chunk
                  (map #(s/split % #":"))
                  (filter #(= 2 (count %)))
                  (flatten)
                  (map s/trim)
                  (apply sorted-map))]
    (assoc smap "outcome" outcome "final-gen" final-gen)))

(defn parse-Log
  "Parses a single log file (i.e. output of a Clojush run) into a Log data structure"
  [log-file]
  (let [lines (s/split-lines (slurp log-file))
        inst-chunk (first (filter #(.contains % "Registered instructions:") lines))
        param-chunk (filter #(.contains % "=") lines)
        reports-chunk (->> lines
                           (drop-while #(not (.contains % ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")))
                           (take-while #(and (not (.contains % "SUCCESS")) (not (.contains % "FAILURE")))))
        summary-chunk (drop-while #(and (not (.contains % "SUCCESS")) (not (.contains % "FAILURE"))) lines)]
    (Log. (make-inst inst-chunk)
          (make-params param-chunk)
          (make-reports reports-chunk)
          (make-summary summary-chunk))))

(defn parse-Logs
  "parses the contents of a log folder into a Log data structure, assuming that all files in the folder are logs"
  [log-folder]
  (for [log (.listFiles (io/file log-folder))]
    (parse-Log log)))

(defn Y
  "Koza's Y - `point probability of success'"
  [logs]
  (assert (reduce #(and (= %1 %2) %1) (map #(get (:params %) "population-size") logs)))
  (let [success-array (int-array (read-string (get (:params (first logs)) "population-size")) 0)]
    (->> (reduce #(let [summary (:summary %2)]
                    (when (= "SUCCESS" (get summary "outcome"))
                      (let [index (read-string (get summary "final-gen"))]
                        (aset %1 index (inc (aget %1 index)))))
                    %1)
                 success-array logs)
         (map #(/ % (count logs))))))

(defn P
  "Koza's P - `cumulative probability of success'"
  [logs]
  (let [point-probs (to-array (Y logs))]
    (doseq [i (rest (range (alength point-probs)))]
      (aset point-probs i (+ (aget point-probs i)
                             (aget point-probs (dec i)))))
    (seq point-probs)))

(defn R
  "Koza's R - `number of independent runs needed get a success with probability z"
  [logs z]
  (let [enumerate (fn [lst] (map #(vector %1 %2) (range (count lst)) lst))
        cumulative-probs (P logs)
        calcs (map #(Math/ceil
                     (/ (Math/log (- 1 z))
                        (Math/log (- 1 %))))
                   cumulative-probs)]
    (ffirst (sort #(> (%1 1) (%2 1)) (enumerate calcs)))))

(defn CE
  "Koza's Computational Effort"
  [logs z]
  (* (R logs z)
     (count logs)
     (read-string (get (:params (first logs)) "population-size"))))

(defn MBF
  "Mean Best Fitness"
  [logs error-key]
  (let [best-fitnesses (->> (for [log logs]
                              (for [report (:reports log)]
                                (get report error-key)))
                            flatten
                            (remove nil?)
                            (map read-string)
                            flatten)]
    (/ (apply + best-fitnesses) (count best-fitnesses))))

(defn cosmos
  "Returns a summary of the recommended runs for this data set"
  [logs]
  (cosmos/recommended-runs (-> (for [log logs]
                                 (for [[report gen] (map #(vector %1 %2) (:reports log) (iterate inc 0))]
                                   (for [[ord val] (seq (read-string (get report "Cosmos Data")))]
                                     (struct-map cosmos/cosmos-data
                                       :ord ord
                                       :gen gen
                                       :val val))))
                               flatten
                               cosmos-1)))

(ns analysis.core
  (:import java.lang.Math)
  (:require [clojure.java.io :as io]
            [clojure.string :as s]
            [cosmos.core :as cosmos]))

(defrecord
  ;;"Data structure for defining a single log."
  Log [insts params reports summary])

(defn- make-inst [inst-chunk]
  (-> inst-chunk
      (s/split #":")
      (second)
      (read-string)))

(defn- make-params [param-chunk]
  (->> param-chunk
       (map #(s/split % #"="))
       (map #(vector (s/trim (% 0)) (s/trim (% 1))))
       (reduce #(assoc %1 (%2 0) (%2 1)) (sorted-map))))

(defn- make-reports [reports-chunk]
  (let [pred #(.contains % ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")]
    (let [reports (for [chunk (remove pred (partition-by pred reports-chunk))]
                    (->> chunk
                         (map #(s/split % #":"))
                         (remove #(not= 2 (count %)))
                         (flatten)
                         (map s/trim)
                         (apply sorted-map)))
          max-attributes (apply max (map count reports))]
      (filter #(= max-attributes (count %)) reports))))

(defn- make-summary [summary-chunk]
  (let [outcome (re-find #"SUCCESS|FAILURE" (first summary-chunk))
        final-gen (re-find #"[0-9]+" (first summary-chunk))
        smap (->> summary-chunk
                  (map #(s/split % #":"))
                  (filter #(= 2 (count %)))
                  (flatten)
                  (map s/trim)
                  (apply sorted-map))]
    (assoc smap "outcome" outcome "final-gen" final-gen)))

(defn parse-Log
  "Parses a single log file (i.e. output of a Clojush run) into a Log data structure"
  [log-file]
  (let [lines (s/split-lines (slurp log-file))
        inst-chunk (first (filter #(.contains % "Registered instructions:") lines))
        param-chunk (filter #(.contains % "=") lines)
        reports-chunk (->> lines
                           (drop-while #(not (.contains % ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")))
                           (take-while #(and (not (.contains % "SUCCESS")) (not (.contains % "FAILURE")))))
        summary-chunk (drop-while #(and (not (.contains % "SUCCESS")) (not (.contains % "FAILURE"))) lines)]
    (Log. (make-inst inst-chunk)
          (make-params param-chunk)
          (make-reports reports-chunk)
          (make-summary summary-chunk))))

(defn parse-Logs
  "parses the contents of a log folder into a Log data structure, assuming that all files in the folder are logs"
  [log-folder]
  (for [log (.listFiles (io/file log-folder))]
    (parse-Log log)))

(defn Y
  "Koza's Y - `point probability of success'"
  [logs]
  (assert (reduce #(and (= %1 %2) %1) (map #(get (:params %) "population-size") logs)))
  (let [success-array (int-array (read-string (get (:params (first logs)) "population-size")) 0)]
    (->> (reduce #(let [summary (:summary %2)]
                    (when (= "SUCCESS" (get summary "outcome"))
                      (let [index (read-string (get summary "final-gen"))]
                        (aset %1 index (inc (aget %1 index)))))
                    %1)
                 success-array logs)
         (map #(/ % (count logs))))))

(defn P
  "Koza's P - `cumulative probability of success'"
  [logs]
  (let [point-probs (to-array (Y logs))]
    (doseq [i (rest (range (alength point-probs)))]
      (aset point-probs i (+ (aget point-probs i)
                             (aget point-probs (dec i)))))
    (seq point-probs)))

(defn R
  "Koza's R - `number of independent runs needed get a success with probability z"
  [logs z]
  (let [enumerate (fn [lst] (map #(vector %1 %2) (range (count lst)) lst))
        cumulative-probs (P logs)
        calcs (map #(Math/ceil
                     (/ (Math/log (- 1 z))
                        (Math/log (- 1 %))))
                   cumulative-probs)]
    (ffirst (sort #(> (%1 1) (%2 1)) (enumerate calcs)))))

(defn CE
  "Koza's Computational Effort"
  [logs z]
  (* (R logs z)
     (count logs)
     (read-string (get (:params (first logs)) "population-size"))))

(defn MBF
  "Mean Best Fitness"
  [logs error-key]
  (let [best-fitnesses (->> (for [log logs]
                              (for [report (:reports log)]
                                (get report error-key)))
                            flatten
                            (remove nil?)
                            (map read-string)
                            flatten)]
    (/ (apply + best-fitnesses) (count best-fitnesses))))

(defn cosmos
  "Returns a summary of the recommended runs for this data set"
  [logs]
  (cosmos/recommended-runs (-> (for [log logs]
                                 (for [[report gen] (map #(vector %1 %2) (:reports log) (iterate inc 0))]
                                   (for [[ord val] (seq (read-string (get report "Cosmos Data")))]
                                     (struct-map cosmos/cosmos-data
                                       :ord ord
                                       :gen gen
                                       :val val))))
                               flatten
                               cosmos/cosmos-1)))

Update src/analysis/core.clj

Update src/analysis/core.clj

cosmos-1 should be namespace-qualified