(ns warehouse.selenium.test
  (:use [clj-webdriver.taxi :exclude [clear]]
        [clojure.test]
        [warehouse.selenium.config]))

(def fixtures {:components
               [{:id 1
                :name "EPR212A408000Z"
                :tags ["optocoupler"]
                :tags-string "optocoupler"
                :expected-tags-string "optocoupler"
                :amount 7}
               {:id 2
                :name "2N3904"
                :tags ["transistor"]
                :tags-string "transistor"
                :expected-tags-string "transistor"
                :amount 8}
               {:id 3
                :name "LF33CV"
                :tags ["linear regulator"]
                :tags-string "linear regulator"
                :expected-tags-string "linear regulator"
                :amount 10}
               {:id 4
                :name "BD241C"
                :tags ["transistor"]
                :tags-string "transistor"
                :expected-tags-string "transistor"
                :amount 4}
               {:id 5
                :name "HC49/US QM 16.000MHZ"
                :tags ["crystal" "oscillator"]
                :tags-string "crystal, oscillator"
                :expected-tags-string "crystal, oscillator"
                :amount 1}
                {:id 6
                 :name "AVRProg USB v3"
                 :tags ["rs232", "serial", "usb"]
                 :tags-string "rs232, serial, usb"
                 :expected-tags-string "rs232, serial, usb"
                 :amount 1}]})

(def not-empty? (complement empty?))

(defn fixture-path [filename]
  (.getCanonicalPath (clojure.java.io/file (str "test/warehouse/selenium/" filename))))

(defn upload-file
  "This function exists because of bug in ghost driver https://github.com/ariya/phantomjs/issues/10993"
  [path]
  (let [driver (:webdriver *driver*)]
    (if (instance? org.openqa.selenium.phantomjs.PhantomJSDriver driver)
      (let [script (str "this.uploadFile('input[type=file]', '" path "')")]
        (.executePhantomJS driver script (make-array Object 0)))
      (send-keys "//input[@type='file']" path))))

