(ns babel.test.translate
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.directory :refer [models]]
   [babel.test.it :as it]
   [babel.test.en :as en]
   [clojure.test :refer [deftest is]]
   [clojure.tools.logging :as log]
   [dag_unify.core :refer [get-in strip-refs]]))

;; In Italian, certain verbs, called "essere" verbs, when conjugated
;; in certain tenses, agree in gender and number with their subject:
;;
;; For example, compare:
;;  Italian: "loro sono andati"
;;  English: They (masculine plural) went.
;; but:
;;  Italian: "loro sono andate"
;;  English: They (feminine plural) went.
;;
;; In English we indicate feminine and masculine gender with ♀ and ♂,
;; respectively.

;; Test that gender agreement is correctly translated.
(deftest past-and-gender-agreement-feminine
  (let [italian "loro sono andate"

        italian-structure
        (-> italian
            babel.italiano/parse
            first
            :parses
            first)

        semantics
        (-> italian-structure
            (get-in [:synsem :sem])
            strip-refs)

        english-structure
        (->  {:synsem {:sem semantics}}
             (babel.english/generate :model (-> ((-> models :en)) deref)))

        english (babel.english.morphology/fo english-structure)]

    (= "they (♀) went" english)))

(deftest past-and-gender-agreement-masculine
  (let [italian "loro sono andati"

        italian-structure
        (-> italian
            babel.italiano/parse
            first
            :parses
            first)

        semantics
        (-> italian-structure
            (get-in [:synsem :sem])
            strip-refs)

        english-structure
        (->  {:synsem {:sem semantics}}
             (babel.english/generate :model (-> ((-> models :en)) deref)))

        english (babel.english.morphology/fo english-structure)]

    (= "they (♂) went" english)))