(deftest import-export []
  ; reset env
  (to base-url)
  (execute-script "localStorage.clear();")

  (refresh)

  ; guard: there is zero components
  (is (empty? (elements "//li[@class='ccomponent']")))

  (upload-file (fixture-path "export.json"))

  (wait-until #(not-empty? (elements "//li[@class='component']")))
  (refresh)
  (wait-until #(not-empty? (elements "//li[@class='component']"))))

(defn create-component [component]
  (click "//button[contains(text(), 'Add new')]")
  (wait-until #(present? "//input[@name='name']"))
  (input-text "//input[@name='name']" (:name component))
  (input-text "//input[@name='tags']" (:tags-string component))
  (clear "//input[@name='amount']")
  (input-text "//input[@name='amount']" (str (:amount component)))
  (click "//button[contains(text(), 'Save')]"))

(defn component-value-selector [n v]
  (str "//li[@class='component'][" n "]//span[@class='value' and contains(text(), '" v "')]"))

(deftest components []

  ;;;;;;;;;;;;; Create components ;;;;;;;;;;;;;

  ; reset env
  (to base-url)
  (execute-script "localStorage.clear();")
  (refresh)

  ; guard: there is zero components
  (is (empty? (elements "//li[@class='component']")))

  (doseq [component (:components fixtures)]
    (create-component component)

    ; check values of created components
    (wait-until #(present? (component-value-selector (:id component) (:name component))))
    (is (present? (component-value-selector (:id component) (:expected-tags-string component))))
    (is (present? (component-value-selector (:id component) (:amount component))))

    ; check number of components
    (is (=
         (:id component)
         (count (elements "//li[@class='component']")))))

  ; check total of created components
  (is (=
       (count (:components fixtures))
       (count (elements "//li[@class='component']"))))

  ;;;;;;;;;;;;; Edit form with cancel ;;;;;;;;;;;;;

  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'EPR212A408000Z')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'optocoupler')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), '7')]"))
  (click "//button[contains(text(), 'Edit')]")

  (wait-until #(present? "//input[@name='name' and @value='EPR212A408000Z']"))
  (is (present? "//input[@name='tags' and @value='optocoupler']"))
  (is (present? "//input[@name='amount' and @value='7']"))

  (clear "//input[@name='name']")
  (clear "//input[@name='tags']")
  (clear "//input[@name='amount']")
  (input-text "//input[@name='name']" "new name")
  (input-text "//input[@name='tags']" "tag1, tag2")
  (input-text "//input[@name='amount']" "20")
  (click "//button[contains(text(), 'Cancel')]")

  (wait-until #(present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'EPR212A408000Z')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'optocoupler')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), '7')]"))

  ;;;;;;;;;;;;; Edit form with save ;;;;;;;;;;;;;

  (click "//button[contains(text(), 'Edit')]")

  (wait-until #(present? "//input[@name='name' and @value='EPR212A408000Z']"))
  (is (present? "//input[@name='tags' and @value='optocoupler']"))
  (is (present? "//input[@name='amount' and @value='7']"))

  (clear "//input[@name='name']")
  (clear "//input[@name='tags']")
  (clear "//input[@name='amount']")
  (input-text "//input[@name='name']" "new name")
  (input-text "//input[@name='tags']" "tag1, tag2")
  (input-text "//input[@name='amount']" "20")
  (click "//button[contains(text(), 'Save')]")

  (wait-until #(present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'new name')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'tag1, tag2')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), '20')]"))

  ;;;;;;;;;;;;; Search component ;;;;;;;;;;;;;

  ; guard
  (is (< 1 (count (elements "//li[@class='component']"))))

  ; linear regulator by name
  (input-text "//input[@name='search']" "LF")
  (wait-until #(= 1 (count (elements "//li[@class='component']"))))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'LF33CV')]"))

  ; avr programmer by tag
  (clear "//input[@name='search']")
  (input-text "//input[@name='search']" "rs232")
  (wait-until #(= 1 (count (elements "//li[@class='component']"))))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'AVRProg USB v3')]"))

  ;;;;;;;;;;;;; Search edited component ;;;;;;;;;;;;;

  ; guard
  (clear "//input[@name='search']")
  (input-text "//input[@name='search']" "wtf")
  (wait-until #(= 0 (count (elements "//li[@class='component']"))))
  (clear "//input[@name='search']")
  (wait-until #(present? "//li[@class='component']"))

  (click "//button[contains(text(), 'Edit')]")
  (clear "//input[@name='name']")
  (input-text "//input[@name='name']" "wtf")
  (click "//button[contains(text(), 'Save')]")
  (input-text "//input[@name='search']" "wtf")
  (wait-until #(= 1 (count (elements "//li[@class='component']"))))

  ;;;;;;;;;;;;;; Search new component ;;;;;;;;;;;;;

  ; guard
  (clear "//input[@name='search']")
  (input-text "//input[@name='search']" "new-component")
  (wait-until #(= 0 (count (elements "//li[@class='component']"))))
  (clear "//input[@name='search']")

  (click "//button[contains(text(), 'Add new')]")
  (wait-until #(present? "//input[@name='name']"))
  (input-text "//input[@name='name']" "new-component")
  (click "//button[contains(text(), 'Save')]")
  (input-text "//input[@name='search']" "new-component")
  (wait-until #(= 1 (count (elements "//li[@class='component']")))))

(ns warehouse.selenium.test
  (:use [clj-webdriver.taxi :exclude [clear]]
        [clojure.test]
        [warehouse.selenium.config]))

(def fixtures {:components
               [{:id 1
                :name "EPR212A408000Z"
                :tags ["optocoupler"]
                :tags-string "optocoupler"
                :expected-tags-string "optocoupler"
                :amount 7}
               {:id 2
                :name "2N3904"
                :tags ["transistor"]
                :tags-string "transistor"
                :expected-tags-string "transistor"
                :amount 8}
               {:id 3
                :name "LF33CV"
                :tags ["linear regulator"]
                :tags-string "linear regulator"
                :expected-tags-string "linear regulator"
                :amount 10}
               {:id 4
                :name "BD241C"
                :tags ["transistor"]
                :tags-string "transistor"
                :expected-tags-string "transistor"
                :amount 4}
               {:id 5
                :name "HC49/US QM 16.000MHZ"
                :tags ["crystal" "oscillator"]
                :tags-string "crystal, oscillator"
                :expected-tags-string "crystal, oscillator"
                :amount 1}
                {:id 6
                 :name "AVRProg USB v3"
                 :tags ["rs232", "serial", "usb"]
                 :tags-string "rs232, serial, usb"
                 :expected-tags-string "rs232, serial, usb"
                 :amount 1}]})

(def not-empty? (complement empty?))

(defn fixture-path [filename]
  (.getCanonicalPath (clojure.java.io/file (str "test/warehouse/selenium/" filename))))

(defn upload-file
  "This function exists because of bug in ghost driver https://github.com/ariya/phantomjs/issues/10993"
  [path]
  (let [driver (:webdriver *driver*)]
    (if (instance? org.openqa.selenium.phantomjs.PhantomJSDriver driver)
      (let [script (str "this.uploadFile('input[type=file]', '" path "')")]
        (.executePhantomJS driver script (make-array Object 0)))
      (send-keys "//input[@type='file']" path))))

(deftest import-export []
  ; reset env
  (to base-url)
  (execute-script "localStorage.clear();")

  (refresh)

  ; guard: there is zero components
  (is (empty? (elements "//li[@class='ccomponent']")))

  (upload-file (fixture-path "export.json"))

  (wait-until #(not-empty? (elements "//li[@class='component']")))
  (refresh)
  (wait-until #(not-empty? (elements "//li[@class='component']"))))

(defn create-component [component]
  (click "//button[contains(text(), 'Add new')]")
  (wait-until #(present? "//input[@name='name']"))
  (input-text "//input[@name='name']" (:name component))
  (input-text "//input[@name='tags']" (:tags-string component))
  (clear "//input[@name='amount']")
  (input-text "//input[@name='amount']" (str (:amount component)))
  (click "//button[contains(text(), 'Save')]"))

(defn component-value-selector [n v]
  (str "//li[@class='component'][" n "]//span[@class='value' and contains(text(), '" v "')]"))

(deftest components []

  ;;;;;;;;;;;;; Create components ;;;;;;;;;;;;;

  ; reset env
  (to base-url)
  (execute-script "localStorage.clear();")
  (refresh)

  ; guard: there is zero components
  (is (empty? (elements "//li[@class='component']")))

  (doseq [component (:components fixtures)]
    (create-component component)

    ; check values of created components
    (wait-until #(present? (component-value-selector (:id component) (:name component))))
    (is (present? (component-value-selector (:id component) (:expected-tags-string component))))
    (is (present? (component-value-selector (:id component) (:amount component))))

    ; check number of components
    (is (=
         (:id component)
         (count (elements "//li[@class='component']")))))

  ; check total of created components
  (is (=
       (count (:components fixtures))
       (count (elements "//li[@class='component']"))))

  ;;;;;;;;;;;;; Edit form with cancel ;;;;;;;;;;;;;

  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'EPR212A408000Z')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'optocoupler')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), '7')]"))
  (click "//button[contains(text(), 'Edit')]")

  (wait-until #(present? "//input[@name='name' and @value='EPR212A408000Z']"))
  (is (present? "//input[@name='tags' and @value='optocoupler']"))
  (is (present? "//input[@name='amount' and @value='7']"))

  (clear "//input[@name='name']")
  (clear "//input[@name='tags']")
  (clear "//input[@name='amount']")
  (input-text "//input[@name='name']" "new name")
  (input-text "//input[@name='tags']" "tag1, tag2")
  (input-text "//input[@name='amount']" "20")
  (click "//button[contains(text(), 'Cancel')]")

  (wait-until #(present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'EPR212A408000Z')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'optocoupler')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), '7')]"))

  ;;;;;;;;;;;;; Edit form with save ;;;;;;;;;;;;;

  (click "//button[contains(text(), 'Edit')]")

  (wait-until #(present? "//input[@name='name' and @value='EPR212A408000Z']"))
  (is (present? "//input[@name='tags' and @value='optocoupler']"))
  (is (present? "//input[@name='amount' and @value='7']"))

  (clear "//input[@name='name']")
  (clear "//input[@name='tags']")
  (clear "//input[@name='amount']")
  (input-text "//input[@name='name']" "new name")
  (input-text "//input[@name='tags']" "tag1, tag2")
  (input-text "//input[@name='amount']" "20")
  (click "//button[contains(text(), 'Save')]")

  (wait-until #(present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'new name')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'tag1, tag2')]"))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), '20')]"))

  ;;;;;;;;;;;;; Search component ;;;;;;;;;;;;;

  ; guard
  (is (< 1 (count (elements "//li[@class='component']"))))

  ; linear regulator by name
  (input-text "//input[@name='search']" "LF")
  (wait-until #(= 1 (count (elements "//li[@class='component']"))))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'LF33CV')]"))

  ; avr programmer by tag
  (clear "//input[@name='search']")
  (input-text "//input[@name='search']" "rs232")
  (wait-until #(= 1 (count (elements "//li[@class='component']"))))
  (is (present? "//li[@class='component'][1]//span[@class='value' and contains(text(), 'AVRProg USB v3')]"))

  ;;;;;;;;;;;;; Search edited component ;;;;;;;;;;;;;

  ; guard
  (clear "//input[@name='search']")
  (input-text "//input[@name='search']" "wtf")
  (wait-until #(= 0 (count (elements "//li[@class='component']"))))
  (clear "//input[@name='search']")
  (wait-until #(present? "//li[@class='component']"))

  (click "//button[contains(text(), 'Edit')]")
  (wait-until #(present? "//input[@name='name']"))
  (clear "//input[@name='name']")
  (input-text "//input[@name='name']" "wtf")
  (click "//button[contains(text(), 'Save')]")
  (input-text "//input[@name='search']" "wtf")
  (wait-until #(= 1 (count (elements "//li[@class='component']"))))

  ;;;;;;;;;;;;;; Search new component ;;;;;;;;;;;;;

  ; guard
  (clear "//input[@name='search']")
  (input-text "//input[@name='search']" "new-component")
  (wait-until #(= 0 (count (elements "//li[@class='component']"))))
  (clear "//input[@name='search']")

  (click "//button[contains(text(), 'Add new')]")
  (wait-until #(present? "//input[@name='name']"))
  (input-text "//input[@name='name']" "new-component")
  (click "//button[contains(text(), 'Save')]")
  (input-text "//input[@name='search']" "new-component")
  (wait-until #(= 1 (count (elements "//li[@class='component']")))))

Tests: check if input is present before clear attempt


(ns cyanite-remover.path-store
  (:require [clojurewerkz.elastisch.rest :as esr]
            [clojurewerkz.elastisch.rest.index :as esri]
            [clojurewerkz.elastisch.rest.document :as esrd]
            [clojure.string :as str]
            [clojure.tools.logging :as log]
            [cyanite-remover.logging :as clog]
            [cyanite-remover.utils :as utils]))

(defprotocol PathStore
  "Path store."
  (lookup [this tenant leafs-only limit-depth path exclude-paths])
  (delete [this tenant path])
  (delete-query [this tenant leafs-only limit-depth path])
  (get-stats [this]))

(def ^:const default-es-index "cyanite_paths")
(def ^:const default-es-scroll-batch-size 100000)

(def ^:const es-def-type "path")

(def ^:const es-type-map
  {es-def-type {:_all { :enabled false }
                :_source { :compress false }
                :properties {:tenant {:type "string" :index "not_analyzed"}
                             :path {:type "string" :index "not_analyzed"}}}})

(defn- log-error
  "Log a error."
  [error path stats-errors]
  (clog/error (format "Path store error: path: %s, error: %s" path error) error)
  (swap! stats-errors inc))

(defn- wildcards-to-regexp
  "Convert Graphite wildcards to a regular expression."
  [path]
  (-> path
      ;; Wildcards
      (str/replace #"\.|\*|\?" {"." "\\." "*" ".*" "?" ".?"})
      ;; Lists
      (str/replace #"\{|\}|," {"{" "(" "}" ")" "," "|"})
      ;; Ranges
      (str/replace #"\[(\d+)-(\d+)\]"
                   (fn [[_ r1s r2s]]
                     (let [r1i (Integer/parseInt r1s)
                           r2i (Integer/parseInt r2s)
                           r1 (apply min [r1i r2i])
                           r2 (apply max [r1i r2i])]
                       (format "(%s)" (str/join "|" (range r1 (inc r2)))))))))

(defn- join-wildcards [paths]
  (let [wrap-to-brackets #(str "(" % ")")]
    (->> paths
         (map wildcards-to-regexp)
         (map wrap-to-brackets)
         (str/join "|")
         wrap-to-brackets)))

(defn- add-depth-filter
  "Add a depth filter."
  [filter limit-depth path]
  (if limit-depth
    (let [depth (inc (count (re-seq (re-pattern #"\.") path)))]
      (conj filter {:range {:depth {:from depth :to depth}}}))
    filter))

(defn- add-leaf-filter
  "Add a leaf filter."
  [filter leafs-only path]
  (if leafs-only (conj filter {:term {:leaf true}}) filter))

(defn- build-filter
  "Build an Elasticsearch filter."
  [tenant leafs-only limit-depth path]
  (let [filter (vector
                {:term {:tenant tenant}}
                {:regexp {:path (wildcards-to-regexp path) :_cache true}})]
    (-> filter
        (add-depth-filter limit-depth path)
        (add-leaf-filter leafs-only path))))

(defn- build-query
  "Build an Elasticsearch query."
  [filter]
  {:filtered {:filter {:bool {:must filter}}}})

(defn- search
  "Search for a path."
  [search-fn scroll-fn tenant leafs-only limit-depth path batch-size batch-rate]
  (let [throttle-fn (utils/fn-or-trtlfn #(do %) batch-rate)
        query (build-query (build-filter tenant leafs-only limit-depth path))
        _ (log/trace (str "ES search query: " query))
        resp (search-fn :query query :size batch-size
                        :search_type "query_then_fetch" :scroll "1m")]
    (log/trace (str "ES search response: " resp))
    (map :_source (map throttle-fn (scroll-fn resp)))))

(defn- log-shards-errors
  "Log shards' errors."
  [failed failures path stats-errors]
  (let [shards-errors (str/join "\n" (map #(format "shard: %s, error: %s"
                                                   (:shard %) (:reason %))
                                          failures))]
    (log-error
     (format "there were %s errors during the removal of the path:\n%s"
             failed shards-errors) path stats-errors)))

(defn- process-response-delete
  "Process response of delete-by-query."
  [response index path stats-errors]
  (log/trace (str "ES delete query response: " response))
  (let [error-fn #(do (log-error (format "Can't get \"%s\" value from response" %)
                                 path stats-errors) false)]
    (if-let [shards (:_shards (get (:_indices response) (keyword index)))]
      (let [total (:total shards)
            successful (:successful shards)
            failed (:failed shards)]
        (cond
         (not total) (error-fn "total")
         (not successful) (error-fn "successful")
         (not failed) (error-fn "failed")
         (pos? failed) (do (log-shards-errors failed (:failures shards) path
                                              stats-errors) false))
        true)
      (error-fn "shards"))))

(defn- get-doc-id
  "Get a document ID."
  [tenant path]
  (str tenant "_" path))

(defn- delete-impl
  "Delete implementation."
  [conn index es-def-type run stats-processed stats-errors tenant path]
  (try
    (swap! stats-processed inc)
    (let [id (get-doc-id tenant path)]
      (log/trace (str "ES delete document ID: " id))
      (when run
        (let [response (esrd/delete conn index es-def-type id)]
          (log/trace (str "ES delete response: " response)))))
    (catch Exception e
      (log-error e path stats-errors))))

(defn- deleteq-impl
  "Delete query implementation."
  [conn index es-def-type run stats-processed stats-errors tenant leafs-only
   limit-depth path]
  (try
    (swap! stats-processed inc)
    (let [query (build-query (build-filter tenant leafs-only
                                           limit-depth path))]
      (log/trace (str "ES delete query: " query))
      (when run
        (let [response (esrd/delete-by-query conn index es-def-type query)]
          (process-response-delete response index path stats-errors))))
    (catch Exception e
      (log-error e path stats-errors))))

(defn elasticsearch-path-store
  "Create an Elasticsearch path store."
  [url options]
  (log/info "Creating the path store...")
  (let [run (:run options false)
        index (:elasticsearch-index options default-es-index)
        scroll-batch-size (:elasticsearch-scroll-batch-size
                           options default-es-scroll-batch-size)
        scroll-batch-rate (:elasticsearch-scroll-batch-rate options)
        delete-request-rate (:elasticsearch-delete-request-rate options)
        conn (esr/connect url)
        search-fn (partial esrd/search conn index es-def-type)
        scroll-fn (partial esrd/scroll-seq conn)
        data-stored? (atom false)
        stats-processed (atom 0)
        stats-errors (atom 0)
        delete-impl (partial delete-impl conn index es-def-type run
                             stats-processed stats-errors)
        deleteq-impl (partial deleteq-impl conn index es-def-type run
                              stats-processed stats-errors)
        delete-fn (utils/fn-or-trtlfn delete-impl delete-request-rate)
        deleteq-fn (utils/fn-or-trtlfn deleteq-impl delete-request-rate)]
    (log/info (str "The path store has been created. "
                   "URL: " url
                   ", index: " index
                   ", scroll batch size: " scroll-batch-size
                   (utils/string-or-empty scroll-batch-rate
                                          (str ", scroll batch rate: "
                                               scroll-batch-rate))
                   (utils/string-or-empty delete-request-rate
                                          (str ", delete request rate: "
                                               delete-request-rate))))
    (reify
      PathStore
      (lookup [this tenant leafs-only limit-depth path exclude-paths]
        (try
          (let [paths (search search-fn scroll-fn tenant leafs-only
                              limit-depth path scroll-batch-size
                              scroll-batch-rate)
                re-excludes (re-pattern (join-wildcards exclude-paths))]
            (if-not exclude-paths
              paths
              (remove #(re-matches re-excludes (:path %)) paths)))
          (catch Exception e
            (log-error e path stats-errors))))
      (delete [this tenant path]
        (delete-fn tenant path))
      (delete-query [this tenant leafs-only limit-depth path]
        (deleteq-fn tenant leafs-only limit-depth path))
      (get-stats [this]
        {:processed @stats-processed
         :errors @stats-errors}))))

(ns cyanite-remover.path-store
  (:require [clojurewerkz.elastisch.rest :as esr]
            [clojurewerkz.elastisch.rest.index :as esri]
            [clojurewerkz.elastisch.rest.document :as esrd]
            [clojure.string :as str]
            [clojure.tools.logging :as log]
            [cyanite-remover.logging :as clog]
            [cyanite-remover.utils :as utils]))

(defprotocol PathStore
  "Path store."
  (lookup [this tenant leafs-only limit-depth path exclude-paths])
  (delete [this tenant path])
  (delete-query [this tenant leafs-only limit-depth path])
  (get-stats [this]))

(def ^:const default-es-index "cyanite_paths")
(def ^:const default-es-scroll-batch-size 100000)

(def ^:const es-def-type "path")

(def ^:const es-type-map
  {es-def-type {:_all { :enabled false }
                :_source { :compress false }
                :properties {:tenant {:type "string" :index "not_analyzed"}
                             :path {:type "string" :index "not_analyzed"}}}})

(defn- log-error
  "Log a error."
  [error path stats-errors]
  (clog/error (format "Path store error: path: %s, error: %s" path error) error)
  (swap! stats-errors inc))

(defn- wildcards-to-regexp
  "Convert Graphite wildcards to a regular expression."
  [path]
  (-> path
      ;; Wildcards
      (str/replace #"\.|\*|\?" {"." "\\." "*" ".*" "?" ".?"})
      ;; Lists
      (str/replace #"\{|\}|," {"{" "(" "}" ")" "," "|"})
      ;; Ranges
      (str/replace #"\[(\d+)-(\d+)\]"
                   (fn [[_ r1s r2s]]
                     (let [r1i (Integer/parseInt r1s)
                           r2i (Integer/parseInt r2s)
                           r1 (apply min [r1i r2i])
                           r2 (apply max [r1i r2i])]
                       (format "(%s)" (str/join "|" (range r1 (inc r2)))))))))

(defn- join-wildcards [paths]
  (let [wrap-to-brackets #(str "(" % ")")]
    (->> paths
         (map wildcards-to-regexp)
         (map wrap-to-brackets)
         (str/join "|")
         wrap-to-brackets)))

(defn- add-depth-filter
  "Add a depth filter."
  [filter limit-depth path]
  (if limit-depth
    (let [depth (inc (count (re-seq (re-pattern #"\.") path)))]
      (conj filter {:range {:depth {:from depth :to depth}}}))
    filter))

(defn- add-leaf-filter
  "Add a leaf filter."
  [filter leafs-only path]
  (if leafs-only (conj filter {:term {:leaf true}}) filter))

(defn- build-filter
  "Build an Elasticsearch filter."
  [tenant leafs-only limit-depth path]
  (let [filter (vector
                {:term {:tenant tenant}}
                {:regexp {:path (wildcards-to-regexp path) :_cache true}})]
    (-> filter
        (add-depth-filter limit-depth path)
        (add-leaf-filter leafs-only path))))

(defn- build-query
  "Build an Elasticsearch query."
  [filter]
  {:filtered {:filter {:bool {:must filter}}}})

(defn- search
  "Search for a path."
  [search-fn scroll-fn tenant leafs-only limit-depth path batch-size batch-rate]
  (let [throttle-fn (utils/fn-or-trtlfn identity batch-rate)
        query (build-query (build-filter tenant leafs-only limit-depth path))
        _ (log/trace (str "ES search query: " query))
        resp (search-fn :query query :size batch-size
                        :search_type "query_then_fetch" :scroll "1m")]
    (log/trace (str "ES search response: " resp))
    (map :_source (map throttle-fn (scroll-fn resp)))))

(defn- log-shards-errors
  "Log shards' errors."
  [failed failures path stats-errors]
  (let [shards-errors (str/join "\n" (map #(format "shard: %s, error: %s"
                                                   (:shard %) (:reason %))
                                          failures))]
    (log-error
     (format "there were %s errors during the removal of the path:\n%s"
             failed shards-errors) path stats-errors)))

(defn- process-response-delete
  "Process response of delete-by-query."
  [response index path stats-errors]
  (log/trace (str "ES delete query response: " response))
  (let [error-fn #(do (log-error (format "Can't get \"%s\" value from response" %)
                                 path stats-errors) false)]
    (if-let [shards (:_shards (get (:_indices response) (keyword index)))]
      (let [total (:total shards)
            successful (:successful shards)
            failed (:failed shards)]
        (cond
         (not total) (error-fn "total")
         (not successful) (error-fn "successful")
         (not failed) (error-fn "failed")
         (pos? failed) (do (log-shards-errors failed (:failures shards) path
                                              stats-errors) false))
        true)
      (error-fn "shards"))))

(defn- get-doc-id
  "Get a document ID."
  [tenant path]
  (str tenant "_" path))

(defn- delete-impl
  "Delete implementation."
  [conn index es-def-type run stats-processed stats-errors tenant path]
  (try
    (swap! stats-processed inc)
    (let [id (get-doc-id tenant path)]
      (log/trace (str "ES delete document ID: " id))
      (when run
        (let [response (esrd/delete conn index es-def-type id)]
          (log/trace (str "ES delete response: " response)))))
    (catch Exception e
      (log-error e path stats-errors))))

(defn- deleteq-impl
  "Delete query implementation."
  [conn index es-def-type run stats-processed stats-errors tenant leafs-only
   limit-depth path]
  (try
    (swap! stats-processed inc)
    (let [query (build-query (build-filter tenant leafs-only
                                           limit-depth path))]
      (log/trace (str "ES delete query: " query))
      (when run
        (let [response (esrd/delete-by-query conn index es-def-type query)]
          (process-response-delete response index path stats-errors))))
    (catch Exception e
      (log-error e path stats-errors))))

(defn elasticsearch-path-store
  "Create an Elasticsearch path store."
  [url options]
  (log/info "Creating the path store...")
  (let [run (:run options false)
        index (:elasticsearch-index options default-es-index)
        scroll-batch-size (:elasticsearch-scroll-batch-size
                           options default-es-scroll-batch-size)
        scroll-batch-rate (:elasticsearch-scroll-batch-rate options)
        delete-request-rate (:elasticsearch-delete-request-rate options)
        conn (esr/connect url)
        search-fn (partial esrd/search conn index es-def-type)
        scroll-fn (partial esrd/scroll-seq conn)
        data-stored? (atom false)
        stats-processed (atom 0)
        stats-errors (atom 0)
        delete-impl (partial delete-impl conn index es-def-type run
                             stats-processed stats-errors)
        deleteq-impl (partial deleteq-impl conn index es-def-type run
                              stats-processed stats-errors)
        delete-fn (utils/fn-or-trtlfn delete-impl delete-request-rate)
        deleteq-fn (utils/fn-or-trtlfn deleteq-impl delete-request-rate)]
    (log/info (str "The path store has been created. "
                   "URL: " url
                   ", index: " index
                   ", scroll batch size: " scroll-batch-size
                   (utils/string-or-empty scroll-batch-rate
                                          (str ", scroll batch rate: "
                                               scroll-batch-rate))
                   (utils/string-or-empty delete-request-rate
                                          (str ", delete request rate: "
                                               delete-request-rate))))
    (reify
      PathStore
      (lookup [this tenant leafs-only limit-depth path exclude-paths]
        (try
          (let [paths (search search-fn scroll-fn tenant leafs-only
                              limit-depth path scroll-batch-size
                              scroll-batch-rate)
                re-excludes (re-pattern (join-wildcards exclude-paths))]
            (if-not exclude-paths
              paths
              (remove #(re-matches re-excludes (:path %)) paths)))
          (catch Exception e
            (log-error e path stats-errors))))
      (delete [this tenant path]
        (delete-fn tenant path))
      (delete-query [this tenant leafs-only limit-depth path]
        (deleteq-fn tenant leafs-only limit-depth path))
      (get-stats [this]
        {:processed @stats-processed
         :errors @stats-errors}))))

Replace '#(do %)' with 'identity'

Replace '#(do %)' with 'identity'


(defproject scamp "0.1.0-SNAPSHOT"
  :description "FIXME: write description"
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.8.0"]
                 [com.taoensso/timbre "4.3.1"]
                 [prismatic/schema "1.1.1"]])

(defproject scamp "0.1.0-SNAPSHOT"
  :description "FIXME: write description"
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}
  :dependencies [[org.clojure/clojure "1.9.0-alpha14"]
                 [com.taoensso/timbre "4.3.1"]
                 [prismatic/schema "1.1.1"]])

bump to clojure 1.9.0-alpha14

[scamp] bump to clojure 1.9.0-alpha14


;;
;; Author:: Adam Jacob (<adam@opscode.com>)
;; Author:: Christopher Brown (<cb@opscode.com>)
;; Copyright:: Copyright (c) 2010 Opscode, Inc.
;; License:: Apache License, Version 2.0
;;
;; 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.
;;

(let [initial-steps
      [{:command "make" :args ["BUILD_OPT=1" "XCFLAGS=-L/opt/opscode/embedded/lib -I/opt/opscode/embedded/include" "-f" "Makefile.ref"]}
       {:command "make" :args ["BUILD_OPT=1" "JS_DIST=/opt/opscode/embedded" "-f" "Makefile.ref" "export"]}]
      steps
      (cond
       (is-os? "darwin")
       (concat
        initial-steps
        [{:command "mv" :args ["/opt/opscode/embedded/lib64/libjs.a" "/opt/opscode/embedded/lib"]}
         {:command "mv" :args ["/opt/opscode/embedded/lib64/libjs.so" "/opt/opscode/embedded/lib"]}
         {:command "rm" :args ["-rf" "/opt/opscode/embedded/lib64"]}])
       true
       initial-steps)]
  (software "spidermonkey"
            :source "js"
            :build-subdir "src"
            :steps initial-steps))

;;
;; Author:: Adam Jacob (<adam@opscode.com>)
;; Author:: Christopher Brown (<cb@opscode.com>)
;; Copyright:: Copyright (c) 2010 Opscode, Inc.
;; License:: Apache License, Version 2.0
;;
;; 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.
;;

(let [initial-steps
      [{:command "make" :args ["BUILD_OPT=1" "XCFLAGS=-L/opt/opscode/embedded/lib -I/opt/opscode/embedded/include" "-f" "Makefile.ref"]}
       {:command "make" :args ["BUILD_OPT=1" "JS_DIST=/opt/opscode/embedded" "-f" "Makefile.ref" "export"]}]
      steps
      (cond
       (is-machine? "x86_64")
       (concat
        initial-steps
        [{:command "mv" :args ["/opt/opscode/embedded/lib64/libjs.a" "/opt/opscode/embedded/lib"]}
         {:command "mv" :args ["/opt/opscode/embedded/lib64/libjs.so" "/opt/opscode/embedded/lib"]}
         {:command "rm" :args ["-rf" "/opt/opscode/embedded/lib64"]}])
       true
       initial-steps)]
  (software "spidermonkey"
            :source "js"
            :build-subdir "src"
            :steps initial-steps))

test for x86_64 rather than Darwin

test for x86_64 rather than Darwin


(ns babel.italiano
  (:refer-clojure :exclude [get-in]))

(require '[babel.cache :refer (create-index)])
(require '[babel.forest :as forest])
(require '[babel.italiano.grammar :as gram])
(require '[babel.italiano.lexicon :as lex])
(require '[babel.italiano.morphology :as morph :refer [fo]])
(require '[babel.italiano.pos :refer [intransitivize transitivize]])
(require '[babel.lexiconfn :refer (compile-lex infinitives map-function-on-map-vals unify)])
(require '[babel.parse :as parse])
(require '[babel.ug :refer [head-principle]])

(require '[clojure.string :as string])
(require '[clojure.tools.logging :as log])

(require '[dag-unify.core :refer (fail? get-in strip-refs)])
(require '[dag-unify.core :as unify])

(def grammar gram/grammar)
(def lexicon-source lex/lexicon-source)

;; see TODOs in lexiconfn/compile-lex (should be more of a pipeline as opposed to a argument-position-sensitive function.
(def lexicon (future (-> (compile-lex lex/lexicon-source
                                      morph/exception-generator
                                      morph/phonize morph/italian-specific-rules)

                         ;; make an intransitive version of every verb which has an
                         ;; [:sem :obj] path.
                         intransitivize

                         ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
                         transitivize

                         ;; Cleanup functions can go here. Number them for ease of reading.
                         ;; 1. this filters out any verbs without an inflection: infinitive verbs should have inflection ':infinitive',
                         ;; rather than not having any inflection.
                         (map-function-on-map-vals
                          (fn [k vals]
                            (filter #(or (not (= :verb (get-in % [:synsem :cat])))
                                         (not (= :none (get-in % [:synsem :infl] :none))))
                                    vals))))))
(defn lookup [token]
  "return the subset of lexemes that match this token from the lexicon."
  (morph/analyze token #(get @lexicon %)))

(def it lookup) ;; abbreviation for the above

(defn parse [string]
  (parse/parse string lexicon lookup grammar))

(def index nil)
;; TODO: trying to print index takes forever and blows up emacs buffer:
;; figure out how to change printable version to (keys index).
(def index (future (create-index grammar (flatten (vals @lexicon)) head-principle)))

(defn sentence [ & [spec]]
  (let [spec (unify (if spec spec :top)
                    {:synsem {:subcat '()
                              :cat :verb}})]
    (forest/generate spec grammar (flatten (vals @lexicon)) index)))

(declare small)

(defn generate [ & [spec model]]
  (let [spec (if spec spec :top)
        model (if model model small)
        model (if (future? model) @model model)]
    (forest/generate spec
                     (:grammar model)
                     (:lexicon model)
                     (:index model))))

;; TODO: factor out to forest/.
(defn generate-all [ & [spec {use-grammar :grammar
                              use-index :index
                              use-lexicon :lexicon}]]
  (let [spec (if spec spec :top)
        use-grammar (if use-grammar use-grammar grammar)
        use-index (if use-index use-index index)
        use-lexicon (if use-lexicon use-lexicon lexicon)]
    (log/info (str "using grammar of size: " (.size use-grammar)))
    (log/info (str "using index of size: " (.size @use-index)))
    (if (seq? spec)
      (mapcat generate-all spec)
      (forest/generate-all spec use-grammar
                           (flatten (vals @use-lexicon))
                           use-index))))

;; TODO: move the following 2 to lexicon.clj:
(def lookup-in
  "find all members of the collection that matches with query successfully."
  (fn [query collection]
    (loop [coll collection matches nil]
      (if (not (empty? coll))
        (let [first-val (first coll)
              result (unify/match (unify/copy query) (unify/copy first-val))]
          (if (not (unify/fail? result))
            (recur (rest coll)
                   (cons first-val matches))
            (recur (rest coll)
                   matches)))
        matches))))

(defn choose-lexeme [spec]
  (first (unify/lazy-shuffle (lookup-in spec (vals lexicon)))))

(declare enrich)
(declare against-pred)
(declare against-comp)
(declare matching-head-lexemes)
(declare matching-comp-lexemes)

(def small
  (future
    (let [grammar
          (filter #(or (= (:rule %) "s-conditional-nonphrasal")
                       (= (:rule %) "s-present-nonphrasal")
                       (= (:rule %) "s-future-nonphrasal")
                       (= (:rule %) "s-imperfetto-nonphrasal")
                       (= (:rule %) "s-aux")
                       (= (:rule %) "vp-aux"))
                  grammar)
          lexicon
          (into {}
                (for [[k v] @lexicon]
                  (let [filtered-v
                        (filter #(or (= (get-in % [:synsem :cat]) :verb)
                                     (= (get-in % [:synsem :propernoun]) true)
                                     (= (get-in % [:synsem :pronoun]) true))
                                v)]
                    (if (not (empty? filtered-v))
                      [k filtered-v]))))]
      {:name "small"
       :language-keyword :italiano
       :language "it"
       :morph fo
       :enrich enrich
       :grammar grammar
       :lexicon lexicon
       :index (create-index grammar (flatten (vals lexicon)) head-principle)})))

(def small-plus-vp-pronoun
  (future
    (let [grammar
          (filter #(or (= (:rule %) "s-conditional-phrasal")
                       (= (:rule %) "s-conditional-nonphrasal")
                       (= (:rule %) "s-present-phrasal")
                       (= (:rule %) "s-present-nonphrasal")
                       (= (:rule %) "s-future-phrasal")
                       (= (:rule %) "s-future-nonphrasal")
                       (= (:rule %) "s-imperfetto-phrasal")
                       (= (:rule %) "s-imperfetto-nonphrasal")
                       (= (:rule %) "s-aux")
                       (= (:rule %) "vp-aux")
                       (= (:rule %) "vp-aux-22")
                       (= (:rule %) "vp-pronoun-nonphrasal")
                       (= (:rule %) "vp-pronoun-phrasal"))
                  grammar)
          lexicon
          (into {}
                (for [[k v] @lexicon]
                  (let [filtered-v
                        (filter #(or (= (get-in % [:synsem :cat]) :verb)
                                     (= (get-in % [:synsem :propernoun]) true)
                                     (= (get-in % [:synsem :pronoun]) true))
                                v)]
                    (if (not (empty? filtered-v))
                      [k filtered-v]))))]
      {:name "small-plus-vp-pronoun"
       :language "it"
       :language-keyword :italiano
       :morph fo
       :enrich enrich
       :grammar grammar
       :lexicon lexicon
       :index (create-index grammar (flatten (vals lexicon)) head-principle)})))

(def medium
  (future
    (let [lexicon
          (into {}
                (for [[k v] @lexicon]
                  (let [filtered-v v]
                    (if (not (empty? filtered-v))
                      [k filtered-v]))))]
      {:name "medium"
       :language "it"
       :language-keyword :italiano
       :morph fo
       :enrich enrich
       :grammar grammar
       :lexicon lexicon
       :index (create-index grammar (flatten (vals lexicon)) head-principle)
       })))

(defn enrich [spec]
  (let [against-pred (against-pred spec)]
    (if true against-pred
        (let [against-comp (map (fn [spec]
                            (against-comp spec))
                          (if (seq? against-pred)
                            (seq (set against-pred))
                            against-pred))]
          (if (seq? against-comp)
            (seq (set against-comp))
            against-comp)))))

(defn against-pred [spec]
  (let [pred (get-in spec [:synsem :sem :pred] :top)]
    (if (= :top pred)
      spec
      (mapcat (fn [lexeme]
                (let [result (unify spec
                                    {:synsem {:sem (strip-refs (get-in lexeme [:synsem :sem] :top))}}
                                    {:synsem {:essere (strip-refs (get-in lexeme [:synsem :essere] :top))}}
                                    )]
                  (if (not (fail? result))
                    (list result))))
              (matching-head-lexemes spec)))))

;; TODO: not currently used: needs to be called from within (enrich).
(defn against-comp [spec]
  (let [pred-of-comp (get-in spec [:synsem :sem :subj :pred] :top)]
    (if (= :top pred-of-comp)
      spec
      (mapcat (fn [lexeme]
                (let [result (unify spec
                                    {:comp {:synsem {:agr (strip-refs (get-in lexeme [:synsem :agr] :top))
                                                     :sem (strip-refs (get-in lexeme [:synsem :sem] :top))}}})]
                  (if (not (fail? result))
                    (list result))))
              (matching-comp-lexemes spec)))))

(defn matching-head-lexemes [spec]
  (let [pred-of-head (get-in spec [:synsem :sem :pred] :top)]
    (if (= pred-of-head :top)
      spec
      (mapcat (fn [lexemes]
                (mapcat (fn [lexeme]
                          (if (= pred-of-head
                                 (get-in lexeme [:synsem :sem :pred] :top))
                            (list lexeme)))
                        lexemes))
              (vals @lexicon)))))

(defn matching-comp-lexemes [spec]
  (let [pred-of-comp (get-in spec [:synsem :sem :subj :pred] :top)]
    (if (= pred-of-comp :top)
      spec
      (mapcat (fn [lexemes]
                (mapcat (fn [lexeme]
                          (if (= pred-of-comp
                                 (get-in lexeme [:synsem :sem :pred] :top))
                            (list lexeme)))
                        lexemes))
              (vals @lexicon)))))

(ns babel.italiano
  (:refer-clojure :exclude [get-in]))

(require '[babel.cache :refer (create-index)])
(require '[babel.forest :as forest])
(require '[babel.italiano.grammar :as gram])
(require '[babel.italiano.lexicon :as lex])
(require '[babel.italiano.morphology :as morph :refer [fo]])
(require '[babel.italiano.pos :refer [intransitivize transitivize]])
(require '[babel.lexiconfn :refer (compile-lex infinitives map-function-on-map-vals unify)])
(require '[babel.parse :as parse])
(require '[babel.ug :refer [head-principle]])

(require '[clojure.string :as string])
(require '[clojure.tools.logging :as log])

(require '[dag-unify.core :refer (fail? get-in strip-refs)])
(require '[dag-unify.core :as unify])

(def grammar gram/grammar)
(def lexicon-source lex/lexicon-source)

;; see TODOs in lexiconfn/compile-lex (should be more of a pipeline as opposed to a argument-position-sensitive function.
(def lexicon (future (-> (compile-lex lex/lexicon-source
                                      morph/exception-generator
                                      morph/phonize morph/italian-specific-rules)

                         ;; make an intransitive version of every verb which has an
                         ;; [:sem :obj] path.
                         intransitivize

                         ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
                         transitivize

                         ;; Cleanup functions can go here. Number them for ease of reading.
                         ;; 1. this filters out any verbs without an inflection: infinitive verbs should have inflection ':infinitive',
                         ;; rather than not having any inflection.
                         (map-function-on-map-vals
                          (fn [k vals]
                            (filter #(or (not (= :verb (get-in % [:synsem :cat])))
                                         (not (= :none (get-in % [:synsem :infl] :none))))
                                    vals))))))
(defn lookup [token]
  "return the subset of lexemes that match this token from the lexicon."
  (morph/analyze token #(get @lexicon %)))

(def it lookup) ;; abbreviation for the above

(defn parse [string]
  (parse/parse string lexicon lookup grammar))

(def index nil)
;; TODO: trying to print index takes forever and blows up emacs buffer:
;; figure out how to change printable version to (keys index).
(def index (future (create-index grammar (flatten (vals @lexicon)) head-principle)))

(defn sentence [ & [spec]]
  (let [spec (unify (if spec spec :top)
                    {:synsem {:subcat '()
                              :cat :verb}})]
    (forest/generate spec grammar (flatten (vals @lexicon)) index)))

(declare small)

(defn generate [ & [spec model]]
  (let [spec (if spec spec :top)
        model (if model model small)
        model (if (future? model) @model model)]
    (forest/generate spec
                     (:grammar model)
                     (:lexicon model)
                     (:index model)
                     fo)))

;; TODO: factor out to forest/.
(defn generate-all [ & [spec {use-grammar :grammar
                              use-index :index
                              use-lexicon :lexicon}]]
  (let [spec (if spec spec :top)
        use-grammar (if use-grammar use-grammar grammar)
        use-index (if use-index use-index index)
        use-lexicon (if use-lexicon use-lexicon lexicon)]
    (log/info (str "using grammar of size: " (.size use-grammar)))
    (log/info (str "using index of size: " (.size @use-index)))
    (if (seq? spec)
      (mapcat generate-all spec)
      (forest/generate-all spec use-grammar
                           (flatten (vals @use-lexicon))
                           use-index))))

;; TODO: move the following 2 to lexicon.clj:
(def lookup-in
  "find all members of the collection that matches with query successfully."
  (fn [query collection]
    (loop [coll collection matches nil]
      (if (not (empty? coll))
        (let [first-val (first coll)
              result (unify/match (unify/copy query) (unify/copy first-val))]
          (if (not (unify/fail? result))
            (recur (rest coll)
                   (cons first-val matches))
            (recur (rest coll)
                   matches)))
        matches))))

(defn choose-lexeme [spec]
  (first (unify/lazy-shuffle (lookup-in spec (vals lexicon)))))

(declare enrich)
(declare against-pred)
(declare against-comp)
(declare matching-head-lexemes)
(declare matching-comp-lexemes)

(def small
  (future
    (let [grammar
          (filter #(or (= (:rule %) "s-conditional-nonphrasal")
                       (= (:rule %) "s-present-nonphrasal")
                       (= (:rule %) "s-future-nonphrasal")
                       (= (:rule %) "s-imperfetto-nonphrasal")
                       (= (:rule %) "s-aux")
                       (= (:rule %) "vp-aux"))
                  grammar)
          lexicon
          (into {}
                (for [[k v] @lexicon]
                  (let [filtered-v
                        (filter #(or (= (get-in % [:synsem :cat]) :verb)
                                     (= (get-in % [:synsem :propernoun]) true)
                                     (= (get-in % [:synsem :pronoun]) true))
                                v)]
                    (if (not (empty? filtered-v))
                      [k filtered-v]))))]
      {:name "small"
       :language-keyword :italiano
       :language "it"
       :morph fo
       :enrich enrich
       :grammar grammar
       :lexicon lexicon
       :index (create-index grammar (flatten (vals lexicon)) head-principle)})))

(def small-plus-vp-pronoun
  (future
    (let [grammar
          (filter #(or (= (:rule %) "s-conditional-phrasal")
                       (= (:rule %) "s-conditional-nonphrasal")
                       (= (:rule %) "s-present-phrasal")
                       (= (:rule %) "s-present-nonphrasal")
                       (= (:rule %) "s-future-phrasal")
                       (= (:rule %) "s-future-nonphrasal")
                       (= (:rule %) "s-imperfetto-phrasal")
                       (= (:rule %) "s-imperfetto-nonphrasal")
                       (= (:rule %) "s-aux")
                       (= (:rule %) "vp-aux")
                       (= (:rule %) "vp-aux-22")
                       (= (:rule %) "vp-pronoun-nonphrasal")
                       (= (:rule %) "vp-pronoun-phrasal"))
                  grammar)
          lexicon
          (into {}
                (for [[k v] @lexicon]
                  (let [filtered-v
                        (filter #(or (= (get-in % [:synsem :cat]) :verb)
                                     (= (get-in % [:synsem :propernoun]) true)
                                     (= (get-in % [:synsem :pronoun]) true))
                                v)]
                    (if (not (empty? filtered-v))
                      [k filtered-v]))))]
      {:name "small-plus-vp-pronoun"
       :language "it"
       :language-keyword :italiano
       :morph fo
       :enrich enrich
       :grammar grammar
       :lexicon lexicon
       :index (create-index grammar (flatten (vals lexicon)) head-principle)})))

(def medium
  (future
    (let [lexicon
          (into {}
                (for [[k v] @lexicon]
                  (let [filtered-v v]
                    (if (not (empty? filtered-v))
                      [k filtered-v]))))]
      {:name "medium"
       :language "it"
       :language-keyword :italiano
       :morph fo
       :enrich enrich
       :grammar grammar
       :lexicon lexicon
       :index (create-index grammar (flatten (vals lexicon)) head-principle)
       })))

(defn enrich [spec]
  (let [against-pred (against-pred spec)]
    (if true against-pred
        (let [against-comp (map (fn [spec]
                            (against-comp spec))
                          (if (seq? against-pred)
                            (seq (set against-pred))
                            against-pred))]
          (if (seq? against-comp)
            (seq (set against-comp))
            against-comp)))))

(defn against-pred [spec]
  (let [pred (get-in spec [:synsem :sem :pred] :top)]
    (if (= :top pred)
      spec
      (mapcat (fn [lexeme]
                (let [result (unify spec
                                    {:synsem {:sem (strip-refs (get-in lexeme [:synsem :sem] :top))}}
                                    {:synsem {:essere (strip-refs (get-in lexeme [:synsem :essere] :top))}}
                                    )]
                  (if (not (fail? result))
                    (list result))))
              (matching-head-lexemes spec)))))

;; TODO: not currently used: needs to be called from within (enrich).
(defn against-comp [spec]
  (let [pred-of-comp (get-in spec [:synsem :sem :subj :pred] :top)]
    (if (= :top pred-of-comp)
      spec
      (mapcat (fn [lexeme]
                (let [result (unify spec
                                    {:comp {:synsem {:agr (strip-refs (get-in lexeme [:synsem :agr] :top))
                                                     :sem (strip-refs (get-in lexeme [:synsem :sem] :top))}}})]
                  (if (not (fail? result))
                    (list result))))
              (matching-comp-lexemes spec)))))

(defn matching-head-lexemes [spec]
  (let [pred-of-head (get-in spec [:synsem :sem :pred] :top)]
    (if (= pred-of-head :top)
      spec
      (mapcat (fn [lexemes]
                (mapcat (fn [lexeme]
                          (if (= pred-of-head
                                 (get-in lexeme [:synsem :sem :pred] :top))
                            (list lexeme)))
                        lexemes))
              (vals @lexicon)))))

(defn matching-comp-lexemes [spec]
  (let [pred-of-comp (get-in spec [:synsem :sem :subj :pred] :top)]
    (if (= pred-of-comp :top)
      spec
      (mapcat (fn [lexemes]
                (mapcat (fn [lexeme]
                          (if (= pred-of-comp
                                 (get-in lexeme [:synsem :sem :pred] :top))
                            (list lexeme)))
                        lexemes))
              (vals @lexicon)))))

fix test: forest/generate now needs another parameter: a morphological function to realize feature structures as strings


(ns frontend.models.plan
  (:require [frontend.utils :as utils :include-macros true]
            [goog.string :as gstring]
            [cljs-time.core :as time]
            [cljs-time.format :as time-format]))

(defn max-parallelism
  "Maximum parallelism that the plan allows (usually 16x)"
  [plan]
  (get-in plan [:template_properties :max_parallelism]))

(defn usable-containers
  "Maximum containers that the plan has available to it"
  [plan]
  (max (:containers_override plan) (:containers plan) (get-in plan [:template_properties :free_containers])))

(defn max-selectable-parallelism [plan]
  (min (max-parallelism plan)
       (usable-containers plan)))

(defn piggieback? [plan org-name]
  (not= (:org_name plan) org-name))

(defn paid? [plan]
  (not= (get-in plan [:template_properties :type] "trial") "trial"))

(defn can-edit-plan? [plan org-name]
  (and (paid? plan) (not (piggieback? plan org-name))))

(defn trial? [plan]
  (some-> plan :template_properties :type name (= "trial")))

(defn trial-over? [plan]
  (time/after? (time/now) (time-format/parse (:trial_end plan))))

;; true  if the plan has an active Stripe discount coupon.
;; false if the plan is nil (not loaded yet) or has no discount applied
(defn has-active-discount? [plan]
  (get-in plan [:discount :coupon :valid]))

(defn days-left-in-trial
  "Returns number of days left in trial, can be negative."
  [plan]
  (let [trial-end (time-format/parse (:trial_end plan))
        now (time/now)]
    (if (time/after? trial-end now)
      ;; count partial days as a full day
      (inc (time/in-days (time/interval now trial-end)))
      (- (time/in-days (time/interval trial-end now))))))

(defn pretty-trial-time [plan]
  (let [trial-interval (time/interval (time/now) (time-format/parse (:trial_end plan)))
        hours-left (time/in-hours trial-interval)]
    (cond (< 24 hours-left)
          (str (days-left-in-trial plan) " days")

          (< 1 hours-left)
          (str hours-left " hours")

          :else
          (str (time/in-minutes trial-interval) " minutes"))))

;; The template tells how to price the plan
(def default-template-properties {:price 19 :container_cost 50 :id "p18" :max_containers 1000 :free_containers 1})

(defn container-cost [template-properties containers]
  (let [{:keys [free_containers container_cost]} template-properties]
    (max 0 (* container_cost (- containers free_containers)))))

(defn cost [template-properties containers]
  (+ (:price template-properties)
     (container-cost template-properties containers)))

(defn stripe-cost
  "Normalizes the Stripe amount on the plan to dollars."
  [plan]
  (/ (:amount plan) 100))

(defn grandfathered? [plan]
  (< (stripe-cost plan)
     (cost (:template-properties plan) (:containers plan))))

(ns frontend.models.plan
  (:require [frontend.utils :as utils :include-macros true]
            [goog.string :as gstring]
            [cljs-time.core :as time]
            [cljs-time.format :as time-format]))

(defn max-parallelism
  "Maximum parallelism that the plan allows (usually 16x)"
  [plan]
  (get-in plan [:template_properties :max_parallelism]))

(defn usable-containers
  "Maximum containers that the plan has available to it"
  [plan]
  (max (:containers_override plan) (:containers plan) (get-in plan [:template_properties :free_containers])))

(defn max-selectable-parallelism [plan]
  (min (max-parallelism plan)
       (usable-containers plan)))

(defn piggieback? [plan org-name]
  (not= (:org_name plan) org-name))

(defn paid? [plan]
  (not= (get-in plan [:template_properties :type] "trial") "trial"))

(defn can-edit-plan? [plan org-name]
  (and (paid? plan) (not (piggieback? plan org-name))))

(defn trial? [plan]
  (some-> plan :template_properties :type name (= "trial")))

(defn trial-over? [plan]
  (time/after? (time/now) (time-format/parse (:trial_end plan))))

;; true  if the plan has an active Stripe discount coupon.
;; false if the plan is nil (not loaded yet) or has no discount applied
(defn has-active-discount? [plan]
  (get-in plan [:discount :coupon :valid]))

(defn days-left-in-trial
  "Returns number of days left in trial, can be negative."
  [plan]
  (let [trial-end (time-format/parse (:trial_end plan))
        now (time/now)]
    (when (not (nil? trial-end))
      (if (time/after? trial-end now)
        ;; count partial days as a full day
        (inc (time/in-days (time/interval now trial-end)))
        (- (time/in-days (time/interval trial-end now)))))))

(defn pretty-trial-time [plan]
  (let [trial-interval (time/interval (time/now) (time-format/parse (:trial_end plan)))
        hours-left (time/in-hours trial-interval)]
    (cond (< 24 hours-left)
          (str (days-left-in-trial plan) " days")

          (< 1 hours-left)
          (str hours-left " hours")

          :else
          (str (time/in-minutes trial-interval) " minutes"))))

;; The template tells how to price the plan
(def default-template-properties {:price 19 :container_cost 50 :id "p18" :max_containers 1000 :free_containers 1})

(defn container-cost [template-properties containers]
  (let [{:keys [free_containers container_cost]} template-properties]
    (max 0 (* container_cost (- containers free_containers)))))

(defn cost [template-properties containers]
  (+ (:price template-properties)
     (container-cost template-properties containers)))

(defn stripe-cost
  "Normalizes the Stripe amount on the plan to dollars."
  [plan]
  (/ (:amount plan) 100))

(defn grandfathered? [plan]
  (< (stripe-cost plan)
     (cost (:template-properties plan) (:containers plan))))

Handle nil :trial_end times (mostly for ease of testing.)


(ns caesium.crypto.generichash
  (:import (org.abstractj.kalium.crypto Hash)))

(def ^:private sixteen-nuls (byte-array 16))

(defn blake2b
  "Computes the BLAKE2b digest of the given message, with optional
  salt, key and personalization parameters."
  ([message]
     (.blake2 (new Hash) message))
  ([message & {salt :salt key :key personal :personal
               :or {salt sixteen-nuls
                    personal sixteen-nuls
                    key (byte-array 0)}}]
     (.blake2 (new Hash) message key salt personal)))

(ns caesium.crypto.generichash
  (:import (org.abstractj.kalium.crypto Hash)))

(def ^:private empty-byte-array (byte-array 0))
(def ^:private sixteen-nuls (byte-array 16))

(defn blake2b
  "Computes the BLAKE2b digest of the given message, with optional
  salt, key and personalization parameters."
  ([message]
     (.blake2 (new Hash) message))
  ([message & {salt :salt key :key personal :personal
               :or {salt sixteen-nuls
                    personal sixteen-nuls
                    key empty-byte-array}}]
     (.blake2 (new Hash) message key salt personal)))

Make the empty byte array a constant too


(def +version+ "3.27-SNAPSHOT")

(set-env!
  :project 'com.sixsq.slipstream/SlipStreamCljResources-jar

  :version +version+
  :license {"Apache 2.0" "http://www.apache.org/licenses/LICENSE-2.0.txt"}
  :edition "community"

  :dependencies '[[org.clojure/clojure "1.9.0-alpha16"]
                  [sixsq/build-utils "0.1.4" :scope "test"]])

(require '[sixsq.build-fns :refer [merge-defaults
                                   sixsq-nexus-url
                                   lein-generate]])

(set-env!
  :repositories
  #(reduce conj % [["sixsq" {:url (sixsq-nexus-url)}]])

  :dependencies
  #(vec (concat %
                (merge-defaults
                 ['sixsq/default-deps (get-env :version)]
                 '[[org.clojure/clojure]

                   [aleph]
                   [cheshire] ;; newer version needed for ring-json
                   [compojure]
                   [clj-stacktrace]
                   [clj-time]
                   [environ]
                   [instaparse]
                   [log4j]
                   [metrics-clojure]
                   [metrics-clojure-ring]
                   [metrics-clojure-jvm]
                   [metrics-clojure-graphite]
                   [me.raynes/fs]
                   [org.clojure/data.json]
                   [org.clojure/java.classpath]
                   [org.clojure/tools.cli]
                   [org.clojure/tools.logging]
                   [org.clojure/tools.namespace]
                   [potemkin]
                   [ring/ring-core]
                   [ring/ring-json]
                   [superstring]

                   [com.sixsq.slipstream/auth]
                   [com.sixsq.slipstream/token]
                   [com.sixsq.slipstream/SlipStreamDbBinding-jar]
                   [org.apache.logging.log4j/log4j-core]
                   [org.apache.logging.log4j/log4j-api]

                   ;; needed for migration scripts
                   [korma]
                   [org.hsqldb/hsqldb]
                   [org.clojure/java.jdbc]

                   ;; test dependencies
                   [peridot]
                   [honeysql]
                   [org.clojure/test.check]

                   ;; boot tasks
                   [boot-environ]
                   [adzerk/boot-test]
                   [adzerk/boot-reload]
                   [tolitius/boot-check]]))))

(require
  '[environ.boot :refer [environ]]
  '[adzerk.boot-test :refer [test]]
  '[adzerk.boot-reload :refer [reload]]
  '[tolitius.boot-check :refer [with-yagni
                                with-eastwood
                                with-kibit
                                with-bikeshed]])

(set-env!
  :resource-paths #{"src" "resources"})

(task-options!
  pom {:project (get-env :project)
       :version (get-env :version)}
  test {:junit-output-to ""}
  install {:pom (str (get-env :project))}
  push {:pom (str (get-env :project))
        :repo "sixsq"})

(deftask dev-env
         []
         (set-env! :source-paths #(set (concat % #{"test" "test-resources"})))
         identity)

(deftask dev-fixture-env
         []
         (environ :env {:config-name      "config-hsqldb-mem.edn"
                        :auth-private-key (str (clojure.java.io/resource "auth_privkey.pem"))
                        :auth-public-key  (str (clojure.java.io/resource "auth_pubkey.pem"))}))

(deftask run-tests
         "runs all tests and performs full compilation"
         []
         (comp
           (dev-env)
           (dev-fixture-env)
           (test)
           (sift :include #{#".*_test\.clj"
                            #".*test_utils\.clj"
                            #"test_helper\.clj"
                            #".*seeds.*"
                            #".*example\.clj"}
                 :invert true)
           (aot :all true)))

(defn get-file-path
  [fileset fname]
  (try
    (-> (-> fileset
          (boot.core/tmp-get fname)
          boot.core/tmp-dir)
      (clojure.java.io/file fname)
      .getPath)
    (catch IllegalArgumentException e)))

(deftask set-version []
  (fn middleware [next-task]
    (fn handler [fileset]
     (let [f (get-file-path fileset "com/sixsq/slipstream/version.txt")]
       (spit f (get-env :version)))
     (next-task fileset))))

(deftask build []
         (comp
           (pom)
           (set-version)
           (sift :include #{#".*_test\.clj"
                            #".*test_utils\.clj"
                            #"test_helper\.clj"
                            #".*seeds.*"
                            #".*example\.clj"
                            #".*Test\.java"
                            #".*simu_result.txt"
                            #"config-hsqldb-mem.edn"
                            #"config-hsqldb.edn"
                            #"log4j.properties"}
                 :invert true)
           (aot :namespace #{'com.sixsq.slipstream.ssclj.app.main 'com.sixsq.slipstream.ssclj.usage.summarizer})
           #_(uber :exclude #{ #"(?i)^META-INF/INDEX.LIST$"
                             #"(?i)^META-INF/[^/]*\.(MF|SF|RSA|DSA)$"
                             #".*log4j\.properties" })
           (jar ;; :main 'com.sixsq.slipstream.ssclj.app.main
            )))

(def tests-artef-name "SlipStreamCljResourcesTests-jar")
(def tests-artef-pom-loc (str "com.sixsq.slipstream/" tests-artef-name))
(def tests-artef-project-name (symbol tests-artef-pom-loc))
(def tests-artef-jar-name (str tests-artef-name "-" (get-env :version) "-tests.jar"))

(deftask build-tests-jar
  "build jar with test runtime dependencies for connectors."
  []
  (comp
    (pom :project tests-artef-project-name :classifier "tests")
    (sift
      :to-resource #{#"lifecycle_test_utils\.clj"
                     #"connector_test_utils\.clj"}

      :include #{#"lifecycle_test_utils\.clj"
                 #"connector_test_utils\.clj"
                 #"pom.xml"
                 #"pom.properties"})

    (jar :file tests-artef-jar-name)))

(deftask mvn-test
         "run all tests of project"
         []
         (run-tests))

(deftask mvn-build
         "build project"
         []
         (comp
           (build)
           (install)
           (if (= "true" (System/getenv "BOOT_PUSH"))
             (push)
             identity)))

(deftask mvn-build-tests-jar
         "build project"
         []
         (comp
          (dev-env)
          (build-tests-jar)
          (install :pom tests-artef-pom-loc)
          (if (= "true" (System/getenv "BOOT_PUSH"))
            (push :pom tests-artef-pom-loc)
            identity)))

(deftask server-repl
  "start dev server repl"
  []
  (comp
    (dev-env)
    (dev-fixture-env)
    (repl)))

(def +version+ "3.27-SNAPSHOT")

(set-env!
  :project 'com.sixsq.slipstream/SlipStreamCljResources-jar

  :version +version+
  :license {"Apache 2.0" "http://www.apache.org/licenses/LICENSE-2.0.txt"}
  :edition "community"

  :dependencies '[[org.clojure/clojure "1.9.0-alpha16"]
                  [sixsq/build-utils "0.1.4" :scope "test"]])

(require '[sixsq.build-fns :refer [merge-defaults
                                   sixsq-nexus-url]])

(set-env!
  :repositories
  #(reduce conj % [["sixsq" {:url (sixsq-nexus-url)}]])

  :dependencies
  #(vec (concat %
                (merge-defaults
                 ['sixsq/default-deps (get-env :version)]
                 '[[org.clojure/clojure]

                   [aleph]
                   [cheshire] ;; newer version needed for ring-json
                   [compojure]
                   [clj-stacktrace]
                   [clj-time]
                   [environ]
                   [instaparse]
                   [log4j]
                   [metrics-clojure]
                   [metrics-clojure-ring]
                   [metrics-clojure-jvm]
                   [metrics-clojure-graphite]
                   [me.raynes/fs]
                   [org.clojure/data.json]
                   [org.clojure/java.classpath]
                   [org.clojure/tools.cli]
                   [org.clojure/tools.logging]
                   [org.clojure/tools.namespace]
                   [potemkin]
                   [ring/ring-core]
                   [ring/ring-json]
                   [superstring]

                   [com.sixsq.slipstream/auth]
                   [com.sixsq.slipstream/token]
                   [com.sixsq.slipstream/SlipStreamDbBinding-jar]
                   [org.apache.logging.log4j/log4j-core]
                   [org.apache.logging.log4j/log4j-api]

                   ;; needed for migration scripts
                   [korma]
                   [org.hsqldb/hsqldb]
                   [org.clojure/java.jdbc]

                   ;; test dependencies
                   [peridot]
                   [honeysql]
                   [org.clojure/test.check]

                   ;; boot tasks
                   [boot-environ]
                   [adzerk/boot-test]
                   [adzerk/boot-reload]
                   [tolitius/boot-check]
                   [onetom/boot-lein-generate]]))))

(require
  '[environ.boot :refer [environ]]
  '[adzerk.boot-test :refer [test]]
  '[adzerk.boot-reload :refer [reload]]
  '[tolitius.boot-check :refer [with-yagni
                                with-eastwood
                                with-kibit
                                with-bikeshed]]
  '[boot.lein :refer [generate]])

(set-env!
  :resource-paths #{"src" "resources"})

(task-options!
  pom {:project (get-env :project)
       :version (get-env :version)}
  test {:junit-output-to ""}
  install {:pom (str (get-env :project))}
  push {:pom (str (get-env :project))
        :repo "sixsq"})

(deftask dev-env
         []
         (set-env! :source-paths #(set (concat % #{"test" "test-resources"})))
         identity)

(deftask dev-fixture-env
         []
         (environ :env {:config-name      "config-hsqldb-mem.edn"
                        :auth-private-key (str (clojure.java.io/resource "auth_privkey.pem"))
                        :auth-public-key  (str (clojure.java.io/resource "auth_pubkey.pem"))}))

(deftask run-tests
         "runs all tests and performs full compilation"
         []
         (comp
           (dev-env)
           (dev-fixture-env)
           (test)
           (sift :include #{#".*_test\.clj"
                            #".*test_utils\.clj"
                            #"test_helper\.clj"
                            #".*seeds.*"
                            #".*example\.clj"}
                 :invert true)
           (aot :all true)))

(defn get-file-path
  [fileset fname]
  (try
    (-> (-> fileset
          (boot.core/tmp-get fname)
          boot.core/tmp-dir)
      (clojure.java.io/file fname)
      .getPath)
    (catch IllegalArgumentException e)))

(deftask set-version []
  (fn middleware [next-task]
    (fn handler [fileset]
     (let [f (get-file-path fileset "com/sixsq/slipstream/version.txt")]
       (spit f (get-env :version)))
     (next-task fileset))))

(deftask build []
         (comp
           (pom)
           (set-version)
           (sift :include #{#".*_test\.clj"
                            #".*test_utils\.clj"
                            #"test_helper\.clj"
                            #".*seeds.*"
                            #".*example\.clj"
                            #".*Test\.java"
                            #".*simu_result.txt"
                            #"config-hsqldb-mem.edn"
                            #"config-hsqldb.edn"
                            #"log4j.properties"}
                 :invert true)
           (aot :namespace #{'com.sixsq.slipstream.ssclj.app.main 'com.sixsq.slipstream.ssclj.usage.summarizer})
           #_(uber :exclude #{ #"(?i)^META-INF/INDEX.LIST$"
                             #"(?i)^META-INF/[^/]*\.(MF|SF|RSA|DSA)$"
                             #".*log4j\.properties" })
           (jar ;; :main 'com.sixsq.slipstream.ssclj.app.main
            )))

(def tests-artef-name "SlipStreamCljResourcesTests-jar")
(def tests-artef-pom-loc (str "com.sixsq.slipstream/" tests-artef-name))
(def tests-artef-project-name (symbol tests-artef-pom-loc))
(def tests-artef-jar-name (str tests-artef-name "-" (get-env :version) "-tests.jar"))

(deftask build-tests-jar
  "build jar with test runtime dependencies for connectors."
  []
  (comp
    (pom :project tests-artef-project-name :classifier "tests")
    (sift
      :to-resource #{#"lifecycle_test_utils\.clj"
                     #"connector_test_utils\.clj"}

      :include #{#"lifecycle_test_utils\.clj"
                 #"connector_test_utils\.clj"
                 #"pom.xml"
                 #"pom.properties"})

    (jar :file tests-artef-jar-name)))

(deftask mvn-test
         "run all tests of project"
         []
         (run-tests))

(deftask mvn-build
         "build project"
         []
         (comp
           (build)
           (install)
           (if (= "true" (System/getenv "BOOT_PUSH"))
             (push)
             identity)))

(deftask mvn-build-tests-jar
         "build project"
         []
         (comp
          (dev-env)
          (build-tests-jar)
          (install :pom tests-artef-pom-loc)
          (if (= "true" (System/getenv "BOOT_PUSH"))
            (push :pom tests-artef-pom-loc)
            identity)))

(deftask server-repl
  "start dev server repl"
  []
  (comp
    (dev-env)
    (dev-fixture-env)
    (repl)))

add generate boot task

add generate boot task


(ns lambdaui.api-test
  (:require [clojure.test :refer :all]
            [lambdaui.api-legacy :as subject]
            [lambdacd.steps.control-flow :as ctrl-flow]
            [lambdacd.event-bus :as event-bus]
            [lambdacd.internal.pipeline-state :as state]
            [org.httpkit.server :as httpkit-server]
            [shrubbery.core :refer :all]
            [clojure.core.async :as async]
            [clojure.data.json :as json]
            [lambdacd.internal.default-pipeline-state :as default-state]
            )
  (:import (org.joda.time DateTime DateTimeZone)))

(defn do-stuff [] {})

(def foo-pipeline
  `(do-stuff))

(def pipeline-with-substeps
  `((ctrl-flow/run do-stuff do-stuff)))

(def pipeline-with-substeps-parallel
  `((ctrl-flow/in-parallel do-stuff do-stuff)))

(def pipeline-with-substeps-state
  (let [joda-date-12 (DateTime. 2016 01 01 12 00 (DateTimeZone/UTC))
        joda-date-14 (DateTime. 2016 01 01 14 00 (DateTimeZone/UTC))]
    {'(1)   {:status                :running
             :first-updated-at      joda-date-12
             :most-recent-update-at joda-date-14
             }
     '(1 1) {:status                :running
             :first-updated-at      joda-date-12
             :most-recent-update-at joda-date-14
             }}))

(defn foo-pipeline-build-state [status]
  (let [joda-date-12 (DateTime. 2016 01 01 12 00 (DateTimeZone/UTC))
        joda-date-14 (DateTime. 2016 01 01 14 00 (DateTimeZone/UTC))]
    {'(1) {:status                status
           :first-updated-at      joda-date-12
           :most-recent-update-at joda-date-14}}))

(deftest build-details-from-pipeline-test
  (testing "that it returns build details of a running step"
    (doall (for [running-status [:waiting :running :foo]]
             (let [buildId 1]
               (is (= {:buildId 1
                       :steps   [{:stepId    "1"
                                  :state     running-status
                                  :name      "do-stuff"
                                  :startTime "2016-01-01T12:00:00.000Z"
                                  :endTime   nil}]}
                      (subject/build-details-from-pipeline foo-pipeline (foo-pipeline-build-state running-status) buildId)))))))
  (testing "that it returns build details of a finished step"
    (doall (for [finished-status [:success :failure :killed]]
             (let [buildId 1]
               (is (= {:buildId 1
                       :steps   [{:stepId    "1"
                                  :state     finished-status
                                  :name      "do-stuff"
                                  :startTime "2016-01-01T12:00:00.000Z"
                                  :endTime   "2016-01-01T14:00:00.000Z"}]}
                      (subject/build-details-from-pipeline foo-pipeline (foo-pipeline-build-state finished-status) buildId)))))))
  (testing "that it returns build details of nested steps"
    (let [buildId 1]
      (is (= {:buildId 1
              :steps   [{:stepId    "1"
                         :state     :running
                         :name      "run"
                         :startTime "2016-01-01T12:00:00.000Z"
                         :endTime   nil
                         :type      :container
                         :steps     [{:stepId    "1-1"
                                      :state     :running
                                      :name      "do-stuff"
                                      :startTime "2016-01-01T12:00:00.000Z"
                                      :endTime   nil}

                                     {:stepId    "2-1"
                                      :state     :pending
                                      :name      "do-stuff"
                                      :startTime nil
                                      :endTime   nil}]}]} (subject/build-details-from-pipeline pipeline-with-substeps pipeline-with-substeps-state buildId)))))

  (testing "that it returns build details of nested parallel step"
    (let [buildId 1]
      (is (= {:buildId 1
              :steps   [{:stepId    "1"
                         :state     :running
                         :name      "in-parallel"
                         :type      :parallel
                         :startTime "2016-01-01T12:00:00.000Z"
                         :endTime   nil
                         :steps     [{:stepId    "1-1"
                                      :state     :running
                                      :name      "do-stuff"
                                      :startTime "2016-01-01T12:00:00.000Z"
                                      :endTime   nil}

                                     {:stepId    "2-1"
                                      :state     :pending
                                      :name      "do-stuff"
                                      :startTime nil
                                      :endTime   nil}]}]} (subject/build-details-from-pipeline pipeline-with-substeps-parallel pipeline-with-substeps-state buildId))))))

(deftest output-websocket
  (testing "that a payload is sent through the ws channel"
    (let [event-channel (async/chan)
          sent-channel  (async/chan 1)
          ws-ch         (reify httpkit-server/Channel
                          (on-close [& _])
                          (send! [ws-ch data] (async/>!! sent-channel data)))]
      (with-redefs [event-bus/subscribe (fn [ctx topic] nil)
                    event-bus/only-payload (fn [subscription] event-channel)
                    state/get-all (fn [_] {})]
        (subject/output-events nil ws-ch 1 "2-1")
        (async/>!! event-channel {:build-number 1 :step-id [2 1] :step-result {:foo :bar}})
        (async/<!! sent-channel)                            ;ignore first msg. not part of test
        (is (= (json/write-str {:stepId "2-1" :buildId 1 :stepResult {:foo :bar}}) (async/<!! sent-channel))))))

  (testing "that a websocket is closed if step is finished"
    (let [

          event-channel (async/chan)
          sent-channel  (async/chan 1)
          closed (atom false)
          ws-ch         (reify httpkit-server/Channel
                          (on-close [& _])
                          (close [ws-ch] (reset! closed true))
                          (send! [ws-ch data] (async/>!! sent-channel data)))]
      (with-redefs [event-bus/subscribe (fn [ctx topic] nil)
                    event-bus/only-payload (fn [subscription] event-channel)
                    state/get-all (fn [_] {})]
        (subject/output-events nil ws-ch 1 "2-1")
        (async/>!! event-channel {:build-number 1 :step-id [2 1] :stepResult {:status :running}})
        (async/>!! event-channel {:build-number 1 :step-id [2 1] :stepResult {:status :success}})

        (println (async/<!! sent-channel))                  ;ignore first msg. not part of test
        (println (async/<!! sent-channel))
        ;(is (= true @closed))
        )
        ))
    )

(deftest only-matching-step-test
  (testing "that it filters for matching steps"
    (let [in-ch  (async/to-chan [{:build-number 1 :step-id [2 1] :step-result {:foo :bar}}
                                 {:build-number 2 :step-id [2 1] :step-result {:foo :bar}}
                                 {:build-number 1 :step-id [3 1] :step-result {:foo :bar}}])
          out-ch (subject/only-matching-step in-ch 1 "2-1")]
      (is (= [{:buildId 1 :stepId "2-1" :stepResult {:foo :bar}}] (async/<!! (async/into [] out-ch)))))))

(defn wrap-websocket-channel [sent-channel]
  (reify httpkit-server/Channel
    (on-close [& _])
    (send! [_ data] (println "sending " data) (async/>!! sent-channel data))
    (close [_] nil))
  )

(defn debug [x]
  ;(println x)
  x)

(deftest details-websocket
  (testing "that a json payload is sent through the ws channel"

    (with-redefs [lambdacd.internal.pipeline-state/get-all (fn [_] {})]
      (let [pipeline {:pipeline-def pipeline-with-substeps}
            build-id "1"
            ws-ch    (async/chan 1)]
        (subject/websocket-connection-for-details pipeline build-id (wrap-websocket-channel ws-ch))
        (async/close! ws-ch)

        (is (= {:buildId "1"
                :steps   [{:stepId    "1"
                           :state     "pending"
                           :name      "run"
                           :startTime nil
                           :endTime   nil
                           :type      "container"
                           :steps     [{:stepId    "1-1"
                                        :state     "pending"
                                        :name      "do-stuff"
                                        :startTime nil
                                        :endTime   nil}

                                       {:stepId    "2-1"
                                        :state     "pending"
                                        :name      "do-stuff"
                                        :startTime nil
                                        :endTime   nil}]}]}

               (debug (json/read-json (async/<!! ws-ch))))
            )))

    ))

(ns lambdaui.api-test
  (:require [clojure.test :refer :all]
            [lambdaui.api-legacy :as subject]
            [lambdacd.steps.control-flow :as ctrl-flow]
            [lambdacd.event-bus :as event-bus]
            [lambdacd.internal.pipeline-state :as state]
            [org.httpkit.server :as httpkit-server]
            [shrubbery.core :refer :all]
            [clojure.core.async :as async]
            [clojure.data.json :as json]
            [lambdacd.internal.default-pipeline-state :as default-state]
            )
  (:import (org.joda.time DateTime DateTimeZone)))

(defn do-stuff [] {})

(def foo-pipeline
  `(do-stuff))

(def pipeline-with-substeps
  `((ctrl-flow/run do-stuff do-stuff)))

(def pipeline-with-substeps-parallel
  `((ctrl-flow/in-parallel do-stuff do-stuff)))

(def pipeline-with-substeps-state
  (let [joda-date-12 (DateTime. 2016 01 01 12 00 (DateTimeZone/UTC))
        joda-date-14 (DateTime. 2016 01 01 14 00 (DateTimeZone/UTC))]
    {'(1)   {:status                :running
             :first-updated-at      joda-date-12
             :most-recent-update-at joda-date-14
             }
     '(1 1) {:status                :running
             :first-updated-at      joda-date-12
             :most-recent-update-at joda-date-14
             }}))

(defn foo-pipeline-build-state [status]
  (let [joda-date-12 (DateTime. 2016 01 01 12 00 (DateTimeZone/UTC))
        joda-date-14 (DateTime. 2016 01 01 14 00 (DateTimeZone/UTC))]
    {'(1) {:status                status
           :first-updated-at      joda-date-12
           :most-recent-update-at joda-date-14}}))

(deftest build-details-from-pipeline-test
  (testing "that it returns build details of a running step"
    (doall (for [running-status [:waiting :running :foo]]
             (let [buildId 1]
               (is (= {:buildId 1
                       :steps   [{:stepId    "1"
                                  :state     running-status
                                  :name      "do-stuff"
                                  :startTime "2016-01-01T12:00:00.000Z"
                                  :type :step
                                  :steps []
                                  :endTime   nil}]}
                      (subject/build-details-from-pipeline foo-pipeline (foo-pipeline-build-state running-status) buildId)))))))
  (testing "that it returns build details of a finished step"
    (doall (for [finished-status [:success :failure :killed]]
             (let [buildId 1]
               (is (= {:buildId 1
                       :steps   [{:stepId    "1"
                                  :state     finished-status
                                  :name      "do-stuff"
                                  :type :step
                                  :steps []
                                  :startTime "2016-01-01T12:00:00.000Z"
                                  :endTime   "2016-01-01T14:00:00.000Z"}]}
                      (subject/build-details-from-pipeline foo-pipeline (foo-pipeline-build-state finished-status) buildId)))))))
  (testing "that it returns build details of nested steps"
    (let [buildId 1]
      (is (= {:buildId 1
              :steps   [{:stepId    "1"
                         :state     :running
                         :name      "run"
                         :startTime "2016-01-01T12:00:00.000Z"
                         :endTime   nil
                         :type      :container
                         :steps     [{:stepId    "1-1"
                                      :state     :running
                                      :type :step
                                      :steps []
                                      :name      "do-stuff"
                                      :startTime "2016-01-01T12:00:00.000Z"
                                      :endTime   nil}

                                     {:stepId    "2-1"
                                      :state     :pending
                                      :name      "do-stuff"
                                      :type :step
                                      :steps []
                                      :startTime nil
                                      :endTime   nil}]}]} (subject/build-details-from-pipeline pipeline-with-substeps pipeline-with-substeps-state buildId)))))

  (testing "that it returns build details of nested parallel step"
    (let [buildId 1]
      (is (= {:buildId 1
              :steps   [{:stepId    "1"
                         :state     :running
                         :name      "in-parallel"
                         :type      :parallel
                         :startTime "2016-01-01T12:00:00.000Z"
                         :endTime   nil
                         :steps     [{:stepId    "1-1"
                                      :state     :running
                                      :type :step
                                      :steps []
                                      :name      "do-stuff"
                                      :startTime "2016-01-01T12:00:00.000Z"
                                      :endTime   nil}

                                     {:stepId    "2-1"
                                      :state     :pending
                                      :name      "do-stuff"
                                      :type :step
                                      :steps []
                                      :startTime nil
                                      :endTime   nil}]}]} (subject/build-details-from-pipeline pipeline-with-substeps-parallel pipeline-with-substeps-state buildId))))))

(deftest output-websocket
  (testing "that a payload is sent through the ws channel"
    (let [event-channel (async/chan)
          sent-channel  (async/chan 1)
          ws-ch         (reify httpkit-server/Channel
                          (on-close [& _])
                          (send! [ws-ch data] (async/>!! sent-channel data)))]
      (with-redefs [event-bus/subscribe (fn [ctx topic] nil)
                    event-bus/only-payload (fn [subscription] event-channel)
                    state/get-all (fn [_] {})]
        (subject/output-events nil ws-ch 1 "2-1")
        (async/>!! event-channel {:build-number 1 :step-id [2 1] :step-result {:foo :bar}})
        (async/<!! sent-channel)                            ;ignore first msg. not part of test
        (is (= (json/write-str {:stepId "2-1" :buildId 1 :stepResult {:foo :bar}}) (async/<!! sent-channel))))))

  (testing "that a websocket is closed if step is finished"
    (let [

          event-channel (async/chan)
          sent-channel  (async/chan 1)
          closed (atom false)
          ws-ch         (reify httpkit-server/Channel
                          (on-close [& _])
                          (close [ws-ch] (reset! closed true))
                          (send! [ws-ch data] (async/>!! sent-channel data)))]
      (with-redefs [event-bus/subscribe (fn [ctx topic] nil)
                    event-bus/only-payload (fn [subscription] event-channel)
                    state/get-all (fn [_] {})]
        (subject/output-events nil ws-ch 1 "2-1")
        (async/>!! event-channel {:build-number 1 :step-id [2 1] :stepResult {:status :running}})
        (async/>!! event-channel {:build-number 1 :step-id [2 1] :stepResult {:status :success}})

        (println (async/<!! sent-channel))                  ;ignore first msg. not part of test
        (println (async/<!! sent-channel))
        ;(is (= true @closed))
        )
        ))
    )

(deftest only-matching-step-test
  (testing "that it filters for matching steps"
    (let [in-ch  (async/to-chan [{:build-number 1 :step-id [2 1] :step-result {:foo :bar}}
                                 {:build-number 2 :step-id [2 1] :step-result {:foo :bar}}
                                 {:build-number 1 :step-id [3 1] :step-result {:foo :bar}}])
          out-ch (subject/only-matching-step in-ch 1 "2-1")]
      (is (= [{:buildId 1 :stepId "2-1" :stepResult {:foo :bar}}] (async/<!! (async/into [] out-ch)))))))

(defn wrap-websocket-channel [sent-channel]
  (reify httpkit-server/Channel
    (on-close [& _])
    (send! [_ data] (println "sending " data) (async/>!! sent-channel data))
    (close [_] nil))
  )

(defn debug [x]
  ;(println x)
  x)

(deftest details-websocket
  (testing "that a json payload is sent through the ws channel"

    (with-redefs [lambdacd.internal.pipeline-state/get-all (fn [_] {})]
      (let [pipeline {:pipeline-def pipeline-with-substeps}
            build-id "1"
            ws-ch    (async/chan 1)]
        (subject/websocket-connection-for-details pipeline build-id (wrap-websocket-channel ws-ch))
        (async/close! ws-ch)

        (is (= {:buildId "1"
                :steps   [{:stepId    "1"
                           :state     "pending"
                           :name      "run"
                           :startTime nil
                           :endTime   nil
                           :type      "container"
                           :steps     [{:stepId    "1-1"
                                        :state     "pending"
                                        :name      "do-stuff"
                                        :type "step"
                                        :steps []
                                        :startTime nil
                                        :endTime   nil}

                                       {:stepId    "2-1"
                                        :state     "pending"
                                        :name      "do-stuff"
                                        :type "step"
                                        :steps []
                                        :startTime nil
                                        :endTime   nil}]}]}

               (debug (json/read-json (async/<!! ws-ch))))
            )))

    ))

fix failing tests

fix failing tests