(deftest latin-to-english
  (let [latin "ardebam"
        latin-model (-> ((-> models :la)) deref)
        latin-structure
        (-> latin
            (babel.latin/parse latin-model)
            first
            :parses
            first)

        semantics
        (-> latin-structure
            (get-in [:synsem :sem])
            strip-refs)

        english-structure
        (->  {:comp {:synsem {:agr (get-in latin-structure [:synsem :agr])}}
              :slash false ;; TODO: {:slash false,:synsem {:subcat '()}} should be defaults of English language model.
              :synsem {:sem semantics
                       :cat :verb
                       :subcat '()}}
             (babel.english/generate :model (-> ((-> models :en)) deref)))

        english (babel.english.morphology/fo english-structure
                                             :show-notes false)]

    (log/debug (str "babel.translate/latin-to-english: english-structure" english-structure))
    (log/debug (str "babel.translate/latin-to-english: english:" english))
    (is (or (= "I was burning" english)
            (= "I used to burn" english)))))

(ns babel.test.translate
  (:refer-clojure :exclude [get-in])
  (:require
   [babel.directory :refer [models]]
   [babel.test.it :as it]
   [babel.test.en :as en]
   [clojure.test :refer [deftest is]]
   [clojure.tools.logging :as log]
   [dag_unify.core :refer [get-in strip-refs]]))

;; In Italian, certain verbs, called "essere" verbs, when conjugated
;; in certain tenses, agree in gender and number with their subject:
;;
;; For example, compare:
;;  Italian: "loro sono andati"
;;  English: They (masculine plural) went.
;; but:
;;  Italian: "loro sono andate"
;;  English: They (feminine plural) went.
;;
;; In English we indicate feminine and masculine gender with ♀ and ♂,
;; respectively.

;; Test that gender agreement is correctly translated.
(deftest past-and-gender-agreement-feminine
  (let [italian "loro sono andate"

        italian-structure
        (-> italian
            babel.italiano/parse
            first
            :parses
            first)

        semantics
        (-> italian-structure
            (get-in [:synsem :sem])
            strip-refs)

        english-structure
        (->  {:synsem {:sem semantics}}
             (babel.english/generate (-> ((-> models :en)) deref)))

        english (babel.english/morph english-structure (-> ((-> models :en)) deref))]

    (= "they (♀) went" english)))

(deftest past-and-gender-agreement-masculine
  (let [italian "loro sono andati"

        italian-structure
        (-> italian
            babel.italiano/parse
            first
            :parses
            first)

        semantics
        (-> italian-structure
            (get-in [:synsem :sem])
            strip-refs)

        english-structure
        (->  {:synsem {:sem semantics}}
             (babel.english/generate (-> ((-> models :en)) deref)))

        english (babel.english/morph english-structure (-> ((-> models :en)) deref))]

    (= "they (♂) went" english)))

(deftest latin-to-english
  (let [latin "ardebam"
        latin-model (-> ((-> models :la)) deref)
        latin-structure
        (-> latin
            (babel.latin/parse latin-model)
            first
            :parses
            first)

        semantics
        (-> latin-structure
            (get-in [:synsem :sem])
            strip-refs)

        english-structure
        (->  {:comp {:synsem {:agr (get-in latin-structure [:synsem :agr])}}
              :slash false ;; TODO: {:slash false,:synsem {:subcat '()}} should be defaults of English language model.
              :synsem {:sem semantics
                       :cat :verb
                       :subcat '()}}
             (babel.english/generate (-> ((-> models :en)) deref)))

        english (babel.english/morph english-structure
                                     (-> ((-> models :en)) deref)
                                     :show-notes false)]

    (log/debug (str "babel.translate/latin-to-english: english-structure" english-structure))
    (log/debug (str "babel.translate/latin-to-english: english:" english))
    (is (or (= "I was burning" english)
            (= "I used to burn" english)))))

call babel.english/morph rather than babel.english.morphology/fo


; Run test with the lein-exec plugin:
; $ lein exec test/platform.clojure.test.clj
(load-file "platform/clojure/mailchecker.clj")

(ns clojure.test.example
  (:use clojure.test))

(defn expect-valid-result [expected-valid email]
  (is (= expected-valid (mailchecker/valid? email))))

(def expect-invalid (partial expect-valid-result false))
(def expect-valid (partial expect-valid-result true))

; Valid
(deftest true-for-valid-1
  (expect-valid "plop@plop.com"))
(deftest true-for-valid-2
  (expect-valid "my.ok@ok.plop.com"))
(deftest true-for-valid-3
  (expect-valid "my+ok@ok.plop.com"))
(deftest true-for-valid-4
  (expect-valid "my=ok@ok.plop.com"))
(deftest true-for-valid-5
  (expect-valid "ok@gmail.com"))
(deftest true-for-valid-6
  (expect-valid "ok@hotmail.com"))

; Invalid
(deftest false-for-invalid-1
  (expect-invalid "plopplop.com"))
(deftest false-for-invalid-2
  (expect-invalid "my+ok@ok=plop.com"))
(deftest false-for-invalid-3
  (expect-invalid "my,ok@ok.plop.com"))

(deftest false-for-spam-1
  (expect-invalid "ok@tmail.com"))
(deftest false-for-spam-2
  (expect-invalid "ok@33mail.com"))
(deftest false-for-spam-3
  (expect-invalid "ok@ok.33mail.com"))
(deftest false-for-spam-4
  (expect-invalid "ok@guerrillamailblock.com"))

(deftest false-for-blacklist-entries
  (every? (fn [domain]
              (do (expect-invalid (str "test@" domain))
                  (expect-invalid (str "test@subdomain." domain))
                  ;; Blacklisted domains should be valid as subdomains of a
                  ;; valid domain.
                  (expect-valid (str "test@" domain ".gmail.com"))))
          mailchecker/blacklist))

(run-all-tests)

; Run test with the lein-exec plugin:
; $ lein exec test/platform.clojure.test.clj
(load-file "platform/clojure/mailchecker.clj")

(ns clojure.test.example
  (:use clojure.test))

(defn expect-valid-result [expected-valid email]
  (is (= expected-valid (mailchecker/valid? email))))

(def expect-invalid (partial expect-valid-result false))
(def expect-valid (partial expect-valid-result true))

(deftest true-for-valid
  (do (expect-valid "plop@plop.com")
      (expect-valid "my.ok@ok.plop.com")
      (expect-valid "my+ok@ok.plop.com")
      (expect-valid "my=ok@ok.plop.com")
      (expect-valid "ok@gmail.com")
      (expect-valid "ok@hotmail.com")))

(deftest false-for-invalid
  (do (expect-invalid "")
      (expect-invalid "  ")
      (expect-invalid "plopplop.com")
      (expect-invalid "my+ok@ok=plop.com")
      (expect-invalid "my,ok@ok.plop.com")))

(deftest false-for-throwable-domain
  (do (expect-invalid "ok@tmail.com")
      (expect-invalid "ok@33mail.com")
      (expect-invalid "ok@ok.33mail.com")
      (expect-invalid "ok@guerrillamailblock.com")))

(deftest false-for-blacklist-entries
  (every? (fn [domain]
              (do (expect-invalid (str "test@" domain))
                  (expect-invalid (str "test@subdomain." domain))
                  ;; Blacklisted domains should be valid as subdomains of a
                  ;; valid domain.
                  (expect-valid (str "test@" domain ".gmail.com"))))
          mailchecker/blacklist))

(run-all-tests)

Update Clojure tests

Update Clojure tests

- Multiple expectations per test
- Add blank/empty invalid email tests


(ns cavm.cgdata
  (:require [clojure.data.json :as json])
  (:require [clojure.string :as s])
  (:require [clojure.java.io :as io])
  (:require [clojure-csv.core :as csv])
  (:require [me.raynes.fs :as fs])
  (:require clojure.pprint)
  (:require [cavm.readers :refer [reader]])
  (:gen-class))

;
; Utility functions
;

(defn- chunked-pmap [f coll]
  (->> coll
       (partition-all 250)
       (pmap (fn [chunk] (doall (map f chunk))))
       (apply concat)))

(defn- normalized-path
  "Like fs/normalized-path, but doesn't add *cwd*."
  [path]
  (fs/with-cwd "/"
    (apply io/file (drop 1 (fs/split (fs/normalized-path path))))))

(defn- tabbed [line]
  (s/split line #"\t"))

;
; cgData metadata
;

(defn- all-json [path]
  (let [files (file-seq (io/file path))
        fnames (map str files)]
    (map #(vector (s/replace % #"\.json$" "") (json/read-str (slurp %)))
         (filter #(.endsWith ^String % ".json") fnames))))

(defn- json-add [acc [file {n "name" t "type" :as metadata}]]
  (if-let [group (and (= t "probeMap") (metadata "group"))]
    (assoc-in acc [t (str group "::" (metadata ":assembly"))] file)
    (assoc-in acc [t n] file)))

(defn- json-table [json-list]
  (reduce json-add {} json-list))

(defn- dirname [file]
   (s/replace file #"[^/]*$" ""))

(defn- basename [file]
  (s/replace file #".*/([^/]*)$" "$1"))

(defn- make-absolute [^String path]
  (if (.startsWith path "/")
    path
    (str "/" path)))

(defn- normalize-path [cut file path]
  (if (= (dirname file) (dirname path))
    (basename path)
    (make-absolute (subs path cut))))

; either pass through [k v] or map it to a file if
; it matches an object in the table.
(defn resolve-reference [normalize table file [k v]]
  (if-let [match (and (.startsWith ^String k ":")
                      (or
                        (get-in table [(subs k 1) v])
                        (get-in table [(subs k 1) (str v "::hg18")])))]
    [k (normalize file match)]
    [k v]))

; rewrite table to use files instead of object names
(defn- resolve-references [normalize table file metadata]
  (into {}
        (map #(resolve-reference normalize table file %) metadata)))

(defn- write-json [file json]
  (with-open [writer (io/writer file)]
    (binding [*out* writer]
      (json/pprint json :escape-slash false))))

(defn fix-json [root]
  (let [files (all-json root)
        table (json-table files)
        normalize (partial normalize-path (count root))]
    (doseq [[file data] files]
      (write-json (str file ".json")
                  (resolve-references normalize table file data)))))

; apply f to values of map
(defn- fmap [f m]
  (into {} (for [[k v] m] [k (f v)])))

;
; cgData clinicalFeature
;

(defmulti ^:private feature-line
  (fn [acc line] () (second line)))

(defmethod ^:private feature-line :default
  [acc [feature attr value]]
  (assoc-in acc [feature attr] value))

(defn- add-state [curr value]
  (conj (vec curr) value))

(defmethod ^:private feature-line "state"
  [acc [feature attr value]]
  (update-in acc [feature attr] add-state value))

(defn- parse-order [order]
  (first (csv/parse-csv order)))

(defmethod ^:private feature-line "stateOrder"
  [acc [feature attr value]]
  (assoc-in acc [feature attr] (parse-order value)))

(defn- feature-map [lines]
  "Read tab-split clincalFeature rows into a map"
  (reduce feature-line {} lines))

(defn- calc-order
  "Take feature order from 'stateOrder', or file order of 'state' rows."
  [feature]
  (if-let [state (or (feature "stateOrder") (feature "state"))]
    (-> feature
        (assoc :order (into {} (map #(vector %1 %2) state (range))))
        (assoc :state state))
    feature))

(defn feature-file [file]
  (when (and file (.exists (io/as-file file)))
    (->> file
         (slurp)
         (#(s/split % #"\n"))     ; split lines
         (map #(s/split % #"\t")) ; split tabs
         (feature-map)
         (fmap calc-order))))

;
; cgData genomicMatrix
;

(defn- parseFloatNA [str]
  (if (or (= str "NA") (= str "nan") (= str ""))
    Double/NaN
    (Float/parseFloat str)))

; If we have no feature description, we try "float". If that
; fails, we try "category" by passing in a hint. We do not
; allow the hint to override a feature description, since that
; would mask curation errors. multimethod may not be the best
; mechanism for this policy.

(defmulti ^:private data-line
  "(id val val val val) -> seq of parsed values)

  Return from a split probe line a probe name,
  feature definition, data type, and seq of floats"
  (fn [features cols & [hint]]
    (or (get (get features (first cols)) "valueType")
        hint)))

(defmethod ^:private data-line :default
  [features cols & [hint]]
  (try ; the body must be eager so we stay in the try/except scope
    (let [feature (get features (first cols))]
      {:field (String. ^String (first cols)) ; copy, because split is evil.
       :feature feature
       :valueType "float"
       :scores (mapv parseFloatNA (rest cols))}) ; eager
    (catch NumberFormatException e
      (data-line features cols "category"))))

; update map with value for NA
(defn- nil-val [order]
  (assoc order "" Double/NaN))

(defn- ad-hoc-order
  "Provide default order from data order in file"
  [feature cols]
  (if (:order feature)
    feature
    (let [state (distinct cols) ; XXX drop ""? This adds "" as a state.
          order (into {} (map vector state (range)))] ; XXX handle all values null?
      (assoc feature :state state :order order))))

(defn- throw-on-nil [x msg & args]
  (when-not x
    (throw (IllegalArgumentException.
             (apply format msg args))))
  x)

(defmethod ^:private data-line "category"
  [features cols & [hint]]
  (let [name (first cols)
        feature (get features name)  ; use 'get' to handle nil
        feature (ad-hoc-order feature (rest cols))
        order (nil-val (:order feature))
        msg "Invalid state %s for feature %s"
        vals (map #(throw-on-nil (order %) msg % name)
                  (rest cols))]

    {:field (String. ^String name) ; copy the string. string/split is evil.
     :feature feature
     :valueType "category"
     :scores vals}))

(defmulti matrix-data
  "Return samples and seq of scores, probes X samples"
  (fn [metadata features lines] (metadata "type")))

(defmethod matrix-data :default
  [metadata features lines]
  {:fields (chunked-pmap #(data-line features (tabbed %)) (rest lines))
   :samples (rest (tabbed (first lines)))})

(defn- transpose [lines]
  (apply mapv vector lines))

(defmethod matrix-data "clinicalMatrix"
  [metadata features lines]
  (let [lines (transpose (map tabbed lines))]
    {:fields (chunked-pmap #(data-line features %) (rest lines))
     :samples (rest (first lines))}))

(defn- cgdata-meta [file]
  (let [mfile (io/as-file (str file ".json"))]
    (when (.exists mfile)
      (json/read-str (slurp mfile)))))

(defn- path-from-root
  "Return file path relative to root"
  [root file]
  (let [root (fs/normalized-path root)
        file (fs/normalized-path file)]
    (when-not (fs/child-of? root file)
      (throw (IllegalArgumentException. (str file " not in root path: " root))))
    (apply io/file (drop (count (fs/split root)) (fs/split file)))))

(defn- path-from-ref
  "Construct a file path relative to the root of the referring file. 'referer'
  must be relative to root."
  [referrer file]
  (let [sref (fs/split referrer)
        sfile (fs/split file)]
    (if (= (first sfile) fs/unix-root)
      (apply io/file (drop 1 sfile))
      (fs/with-cwd fs/unix-root
        (normalized-path (apply io/file (concat (drop-last 1 sref) sfile)))))))

(defn- references [referrer md]
  "Return map of any references in md to their paths relative to the root. 'referer'
  must be relative to root."
  (let [refs (->> md
                  (keys)
                  (filter #(.startsWith % ":")))]
    (into {} (map vector refs (map #(str (path-from-ref referrer (md %))) refs)))))

(defn matrix-file
  "Return a map describing a cgData matrix file. This will read
  any assoicated json or clinicalFeature file."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (or (cgdata-meta file) {"name" file})
        refs (references rfile meta-data)
        cf (refs ":clinicalFeature")
        feature (when cf (feature-file (fs/file root cf)))]

    {:rfile rfile        ; file relative to root
     :meta meta-data     ; json metadata
     :refs refs          ; map of json metadata references to paths relative to root
     :features feature   ; slurped clinicalFeatures
     :data-fn (fn [in] (matrix-data meta-data feature (line-seq in)))}))

;
; cgData probemaps
;

(defn- split-no-empty [in pat] ; XXX Does this need to handle quotes?
  (filter #(not (= "" %)) (s/split in pat)))

(defn- probemap-row [row]
  (let [[name genes chrom start end strand] (s/split row #"\t")]
    {:name name
     :genes (split-no-empty genes #",")
     :chrom chrom
     :chromStart (. Integer parseInt start)
     :chromEnd (. Integer parseInt end)
     :strand strand}))

(defn probemap-data
  "Return seq of probes entries as maps"
  [rows]
  (map probemap-row rows))

(defn probemap-file
  "Return a map describing a cgData probemap file. This will read
  any assoicated json."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (cgdata-meta file)
        refs (references rfile meta-data)]
    {:rfile rfile
     :meta meta-data
     :refs refs}))

;
; cgdata file detector
;

(def types
  {"clincialMatrix" ::clinical
   "genomicMatrix" ::genomic
   "probeMap" ::probeMap})

(defn detect-cgdata
  "Detect cgdata files by presence of json metadata. If no type
  is give, assume genomicMatrix"
  [file]
  (when-let [cgmeta (cgdata-meta file)]
    (or (types (cgmeta "type")) ::genomic)))

;
; cgdata file reader
;

(defmethod reader ::probeMap
  [filetype url]
  (probemap-file url))

(defmethod reader ::genomic
  [filetype url]
  (matrix-file url))

;
;
;

(defn tabs [line]
  (count (filter #(= % \tab) line)))

(defn is-tsv?
  "Detect tsv. Requires two non-blank lines, each having
  at least one tab."
  [lines]
  (let [head (take 2 (filter #(re-matches #".*\S.*" %) lines))] ; two non-blank lines
    (and
      (> (count head) 1)
      (every? #(> (tabs %) 0) head))))

; XXX Note that this will pick up all kinds of unrelated files,
; including probeMaps without assocated json metadata.
(defn detect-tsv
  "Return ::tsv if the file is tsv, or nil"
  [file]
  (when (with-open [in (io/reader file)]
        (is-tsv? (line-seq in)))
    ::tsv))

(defmethod reader ::tsv
  [filetype url]
  (matrix-file url))

(ns cavm.cgdata
  (:require [clojure.data.json :as json])
  (:require [clojure.string :as s])
  (:require [clojure.java.io :as io])
  (:require [clojure-csv.core :as csv])
  (:require [me.raynes.fs :as fs])
  (:require clojure.pprint)
  (:require [cavm.readers :refer [reader]])
  (:gen-class))

;
; Utility functions
;

(defn- chunked-pmap [f coll]
  (->> coll
       (partition-all 250)
       (pmap (fn [chunk] (doall (map f chunk))))
       (apply concat)))

(defn- normalized-path
  "Like fs/normalized-path, but doesn't add *cwd*."
  [path]
  (fs/with-cwd "/"
    (apply io/file (drop 1 (fs/split (fs/normalized-path path))))))

(defn- tabbed [line]
  (s/split line #"\t"))

;
; cgData metadata
;

(defn- all-json [path]
  (let [files (file-seq (io/file path))
        fnames (map str files)]
    (map #(vector (s/replace % #"\.json$" "") (json/read-str (slurp %)))
         (filter #(.endsWith ^String % ".json") fnames))))

(defn- json-add [acc [file {n "name" t "type" :as metadata}]]
  (if-let [group (and (= t "probeMap") (metadata "group"))]
    (assoc-in acc [t (str group "::" (metadata ":assembly"))] file)
    (assoc-in acc [t n] file)))

(defn- json-table [json-list]
  (reduce json-add {} json-list))

(defn- dirname [file]
   (s/replace file #"[^/]*$" ""))

(defn- basename [file]
  (s/replace file #".*/([^/]*)$" "$1"))

(defn- make-absolute [^String path]
  (if (.startsWith path "/")
    path
    (str "/" path)))

(defn- normalize-path [cut file path]
  (if (= (dirname file) (dirname path))
    (basename path)
    (make-absolute (subs path cut))))

; either pass through [k v] or map it to a file if
; it matches an object in the table.
(defn resolve-reference [normalize table file [k v]]
  (if-let [match (and (.startsWith ^String k ":")
                      (or
                        (get-in table [(subs k 1) v])
                        (get-in table [(subs k 1) (str v "::hg18")])))]
    [k (normalize file match)]
    [k v]))

; rewrite table to use files instead of object names
(defn- resolve-references [normalize table file metadata]
  (into {}
        (map #(resolve-reference normalize table file %) metadata)))

(defn- write-json [file json]
  (with-open [writer (io/writer file)]
    (binding [*out* writer]
      (json/pprint json :escape-slash false))))

(defn fix-json [root]
  (let [files (all-json root)
        table (json-table files)
        normalize (partial normalize-path (count root))]
    (doseq [[file data] files]
      (write-json (str file ".json")
                  (resolve-references normalize table file data)))))

; apply f to values of map
(defn- fmap [f m]
  (into {} (for [[k v] m] [k (f v)])))

;
; cgData clinicalFeature
;

(defmulti ^:private feature-line
  (fn [acc line] () (second line)))

(defmethod ^:private feature-line :default
  [acc [feature attr value]]
  (assoc-in acc [feature attr] value))

(defn- add-state [curr value]
  (conj (vec curr) value))

(defmethod ^:private feature-line "state"
  [acc [feature attr value]]
  (update-in acc [feature attr] add-state value))

(defn- parse-order [order]
  (first (csv/parse-csv order)))

(defmethod ^:private feature-line "stateOrder"
  [acc [feature attr value]]
  (assoc-in acc [feature attr] (parse-order value)))

(defn- feature-map [lines]
  "Read tab-split clincalFeature rows into a map"
  (reduce feature-line {} lines))

(defn- calc-order
  "Take feature order from 'stateOrder', or file order of 'state' rows."
  [feature]
  (if-let [state (or (feature "stateOrder") (feature "state"))]
    (-> feature
        (assoc :order (into {} (map #(vector %1 %2) state (range))))
        (assoc :state state))
    feature))

(defn feature-file [file]
  (when (and file (.exists (io/as-file file)))
    (->> file
         (slurp)
         (#(s/split % #"\n"))     ; split lines
         (map #(s/split % #"\t")) ; split tabs
         (feature-map)
         (fmap calc-order))))

;
; cgData genomicMatrix
;

(defn- parseFloatNA [str]
  (if (or (= str "NA") (= str "nan") (= str ""))
    Double/NaN
    (Float/parseFloat str)))

; If we have no feature description, we try "float". If that
; fails, we try "category" by passing in a hint. We do not
; allow the hint to override a feature description, since that
; would mask curation errors. multimethod may not be the best
; mechanism for this policy.

(defmulti ^:private data-line
  "(id val val val val) -> seq of parsed values)

  Return from a split probe line a probe name,
  feature definition, data type, and seq of floats"
  (fn [features cols & [hint]]
    (or (get (get features (first cols)) "valueType")
        hint)))

(defmethod ^:private data-line :default
  [features cols & [hint]]
  (try ; the body must be eager so we stay in the try/except scope
    (let [feature (get features (first cols))]
      {:field (String. ^String (first cols)) ; copy, because split is evil.
       :feature feature
       :valueType "float"
       :scores (mapv parseFloatNA (rest cols))}) ; eager
    (catch NumberFormatException e
      (data-line features cols "category"))))

; update map with value for NA
(defn- nil-val [order]
  (assoc order "" Double/NaN))

(defn- ad-hoc-order
  "Provide default order from data order in file"
  [feature cols]
  (if (:order feature)
    feature
    (let [state (distinct cols) ; XXX drop ""? This adds "" as a state.
          order (into {} (map vector state (range)))] ; XXX handle all values null?
      (assoc feature :state state :order order))))

(defn- throw-on-nil [x msg & args]
  (when-not x
    (throw (IllegalArgumentException.
             (apply format msg args))))
  x)

(defmethod ^:private data-line "category"
  [features cols & [hint]]
  (let [name (first cols)
        feature (get features name)  ; use 'get' to handle nil
        feature (ad-hoc-order feature (rest cols))
        order (nil-val (:order feature))
        msg "Invalid state %s for feature %s"
        vals (map #(throw-on-nil (order %) msg % name)
                  (rest cols))]

    {:field (String. ^String name) ; copy the string. string/split is evil.
     :feature feature
     :valueType "category"
     :scores vals}))

(defmulti matrix-data
  "Return samples and seq of scores, probes X samples"
  (fn [metadata features lines] (metadata "type")))

(defmethod matrix-data :default
  [metadata features lines]
  {:fields (chunked-pmap #(data-line features (tabbed %)) (rest lines))
   :samples (rest (tabbed (first lines)))})

(defn- transpose [lines]
  (apply mapv vector lines))

(defmethod matrix-data "clinicalMatrix"
  [metadata features lines]
  (let [lines (transpose (map tabbed lines))]
    {:fields (chunked-pmap #(data-line features %) (rest lines))
     :samples (rest (first lines))}))

(defn- cgdata-meta [file]
  (let [mfile (io/as-file (str file ".json"))]
    (when (.exists mfile)
      (json/read-str (slurp mfile)))))

(defn- path-from-root
  "Return file path relative to root"
  [root file]
  (let [root (fs/normalized-path root)
        file (fs/normalized-path file)]
    (when-not (fs/child-of? root file)
      (throw (IllegalArgumentException. (str file " not in root path: " root))))
    (apply io/file (drop (count (fs/split root)) (fs/split file)))))

(defn- path-from-ref
  "Construct a file path relative to the root of the referring file. 'referer'
  must be relative to root."
  [referrer file]
  (let [sref (fs/split referrer)
        sfile (fs/split file)]
    (if (= (first sfile) fs/unix-root)
      (apply io/file (drop 1 sfile))
      (fs/with-cwd fs/unix-root
        (normalized-path (apply io/file (concat (drop-last 1 sref) sfile)))))))

(defn- references [referrer md]
  "Return map of any references in md to their paths relative to the root. 'referer'
  must be relative to root."
  (let [refs (->> md
                  (keys)
                  (filter #(.startsWith % ":")))]
    (into {} (map vector refs (map #(str (path-from-ref referrer (md %))) refs)))))

(defn matrix-file
  "Return a map describing a cgData matrix file. This will read
  any assoicated json or clinicalFeature file."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (or (cgdata-meta file) {"name" file})
        refs (references rfile meta-data)
        cf (refs ":clinicalFeature")
        feature (when cf (feature-file (fs/file root cf)))]

    {:rfile rfile        ; file relative to root
     :meta meta-data     ; json metadata
     :refs refs          ; map of json metadata references to paths relative to root
     :features feature   ; slurped clinicalFeatures
     :data-fn (fn [in] (matrix-data meta-data feature (line-seq in)))}))

;
; cgData probemaps
;

(defn- split-no-empty [in pat] ; XXX Does this need to handle quotes?
  (filter #(not (= "" %)) (s/split in pat)))

(defn- probemap-row [row]
  (let [[name genes chrom start end strand] (s/split row #"\t")]
    {:name name
     :genes (split-no-empty genes #",")
     :chrom chrom
     :chromStart (. Integer parseInt start)
     :chromEnd (. Integer parseInt end)
     :strand strand}))

(defn probemap-data
  "Return seq of probes entries as maps"
  [rows]
  (map probemap-row rows))

(defn probemap-file
  "Return a map describing a cgData probemap file. This will read
  any assoicated json."
  [file & {root :root :or {root fs/unix-root}}]
  (let [rfile (str (path-from-root root file))
        meta-data (cgdata-meta file)
        refs (references rfile meta-data)]
    {:rfile rfile
     :meta meta-data
     :refs refs}))

;
; cgdata file detector
;

(def types
  {"clincialMatrix" ::matrix
   "genomicMatrix" ::matrix
   "probeMap" ::probeMap})

(defn detect-cgdata
  "Detect cgdata files by presence of json metadata. If no type
  is give, assume genomicMatrix"
  [file]
  (when-let [cgmeta (cgdata-meta file)]
    (or (types (cgmeta "type")) ::genomic)))

;
; cgdata file reader
;

(defmethod reader ::probeMap
  [filetype url]
  (probemap-file url))

(defmethod reader ::matrix
  [filetype url]
  (matrix-file url))

;
;
;

(defn tabs [line]
  (count (filter #(= % \tab) line)))

(defn is-tsv?
  "Detect tsv. Requires two non-blank lines, each having
  at least one tab."
  [lines]
  (let [head (take 2 (filter #(re-matches #".*\S.*" %) lines))] ; two non-blank lines
    (and
      (> (count head) 1)
      (every? #(> (tabs %) 0) head))))

; XXX Note that this will pick up all kinds of unrelated files,
; including probeMaps without assocated json metadata.
(defn detect-tsv
  "Return ::tsv if the file is tsv, or nil"
  [file]
  (when (with-open [in (io/reader file)]
        (is-tsv? (line-seq in)))
    ::tsv))

(defmethod reader ::tsv
  [filetype url]
  (matrix-file url))

Handle genomic & clinical with matrix loader.


(ns clstreams.processor-test
  (:require [clojure.string :as str]
            [clojure.test :refer :all]
            [clstreams.processor :as prc]
            [flatland.ordered.map :refer [ordered-map]]
            [clojure.test.check :as tc]
            [clojure.test.check.generators :as gen]
            [clojure.test.check.properties :as prop]
            [clojure.test.check.clojure-test :refer [defspec]]
            [clojure.spec.alpha :as s]))

(deftest conform-predecessors-test
  (testing "s/conform converts predecessors to a map"
    (let [input [:op01 :op02]
          preds (s/conform ::prc/preds input)]
      (is (set? preds))
      (is (= preds #{:op02 :op01}))))
  (testing "invalid collections won't conform"
    (is (= (s/conform ::prc/preds []) ::s/invalid))
    (is (= (s/conform ::prc/preds ["op01" "op02"]) ::s/invalid))))

(defn verify-topological-order
  ([ordered] (verify-topological-order #{} ordered))
  ([seen-ids [node & remaining-ordered]]
   (if-let [[node-id {preds ::prc/preds}] node]
     (if-let [not-preceding (seq (remove seen-ids preds))]
       (format "Node %s not preceded by expected predecesor(s) %s"
               node-id (str/join ", " not-preceding))
       (recur (conj seen-ids node-id) remaining-ordered))
     nil)))

(deftest verify-topological-order-test
  (is (nil? (verify-topological-order
             [[:n1 {}]
              [:n2 {::prc/preds [:n1]}]])))
  (is (= (verify-topological-order
          [[:n1 {}]
           [:n2 {::prc/preds [:n3 :n1 :n4]}]])
         "Node :n2 not preceded by expected predecesor(s) :n3, :n4")))

(defn check-order-nodes [nodes]
  (let [ordered (prc/order-nodes nodes)
        msg (verify-topological-order (seq ordered))]
    (is (= nodes ordered) "same nodes are present in the ordered map")
    (if msg (is false msg))))

(deftest order-nodes-test
  (testing "empty topology"
    (check-order-nodes {}))
  (testing "only sources"
    (let [top1 {:op01 {}}
          top2 (assoc top1 :op02 {})]
      (check-order-nodes top1)
      (check-order-nodes top2)))
  (testing "linear processor sequence"
    (check-order-nodes {:op01 {}
                        :op02 {::prc/preds [:op01]}
                        :op03 {::prc/preds [:op02]}
                        :op04 {::prc/preds [:op03]}
                        :op05 {::prc/preds [:op04]}
                        :op06 {::prc/preds [:op05]}}))
  (testing "two separate strands"
    (check-order-nodes {:op01 {}
                        :op02 {::prc/preds [:op01]}
                        :op03 {::prc/preds [:op02]}
                        :op04 {}
                        :op05 {::prc/preds [:op04]}
                        :op06 {::prc/preds [:op05]}})))

(defn verify-cycle [nodes cycle]
  (let [broken-links
        (->> (map vector cycle (concat (rest cycle) [(first cycle)]))
             (remove (fn [[pred succ]] ((into #{} (::prc/preds (nodes succ))) pred))))]
    (if-let [[pred succ] (first (seq broken-links))]
      (format "Node %s is not a succesor of %s in cycle %s" succ pred (into [] cycle)))))

(deftest verify-cycle-test
  (is (nil? (verify-cycle {:op01 {::prc/preds [:op02]}
                           :op02 {::prc/preds [:op01]}}
                          [:op01 :op02])))
  (is (= (verify-cycle {:op01 {::prc/preds [:op02]}
                        :op02 {::prc/preds []}}
                       [:op01 :op02])
         "Node :op02 is not a succesor of :op01 in cycle [:op01 :op02]")))

(defn check-order-nodes-with-cycle [nodes]
  (let [{cycle ::prc/cycle} (prc/order-nodes nodes)
        msg (verify-cycle nodes cycle)]
    (is cycle "order-nodes didn't find a cycle")
    (is (not (empty? cycle)) "order-nodes returned an empty cycle")
    (if msg (is false msg))))

(deftest order-nodes-with-cycle-test
  (testing "one node pointing to itself"
    (check-order-nodes-with-cycle {:op01 {::prc/preds [:op01]}}))
  (testing "two nodes in a cycle"
    (check-order-nodes-with-cycle {:op01 {::prc/preds [:op02]}
                                   :op02 {::prc/preds [:op01]}}))
  (testing "larger cycle"
    (check-order-nodes-with-cycle {:op01 {::prc/preds [:op03]}
                                   :op02 {::prc/preds [:op01]}
                                   :op03 {::prc/preds [:op02]}}))
  (testing "two nodes in a cycle in a larger graph"
    (check-order-nodes-with-cycle {:op01 {::prc/preds [:op02]}
                                   :op02 {::prc/preds [:op01]}
                                   :op03 {::prc/preds []}})))

(defn gen-dag [size]
  (letfn [(label [n] (keyword (format "op%02d" n)))]
    (into {}
          (for [i (range size)
                :let [preds (if (= i 0)
                              []
                              (gen/generate (gen/vector-distinct (gen/elements (range i)))))]]
            [(label i) {::prc/preds (into [] (map label preds))}]))))

(defspec order-nodes-is-topological-prop
  50
  (prop/for-all [nodes (gen/fmap gen-dag gen/int)]
                (let [ordered (prc/order-nodes nodes)
                      msg (verify-topological-order (seq ordered))]
                  (and (= nodes ordered)
                       (nil? msg)))))

(ns clstreams.processor-test
  (:require [clojure.string :as str]
            [clojure.test :refer :all]
            [clstreams.processor :as prc]
            [flatland.ordered.map :refer [ordered-map]]
            [clojure.test.check :as tc]
            [clojure.test.check.generators :as gen]
            [clojure.test.check.properties :as prop]
            [clojure.test.check.clojure-test :refer [defspec]]
            [clojure.spec.alpha :as s]))

(deftest conform-predecessors-test
  (testing "s/conform converts predecessors to a map"
    (let [input [:op01 :op02]
          preds (s/conform ::prc/preds input)]
      (is (set? preds))
      (is (= preds #{:op02 :op01}))))
  (testing "invalid collections won't conform"
    (is (= (s/conform ::prc/preds []) ::s/invalid))
    (is (= (s/conform ::prc/preds ["op01" "op02"]) ::s/invalid))))

(defn verify-topological-order
  ([ordered] (verify-topological-order #{} ordered))
  ([seen-ids [node & remaining-ordered]]
   (if-let [[node-id {preds ::prc/preds}] node]
     (if-let [not-preceding (seq (remove seen-ids preds))]
       (format "Node %s not preceded by expected predecesor(s) %s"
               node-id (str/join ", " not-preceding))
       (recur (conj seen-ids node-id) remaining-ordered))
     nil)))

(deftest verify-topological-order-test
  (is (nil? (verify-topological-order
             [[:n1 {}]
              [:n2 {::prc/preds [:n1]}]])))
  (is (= (verify-topological-order
          [[:n1 {}]
           [:n2 {::prc/preds [:n3 :n1 :n4]}]])
         "Node :n2 not preceded by expected predecesor(s) :n3, :n4")))

(defn verify-cycle [nodes cycle]
  (let [broken-links
        (->> (map vector cycle (concat (rest cycle) [(first cycle)]))
             (remove (fn [[pred succ]] ((into #{} (::prc/preds (nodes succ))) pred))))]
    (if-let [[pred succ] (first (seq broken-links))]
      (format "Node %s is not a succesor of %s in cycle %s" succ pred (into [] cycle)))))

(deftest verify-cycle-test
  (is (nil? (verify-cycle {:op01 {::prc/preds [:op02]}
                           :op02 {::prc/preds [:op01]}}
                          [:op01 :op02])))
  (is (= (verify-cycle {:op01 {::prc/preds [:op02]}
                        :op02 {::prc/preds []}}
                       [:op01 :op02])
         "Node :op02 is not a succesor of :op01 in cycle [:op01 :op02]")))

(defn check-order-nodes [nodes]
  (let [ordered (prc/order-nodes nodes)
        {cycle ::prc/cycle} ordered]
    (if cycle
      (do
        (let [msg (verify-cycle nodes cycle)] (is (not msg) msg))
        (is cycle "order-nodes didn't find a cycle")
        (is (not (empty? cycle)) "order-nodes returned an empty cycle"))
      (do
        (let [msg (verify-topological-order (seq ordered))] (is (not msg) msg))
        (is (= nodes ordered) "same nodes aren't present in the ordered map")))))

(deftest order-nodes-test
  (testing "empty topology"
    (check-order-nodes {}))
  (testing "only sources"
    (let [top1 {:op01 {}}
          top2 (assoc top1 :op02 {})]
      (check-order-nodes top1)
      (check-order-nodes top2)))
  (testing "linear processor sequence"
    (check-order-nodes {:op01 {}
                        :op02 {::prc/preds [:op01]}
                        :op03 {::prc/preds [:op02]}
                        :op04 {::prc/preds [:op03]}
                        :op05 {::prc/preds [:op04]}
                        :op06 {::prc/preds [:op05]}}))
  (testing "two separate strands"
    (check-order-nodes {:op01 {}
                        :op02 {::prc/preds [:op01]}
                        :op03 {::prc/preds [:op02]}
                        :op04 {}
                        :op05 {::prc/preds [:op04]}
                        :op06 {::prc/preds [:op05]}})))

(deftest order-nodes-with-cycle-test
  (testing "one node pointing to itself"
    (check-order-nodes {:op01 {::prc/preds [:op01]}}))
  (testing "two nodes in a cycle"
    (check-order-nodes {:op01 {::prc/preds [:op02]}
                        :op02 {::prc/preds [:op01]}}))
  (testing "larger cycle"
    (check-order-nodes {:op01 {::prc/preds [:op03]}
                        :op02 {::prc/preds [:op01]}
                        :op03 {::prc/preds [:op02]}}))
  (testing "two nodes in a cycle in a larger graph"
    (check-order-nodes {:op01 {::prc/preds [:op02]}
                        :op02 {::prc/preds [:op01]}
                        :op03 {::prc/preds []}})))

(defn gen-dag [size]
  (letfn [(label [n] (keyword (format "op%02d" n)))]
    (into {}
          (for [i (range size)
                :let [preds (if (= i 0)
                              []
                              (gen/generate (gen/vector-distinct (gen/elements (range i)))))]]
            [(label i) {::prc/preds (into [] (map label preds))}]))))

(defspec order-nodes-is-topological-prop
  50
  (prop/for-all [nodes (gen/fmap gen-dag gen/int)]
                (let [ordered (prc/order-nodes nodes)
                      msg (verify-topological-order (seq ordered))]
                  (and (= nodes ordered)
                       (nil? msg)))))

Reorganize test code for topological order.


(defproject date-rule-instaparse "0.1.0-SNAPSHOT"
  :description "Date Rule Interpreter using Instaparse"
  :url "http://hjuergens.github.io/date-parser/date-rule-instaparse"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.7.0"] [instaparse "1.4.2"] [rhizome "0.2.5"]]
  :main date-rule-instaparse.core
  :aot [date-rule-instaparse.core])

(defproject date-rule-instaparse "0.1.0-SNAPSHOT"
  :description "Date Rule Interpreter using Instaparse"
  :url "http://hjuergens.github.io/date-parser/date-rule-instaparse"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.7.0"] [instaparse "1.4.8"] [rhizome "0.2.9"]]
  :main date-rule-instaparse.core
  :aot [date-rule-instaparse.core])

Update dependencies

Update dependencies


;;
;; 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.40.4"
  :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 "4.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.40.5-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 "4.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 version

bump version


(ns org.broadinstitute.firecloud-ui.page.workspace.method-config-importer
  (:require
    [dmohs.react :as react]
    clojure.string
    [org.broadinstitute.firecloud-ui.common :as common]
    [org.broadinstitute.firecloud-ui.common.icons :as icons]
    [org.broadinstitute.firecloud-ui.common.style :as style]
    [org.broadinstitute.firecloud-ui.common.table :as table]
    [org.broadinstitute.firecloud-ui.common.components :as comps]
    [org.broadinstitute.firecloud-ui.paths :as paths]
    [org.broadinstitute.firecloud-ui.utils :as utils]))

(defn create-path [workspaceNamespace workspaceName]
  (str "/" workspaceNamespace "/"  workspaceName  "/methodconfigs/copyFromMethodRepo"))

(defn create-post-data
  [selected-conf-name
   selected-conf-ns
   selected-conf-snapId
   dest-name
   dest-namespace]
  {"configurationNamespace" selected-conf-ns
   "configurationName" selected-conf-name
   "configurationSnapshotId" selected-conf-snapId
   "destinationNamespace" dest-namespace
   "destinationName" dest-name})

(defn- create-mock-methodconfs-import []
  (map
    (fn [i]
      {:name (str "Configuration " (inc i))
       :url (str "http://agora-ci.broadinstitute.org/configurations/joel_test/jt_test_config/1")
       :namespace (rand-nth ["Broad" "nci" "public" "ISB"])
       :snapshotId (rand-nth (range 100))
       :synopsis (str (rand-nth ["variant caller synopsis","gene analyzer synopsis","mutect synopsis"]) " " (inc i))
       :createDate (str "20"(inc i) "-06-10T16:54:26Z")
       :owner (rand-nth ["thibault@broadinstitute.org" "esalinas@broadinstitute.org"  ])})
    (range (rand-int 50))))

(react/defc ModalImportOptionsAndButton
  {:render (fn [{:keys [state props refs]}]
             (let [selected-conf-name (get  props :init-Name)
                   selected-conf-namespace (get props :init-Namespace)
                   selected-conf-snapshotId (get props :init-SnapshotId)
                   workspace (:workspace props)
                   dest-workspace-name (get workspace "name")
                   dest-workspace-namespace (get workspace "namespace")]
               [:div {:style {:backgroundColor (:background-gray style/colors)}}
                [:div {}
                 "Destination Name : "
                 (style/create-text-field {:defaultValue selected-conf-name :ref "destinationName"})]
                "Destination Namespace : "
                (style/create-text-field
                  {:defaultValue selected-conf-namespace
                   :ref "destinationNamespace"})
                [:br]
                [comps/Button
                 {:title-text "import selected"
                  :icon :plus
                  :onClick (fn []
                             (swap! (get props :parental-state) assoc :show-import-mc-modal? false)
                             (let [dest-conf-name (.-value (.getDOMNode (@refs "destinationName")))
                                   dest-conf-namespace (.-value (.getDOMNode (@refs "destinationNamespace")))
                                   post-data (create-post-data
                                               selected-conf-name
                                               selected-conf-namespace
                                               selected-conf-snapshotId
                                               dest-conf-name
                                               dest-conf-namespace)
                                   copy_URL (paths/copy-method-config-to-workspace-path workspace)]
                               (utils/ajax-orch
                                 copy_URL
                                 {:headers {"Content-Type" "application/json"}
                                  :canned-response {:responseText
                                                      (utils/->json-string (create-mock-methodconfs-import))
                                                    :status 200
                                                    :delay-ms (rand-int 2000)}
                                  :method :post
                                  :data (utils/->json-string post-data)
                                  :on-done (fn [{:keys [success? xhr]}]
                                             (if success?
                                               (utils/rlog "SUCCESS in import ! trigger re-render of workspace MC list here?")
                                               (js/alert (str "Error in import : "  (.-statusText xhr)))))})))}]]))})

(defn render-import-modal [state props refs]
  [comps/ModalDialog
   {:width 750
    :content (react/create-element
               [:div {}
                [:div {:style {:backgroundColor "#fff"
                               :borderBottom (str "1px solid " (:line-gray style/colors))
                               :padding "20px 48px 18px"
                               :fontSize "137%" :fontWeight 400 :lineHeight 1}}
                 "Import a Method Configuration"
                 [:hr]
                 (get-in @state [:selected-conf "name"])[:br]
                 (get-in @state [:selected-conf "namespace"]) [:br]
                 (get-in @state [:selected-conf "snapshotId"])]
                 [:div {:style {:position "absolute" :right 2 :top 2}}
                  [:div {:style {:backgroundColor (:button-blue style/colors) :color "#fff"
                                 :padding "0.5em" :cursor "pointer"}
                         :onClick (fn [] (swap! state assoc :show-import-mc-modal? false))}
                   (icons/font-icon {:style {:fontSize "60%"}} :x)]]
                [:div {:style {:padding "22px 48px 40px"
                               :backgroundColor (:background-gray style/colors)}}
                 [ModalImportOptionsAndButton {:init-Name (get-in @state [:selected-conf "name"])
                                               :init-Namespace (get-in @state [:selected-conf "namespace"])
                                               :init-SnapshotId (get-in @state [:selected-conf "snapshotId"])
                                               :parental-state state
                                               :workspace (get props :workspace)}]]])
    :show-when true}])

(react/defc ImportWorkspaceMethodsConfigurationsList
  {:render
   (fn [{:keys [state props refs]}]
     [:div {}
      (when (:show-import-mc-modal? @state)
        (render-import-modal state props refs))
      (cond
        (:loaded-import-confs? @state)
        (if (zero? (count (:method-confs @state)))
          (style/create-message-well "There are no method configurations to display for import!")
          [table/Table
           {:columns [{:header "Name" :starting-width 200 :filter-by #(% "name")
                       :content-renderer
                       (fn [row-index conf]
                         [:a
                          {:onClick
                           (fn []
                             (swap! state assoc :selected-conf conf :show-import-mc-modal? true))
                           :href "javascript:;"
                           :style {:color (:button-blue style/colors) :textDecoration "none"}}
                          (conf "name")])}
                      {:header "Namespace" :starting-width 200}
                      {:header "Snapshot Id" :starting-width 100}
                      {:header "Synopsis" :starting-width 160}
                      {:header "Create Date" :starting-width 210}
                      {:header "Owner" :starting-width 290}]
            :data (map
                    (fn [config]
                      [config
                       (config "namespace")
                       (config "snapshotId")
                       (config "synopsis")
                       (config "createDate")
                       (config "owner")])
                    (:method-confs @state))}])
        (:error-message @state) [:div {:style {:color "red"}}
                                 "FireCloud service returned error: " (:error-message @state)]
        :else [comps/Spinner {:text "Loading configurations for import..."}])])
   :component-did-mount
   (fn [{:keys [state]}]
     (utils/call-ajax-orch "/configurations"
       {:on-success (fn [{:keys [parsed-response]}]
                      (swap! state assoc :loaded-import-confs? true :method-confs parsed-response))
        :on-failure (fn [{:keys [status-text]}]
                      (swap! state assoc :error-message status-text))
        :mock-data (create-mock-methodconfs-import)}))})

(def modal-import-background
  {:backgroundColor "rgba(82, 129, 197, 0.4)"
   :overflowX "hidden" :overflowY "scroll"
   :position "fixed" :zIndex 9999
   :top 0 :right 0 :bottom 0 :left 0})

(def ^:private modal-import-content
  {:transform "translate(-50%, 0px)"
   :backgroundColor (:background-gray style/colors)
   :position "relative" :marginBottom 60
   :top 60
   :left "50%"
   :width "90%"})

(defn render-import-overlay [state  workspace ]
  (let [clear-import-overlay #(swap! state assoc :import-overlay-shown? false)]
    (when (:import-overlay-shown? @state)
      [:div {:style modal-import-background
             :onKeyDown (common/create-key-handler [:esc] clear-import-overlay)}
       [:div {:style modal-import-content}
        [:div {:style {:position "absolute" :right 2 :top 2}}
         [:div {:style {:backgroundColor (:button-blue style/colors) :color "#fff"
                        :padding "0.5em" :cursor "pointer"}
                :onClick #(swap! state assoc :import-overlay-shown? false)}
          (icons/font-icon {:style {:fontSize "60%"}} :x)]]
        [:div {:style {:backgroundColor "#fff"
                       :borderBottom (str "1px solid " (:line-gray style/colors))
                       :padding "20px 48px 18px"}}
         [:div {:style {:fontSize 24 :align "center" :textAlign "center" :paddingBottom "0.5em"}}
          "Select A Method Configuration For Import"]
         [ImportWorkspaceMethodsConfigurationsList {:workspace workspace}]
         [:div {:style {:paddingTop "0.5em"}}]]]])))

(ns org.broadinstitute.firecloud-ui.page.workspace.method-config-importer
  (:require
    [dmohs.react :as react]
    clojure.string
    [org.broadinstitute.firecloud-ui.common :as common]
    [org.broadinstitute.firecloud-ui.common.icons :as icons]
    [org.broadinstitute.firecloud-ui.common.style :as style]
    [org.broadinstitute.firecloud-ui.common.table :as table]
    [org.broadinstitute.firecloud-ui.common.components :as comps]
    [org.broadinstitute.firecloud-ui.paths :as paths]
    [org.broadinstitute.firecloud-ui.utils :as utils]))

(defn create-path [workspaceNamespace workspaceName]
  (str "/" workspaceNamespace "/"  workspaceName  "/methodconfigs/copyFromMethodRepo"))

(defn create-post-data
  [selected-conf-name
   selected-conf-ns
   selected-conf-snapId
   dest-name
   dest-namespace]
  {"configurationNamespace" selected-conf-ns
   "configurationName" selected-conf-name
   "configurationSnapshotId" (str selected-conf-snapId)
   "destinationNamespace" dest-namespace
   "destinationName" dest-name})

(defn- create-mock-methodconfs-import []
  (map
    (fn [i]
      {:name (str "Configuration " (inc i))
       :url (str "http://agora-ci.broadinstitute.org/configurations/joel_test/jt_test_config/1")
       :namespace (rand-nth ["Broad" "nci" "public" "ISB"])
       :snapshotId (rand-nth (range 100))
       :synopsis (str (rand-nth ["variant caller synopsis","gene analyzer synopsis","mutect synopsis"]) " " (inc i))
       :createDate (str "20"(inc i) "-06-10T16:54:26Z")
       :owner (rand-nth ["thibault@broadinstitute.org" "esalinas@broadinstitute.org"  ])})
    (range (rand-int 50))))

(react/defc ModalImportOptionsAndButton
  {:render (fn [{:keys [state props refs]}]
             (let [selected-conf-name (get  props :init-Name)
                   selected-conf-namespace (get props :init-Namespace)
                   selected-conf-snapshotId (get props :init-SnapshotId)
                   workspace (:workspace props)
                   dest-workspace-name (get workspace "name")
                   dest-workspace-namespace (get workspace "namespace")]
               [:div {:style {:backgroundColor (:background-gray style/colors)}}
                [:div {}
                 "Destination Name : "
                 (style/create-text-field {:defaultValue selected-conf-name :ref "destinationName"})]
                "Destination Namespace : "
                (style/create-text-field
                  {:defaultValue selected-conf-namespace
                   :ref "destinationNamespace"})
                [:br]
                [comps/Button
                 {:title-text "import selected"
                  :icon :plus
                  :onClick (fn []
                             (swap! (get props :parental-state) assoc :show-import-mc-modal? false)
                             (let [dest-conf-name (.-value (.getDOMNode (@refs "destinationName")))
                                   dest-conf-namespace (.-value (.getDOMNode (@refs "destinationNamespace")))
                                   post-data (create-post-data
                                               selected-conf-name
                                               selected-conf-namespace
                                               selected-conf-snapshotId
                                               dest-conf-name
                                               dest-conf-namespace)
                                   copy_URL (paths/copy-method-config-to-workspace-path workspace)]
                               (utils/ajax-orch
                                 copy_URL
                                 {:headers {"Content-Type" "application/json"}
                                  :canned-response {:responseText
                                                      (utils/->json-string (create-mock-methodconfs-import))
                                                    :status 200
                                                    :delay-ms (rand-int 2000)}
                                  :method :post
                                  :data (utils/->json-string post-data)
                                  :on-done (fn [{:keys [success? xhr]}]
                                             (if success?
                                               (utils/rlog "SUCCESS in import ! trigger re-render of workspace MC list here?")
                                               (js/alert (str "Error in import : "  (.-statusText xhr)))))})))}]]))})

(defn render-import-modal [state props refs]
  [comps/ModalDialog
   {:width 750
    :content (react/create-element
               [:div {}
                [:div {:style {:backgroundColor "#fff"
                               :borderBottom (str "1px solid " (:line-gray style/colors))
                               :padding "20px 48px 18px"
                               :fontSize "137%" :fontWeight 400 :lineHeight 1}}
                 "Import a Method Configuration"
                 [:hr]
                 (get-in @state [:selected-conf "name"])[:br]
                 (get-in @state [:selected-conf "namespace"]) [:br]
                 (get-in @state [:selected-conf "snapshotId"])]
                 [:div {:style {:position "absolute" :right 2 :top 2}}
                  [:div {:style {:backgroundColor (:button-blue style/colors) :color "#fff"
                                 :padding "0.5em" :cursor "pointer"}
                         :onClick (fn [] (swap! state assoc :show-import-mc-modal? false))}
                   (icons/font-icon {:style {:fontSize "60%"}} :x)]]
                [:div {:style {:padding "22px 48px 40px"
                               :backgroundColor (:background-gray style/colors)}}
                 [ModalImportOptionsAndButton {:init-Name (get-in @state [:selected-conf "name"])
                                               :init-Namespace (get-in @state [:selected-conf "namespace"])
                                               :init-SnapshotId (get-in @state [:selected-conf "snapshotId"])
                                               :parental-state state
                                               :workspace (get props :workspace)}]]])
    :show-when true}])

(react/defc ImportWorkspaceMethodsConfigurationsList
  {:render
   (fn [{:keys [state props refs]}]
     [:div {}
      (when (:show-import-mc-modal? @state)
        (render-import-modal state props refs))
      (cond
        (:loaded-import-confs? @state)
        (if (zero? (count (:method-confs @state)))
          (style/create-message-well "There are no method configurations to display for import!")
          [table/Table
           {:columns [{:header "Name" :starting-width 200 :filter-by #(% "name")
                       :content-renderer
                       (fn [row-index conf]
                         [:a
                          {:onClick
                           (fn []
                             (swap! state assoc :selected-conf conf :show-import-mc-modal? true))
                           :href "javascript:;"
                           :style {:color (:button-blue style/colors) :textDecoration "none"}}
                          (conf "name")])}
                      {:header "Namespace" :starting-width 200}
                      {:header "Snapshot Id" :starting-width 100}
                      {:header "Synopsis" :starting-width 160}
                      {:header "Create Date" :starting-width 210}
                      {:header "Owner" :starting-width 290}]
            :data (map
                    (fn [config]
                      [config
                       (config "namespace")
                       (config "snapshotId")
                       (config "synopsis")
                       (config "createDate")
                       (config "owner")])
                    (:method-confs @state))}])
        (:error-message @state) [:div {:style {:color "red"}}
                                 "FireCloud service returned error: " (:error-message @state)]
        :else [comps/Spinner {:text "Loading configurations for import..."}])])
   :component-did-mount
   (fn [{:keys [state]}]
     (utils/call-ajax-orch "/configurations"
       {:on-success (fn [{:keys [parsed-response]}]
                      (swap! state assoc :loaded-import-confs? true :method-confs parsed-response))
        :on-failure (fn [{:keys [status-text]}]
                      (swap! state assoc :error-message status-text))
        :mock-data (create-mock-methodconfs-import)}))})

(def modal-import-background
  {:backgroundColor "rgba(82, 129, 197, 0.4)"
   :overflowX "hidden" :overflowY "scroll"
   :position "fixed" :zIndex 9999
   :top 0 :right 0 :bottom 0 :left 0})

(def ^:private modal-import-content
  {:transform "translate(-50%, 0px)"
   :backgroundColor (:background-gray style/colors)
   :position "relative" :marginBottom 60
   :top 60
   :left "50%"
   :width "90%"})

(defn render-import-overlay [state  workspace ]
  (let [clear-import-overlay #(swap! state assoc :import-overlay-shown? false)]
    (when (:import-overlay-shown? @state)
      [:div {:style modal-import-background
             :onKeyDown (common/create-key-handler [:esc] clear-import-overlay)}
       [:div {:style modal-import-content}
        [:div {:style {:position "absolute" :right 2 :top 2}}
         [:div {:style {:backgroundColor (:button-blue style/colors) :color "#fff"
                        :padding "0.5em" :cursor "pointer"}
                :onClick #(swap! state assoc :import-overlay-shown? false)}
          (icons/font-icon {:style {:fontSize "60%"}} :x)]]
        [:div {:style {:backgroundColor "#fff"
                       :borderBottom (str "1px solid " (:line-gray style/colors))
                       :padding "20px 48px 18px"}}
         [:div {:style {:fontSize 24 :align "center" :textAlign "center" :paddingBottom "0.5em"}}
          "Select A Method Configuration For Import"]
         [ImportWorkspaceMethodsConfigurationsList {:workspace workspace}]
         [:div {:style {:paddingTop "0.5em"}}]]]])))

make the snapshot ID a string

make the snapshot ID a string


(ns com.nomistech.clojure-the-language.c-400-state-and-concurrency.s-020-atoms
  (:require [midje.sweet :refer :all]))

;;;; ___________________________________________________________________________
;;;; Atoms basics

;;;; Atoms
;;;; - The most basic reference type -- fast
;;;; - Characteristics:
;;;;   - Shared between threads
;;;;   - Synchronous
;;;;   - Not coordinated (affects a single identity)
;;;;   - Retryable
;;;; - Atomic compare-and-set modification

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; `atom`, `deref`, `@` and `swap!`

(def my-number-atom (atom 0))

(fact (deref my-number-atom) => 0)
(fact @my-number-atom => 0)

(do (swap! my-number-atom inc)
    ;; does this: (inc 0)
    (fact @my-number-atom => 1))

(do (swap! my-number-atom inc)
    ;; does this: (inc 1)
    (fact @my-number-atom => 2))

(fact "`swap` returns the new value of the atom"
  (swap! my-number-atom inc) => 3
  (swap! my-number-atom dec) => 2)

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; We need a name for the function that `swap!` calls
;;;; - We'll use the term "data function"
;;;;   - The book /Clojure Applied/ uses this

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; Supplying additional args to the data function:

(do (swap! my-number-atom + 10)
    ;; does this: (+ 2 10)
    (fact @my-number-atom => 12))

(do (swap! my-number-atom + 1 2 3 4 5)
    ;; does this: (+ 12 1 2 3 4 5)
    (fact @my-number-atom => 27))

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; Storing maps in atoms

;;;; Something about films

(def jaws-atom (atom {}))

;; Set the title:

(do (swap! jaws-atom assoc :title "Paws")
    ;; does this: (assoc {} :title "Paws"}
    (fact @jaws-atom => {:title "Paws"}))

;; Whoops; we got the title wrong. Fix it:

(do (swap! jaws-atom assoc :title "Jaws")
    ;; does this: (assoc {:title "Paws"} :title "Jaws")
    (fact @jaws-atom => {:title "Jaws"}))

;; Set the director:

(do (swap! jaws-atom assoc-in [:director :name] "Karl Zwicky")
    ;; does this:
    ;;   (assoc-in {:title "Jaws"} [:director :name] "Karl Zwicky")
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Karl Zwicky"}}))

;; Whoops; we got the director wrong. Fix it:

(do (swap! jaws-atom assoc-in [:director :name] "Steven Spielberg")
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Steven Spielberg"}}))

;; Add more detail to the director:

(do (swap! jaws-atom assoc-in [:director :date-of-birth] 1946)
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Steven Spielberg"
                                    :date-of-birth 1946}}))

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; `compare-and-set!`

(do (fact @my-number-atom => 27)
    (fact (compare-and-set! my-number-atom 99 42) => false)
    (fact @my-number-atom => 27))

(do (fact (compare-and-set! my-number-atom 27 42) => true)
    (fact @my-number-atom => 42))

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; `reset!`

(do (reset! my-number-atom 100)
    (fact @my-number-atom => 100))

;;;; ___________________________________________________________________________
;;;; Atoms and concurrency

;;;; Overview:
;;;; - Atoms don't block. `swap!` retries if necessary.

;;;; Details:
;;;;
;;;; - When a data function returns the new value:
;;;;   - If the current value of the atom is the same as the value when the
;;;;     function started
;;;;     then
;;;;         -- (this means that this data function did its work based on the
;;;;         -- current value)
;;;;         `swap!` replaces the value of the atom with the new value
;;;;         `swap!` returns the new value
;;;;     else
;;;;         -- (this means that the atom was updated by something else)
;;;;         `swap!` retries running the data function
;;;;         (using the current value as input to the data function).
;;;;
;;;; - So the data function should not have side effects.

;;;; ___________________________________________________________________________
;;;; Illustration of multiple threads competing to update an atom.
;;;;
;;;; - Each thread uses `swap!` with a function that runs for a long time.
;;;;
;;;; - Clojure allows each thread that calls `swap!` to be optimistic.
;;;;   - So multiple data functions run concurrently (for the same atom).
;;;;
;;;; - Another atom is used to keep track of how many times the data function
;;;;   is called.

(def competing-updates-atom (atom 0))

(def n-competitors 1000)

(defn demo-competition-to-modify-atom []
  (let [n-attempts-atom (atom 0)]
    (letfn [(get-info []
              [@competing-updates-atom
               @n-attempts-atom])
            (long-running-inc [n]
              ;; Note that the following `swap!` is within another `swap!`'s
              ;; data function, which violates the rule that data functions
              ;; should not have side effects.
              ;; But that's OK for keeping count of attempts.
              (swap! n-attempts-atom inc)
              ;; Be long-running:
              (Thread/sleep (rand-int 100))
              ;; The "real" functionality:
              (inc n))
            (long-running-inc-on-atom! []
              (swap! competing-updates-atom long-running-inc))
            (create-competing-threads []
              (dotimes [_ n-competitors]
                (.start (Thread. long-running-inc-on-atom!))))
            (report-on-what-is-happening []
              (loop []
                (println "[value n-attempts] =" (get-info))
                (when (< @competing-updates-atom
                         n-competitors)
                  (Thread/sleep 1000)
                  (recur))))]
      (create-competing-threads)
      (report-on-what-is-happening)
      (get-info))))

(fact "About concurrency and atoms"
  (let [[final-value n-attempts] (demo-competition-to-modify-atom)]
    (fact final-value => n-competitors)
    (fact (> n-attempts n-competitors) => truthy)))

(ns com.nomistech.clojure-the-language.c-400-state-and-concurrency.s-020-atoms
  (:require [midje.sweet :refer :all]))

;;;; ___________________________________________________________________________
;;;; Atoms basics

;;;; Atoms
;;;; - The most basic reference type -- fast
;;;; - Characteristics:
;;;;   - Shared between threads
;;;;   - Synchronous
;;;;   - Not coordinated (affects a single identity)
;;;;   - Retryable
;;;; - Atomic compare-and-set modification

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; `atom`, `deref`, `@` and `swap!`

(def my-number-atom (atom 0))

(fact (deref my-number-atom) => 0)
(fact @my-number-atom => 0)

(do (swap! my-number-atom inc)
    ;; does this: (inc 0)
    (fact @my-number-atom => 1))

(do (swap! my-number-atom inc)
    ;; does this: (inc 1)
    (fact @my-number-atom => 2))

(fact "`swap` returns the new value of the atom"
  (swap! my-number-atom inc) => 3
  (swap! my-number-atom dec) => 2)

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; We need a name for the function that `swap!` calls
;;;; - We'll use the term "data function"
;;;;   - The book /Clojure Applied/ uses this

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; Supplying additional args to the data function:

(do (swap! my-number-atom + 10)
    ;; does this: (+ 2 10)
    (fact @my-number-atom => 12))

(do (swap! my-number-atom + 1 2 3 4 5)
    ;; does this: (+ 12 1 2 3 4 5)
    (fact @my-number-atom => 27))

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; Storing maps in atoms

;;;; Something about films

(def jaws-atom (atom {}))

;; Set the title:

(do (swap! jaws-atom assoc :title "Paws")
    ;; does this: (assoc {} :title "Paws"}
    (fact @jaws-atom => {:title "Paws"}))

;; Whoops; we got the title wrong. Fix it:

(do (swap! jaws-atom assoc :title "Jaws")
    ;; does this: (assoc {:title "Paws"} :title "Jaws")
    (fact @jaws-atom => {:title "Jaws"}))

;; A nested map for the director:

(do (swap! jaws-atom assoc-in [:director :name] "Karl Zwicky")
    ;; does this:
    ;;   (assoc-in {:title "Jaws"} [:director :name] "Karl Zwicky")
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Karl Zwicky"}}))

;; Whoops; we got the director wrong. Fix it:

(do (swap! jaws-atom assoc-in [:director :name] "Steven Spielberg")
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Steven Spielberg"}}))

;; Add more detail to the director:

(do (swap! jaws-atom assoc-in [:director :date-of-birth] 1946)
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Steven Spielberg"
                                    :date-of-birth 1946}}))

;; We can apply a function to part of a map in an atom:

(do (swap! jaws-atom assoc :n-likes 0)
    (swap! jaws-atom update :n-likes inc)
    (swap! jaws-atom update :n-likes inc)
    (fact @jaws-atom => {:title "Jaws"
                         :director {:name "Steven Spielberg"
                                    :date-of-birth 1946}
                         :n-likes 2}))

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; `compare-and-set!`

(do (fact @my-number-atom => 27)
    (fact (compare-and-set! my-number-atom 99 42) => false)
    (fact @my-number-atom => 27))

(do (fact (compare-and-set! my-number-atom 27 42) => true)
    (fact @my-number-atom => 42))

;;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;;; `reset!`

(do (reset! my-number-atom 100)
    (fact @my-number-atom => 100))

;;;; ___________________________________________________________________________
;;;; Atoms and concurrency

;;;; Overview:
;;;; - Atoms don't block. `swap!` retries if necessary.

;;;; Details:
;;;;
;;;; - When a data function returns the new value:
;;;;   - If the current value of the atom is the same as the value when the
;;;;     function started
;;;;     then
;;;;         -- (this means that this data function did its work based on the
;;;;         -- current value)
;;;;         `swap!` replaces the value of the atom with the new value
;;;;         `swap!` returns the new value
;;;;     else
;;;;         -- (this means that the atom was updated by something else)
;;;;         `swap!` retries running the data function
;;;;         (using the current value as input to the data function).
;;;;
;;;; - So the data function should not have side effects.

;;;; ___________________________________________________________________________
;;;; Illustration of multiple threads competing to update an atom.
;;;;
;;;; - Each thread uses `swap!` with a function that runs for a long time.
;;;;
;;;; - Clojure allows each thread that calls `swap!` to be optimistic.
;;;;   - So multiple data functions run concurrently (for the same atom).
;;;;
;;;; - Another atom is used to keep track of how many times the data function
;;;;   is called.

(def competing-updates-atom (atom 0))

(def n-competitors 1000)

(defn demo-competition-to-modify-atom []
  (let [n-attempts-atom (atom 0)]
    (letfn [(get-info []
              [@competing-updates-atom
               @n-attempts-atom])
            (long-running-inc [n]
              ;; Note that the following `swap!` is within another `swap!`'s
              ;; data function, which violates the rule that data functions
              ;; should not have side effects.
              ;; But that's OK for keeping count of attempts.
              (swap! n-attempts-atom inc)
              ;; Be long-running:
              (Thread/sleep (rand-int 100))
              ;; The "real" functionality:
              (inc n))
            (long-running-inc-on-atom! []
              (swap! competing-updates-atom long-running-inc))
            (create-competing-threads []
              (dotimes [_ n-competitors]
                (.start (Thread. long-running-inc-on-atom!))))
            (report-on-what-is-happening []
              (loop []
                (println "[value n-attempts] =" (get-info))
                (when (< @competing-updates-atom
                         n-competitors)
                  (Thread/sleep 1000)
                  (recur))))]
      (create-competing-threads)
      (report-on-what-is-happening)
      (get-info))))

(fact "About concurrency and atoms"
  (let [[final-value n-attempts] (demo-competition-to-modify-atom)]
    (fact final-value => n-competitors)
    (fact (> n-attempts n-competitors) => truthy)))

State: Apply a function to part of a map in an atom.