(ns desdemona.query
  (:require
   [clojure.core.logic :as l]
   [clojure.core.match :as m]
   [clojure.string :as s]
   [instaparse.core :as insta]
   [clojure.java.io :refer [resource]]))

(defn free-sym
  "Returns symbol, but marked as a free variable."
  [sym]
  (vary-meta sym assoc ::free true))

(def ^:private free-sym?
  "Check if an object has the free variable metadata annotation."
  (every-pred symbol? (comp ::free meta)))

(defn ^:private find-free-vars
  "Finds all the free logic variables in a given logic query.

  This takes advantage of the fact that function references for goal
  functions/macros (conde, featurec...) will be fully qualified, but free
  variables will be unadorned by a namespace."
  [logic-query]
  (->> (flatten logic-query)
       (filter free-sym?)
       (into #{})))

(defn ^:private generate-logic-query
  "Expands a query and events to a core.logic program that executes
  it.

  This is implemented using syntax-quote because that was the easiest
  way to produce this data structure with some values interpolated.

  The n-answers is simply passed to core.logic/run; we're relying on
  it to correctly bound the number of answers. This helps us limit how
  long it takes to query."
  [n-answers logic-query events]
  `(l/run ~n-answers [results#]
     (l/fresh [~'x] ;; ~'x means "literally x, don't gensym", see #28
       (l/== [~'x] results#)
       (l/membero ~'x ~events)
       ~logic-query)))

(defn ^:private run-logic-query
  "Runs a query over some events and finds n answers (default 1)."
  ([logic-query events]
   (run-logic-query 1 logic-query events))
  ([n-answers logic-query events]
   (let [old-ns *ns*]
     (try
       (in-ns 'desdemona.query)
       (eval (generate-logic-query n-answers logic-query events))
       (finally
         (in-ns (ns-name old-ns)))))))

(defn ^:private dsl->logic
  "Given a DSL query, compile it to the underlying logic (miniKanren)
  expressions."
  [dsl-query]
  (m/match [dsl-query]
    [((= ((attr lvar) :seq) value) :seq)]
    (let [lvar (free-sym lvar)]
      `(l/featurec ~lvar {~attr ~value}))

    [((= value ((attr lvar) :seq)) :seq)]
    (let [lvar (free-sym lvar)]
      `(l/featurec ~lvar {~attr ~value}))

    [(('and & terms) :seq)]
    (let [logic-terms (map dsl->logic terms)]
      `(l/conde [~@logic-terms]))

    [(('or & terms) :seq)]
    (let [clauses (map (comp vector dsl->logic) terms)]
      `(l/conde ~@clauses))))

(defn run-dsl-query
  "Run a DSL query over some events and finds n answers (default 1)."
  ([dsl-query events]
   (run-logic-query (dsl->logic dsl-query) events))
  ([n-answers dsl-query events]
   (run-logic-query n-answers (dsl->logic dsl-query) events)))

(def ^:private infix-parser
  (insta/parser (resource "infix-query-grammar.ebnf")))

(defn ^:private parsed-infix->dsl
  [parsed]
  (m/match parsed
    [:expr terms]
    (parsed-infix->dsl terms)

    [:eq
     [:fn-call
      [:identifier "ip"]
      [:identifier arg]]
     [:ipv4-address & addr-parts]]
    (let [arg (symbol arg)
          addr (s/join "." addr-parts)]
      `(~'= (:ip ~arg) ~addr))))

(def infix->dsl
  (comp parsed-infix->dsl infix-parser))

(ns desdemona.query
  (:require
   [clojure.core.logic :as l]
   [clojure.core.match :as m]
   [clojure.string :as s]
   [instaparse.core :as insta]
   [clojure.java.io :refer [resource]]))

(defn free-sym
  "Returns symbol, but marked as a free variable."
  [sym]
  (vary-meta sym assoc ::free true))

(def ^:private free-sym?
  "Check if an object has the free variable metadata annotation."
  (every-pred symbol? (comp ::free meta)))

(defn ^:private find-free-vars
  "Finds all the free logic variables in a given logic query.

  This takes advantage of the fact that function references for goal
  functions/macros (conde, featurec...) will be fully qualified, but free
  variables will be unadorned by a namespace."
  [logic-query]
  (->> (flatten logic-query)
       (filter free-sym?)
       (into #{})))

(defn ^:private generate-logic-query
  "Expands a query and events to a core.logic program that executes
  it.

  This is implemented using syntax-quote because that was the easiest
  way to produce this data structure with some values interpolated.

  The n-answers is simply passed to core.logic/run; we're relying on
  it to correctly bound the number of answers. This helps us limit how
  long it takes to query."
  [n-answers logic-query events]
  (let [free-vars (find-free-vars logic-query)
        membero-clauses (for [v free-vars]
                          `(l/membero ~v ~events))]
    `(l/run ~n-answers [results#]
       (l/fresh [~@free-vars]
         (l/== [~@free-vars] results#)
         ~@membero-clauses
         ~logic-query))))

(defn ^:private run-logic-query
  "Runs a query over some events and finds n answers (default 1)."
  ([logic-query events]
   (run-logic-query 1 logic-query events))
  ([n-answers logic-query events]
   (let [old-ns *ns*]
     (try
       (in-ns 'desdemona.query)
       (eval (generate-logic-query n-answers logic-query events))
       (finally
         (in-ns (ns-name old-ns)))))))

(defn ^:private dsl->logic
  "Given a DSL query, compile it to the underlying logic (miniKanren)
  expressions."
  [dsl-query]
  (m/match [dsl-query]
    [((= ((attr lvar) :seq) value) :seq)]
    (let [lvar (free-sym lvar)]
      `(l/featurec ~lvar {~attr ~value}))

    [((= value ((attr lvar) :seq)) :seq)]
    (let [lvar (free-sym lvar)]
      `(l/featurec ~lvar {~attr ~value}))

    [(('and & terms) :seq)]
    (let [logic-terms (map dsl->logic terms)]
      `(l/conde [~@logic-terms]))

    [(('or & terms) :seq)]
    (let [clauses (map (comp vector dsl->logic) terms)]
      `(l/conde ~@clauses))))

(defn run-dsl-query
  "Run a DSL query over some events and finds n answers (default 1)."
  ([dsl-query events]
   (run-logic-query (dsl->logic dsl-query) events))
  ([n-answers dsl-query events]
   (run-logic-query n-answers (dsl->logic dsl-query) events)))

(def ^:private infix-parser
  (insta/parser (resource "infix-query-grammar.ebnf")))

(defn ^:private parsed-infix->dsl
  [parsed]
  (m/match parsed
    [:expr terms]
    (parsed-infix->dsl terms)

    [:eq
     [:fn-call
      [:identifier "ip"]
      [:identifier arg]]
     [:ipv4-address & addr-parts]]
    (let [arg (symbol arg)
          addr (s/join "." addr-parts)]
      `(~'= (:ip ~arg) ~addr))))

(def infix->dsl
  (comp parsed-infix->dsl infix-parser))

Make the tests pass

Make the tests pass


(ns qcast.infoq.scraper
  (:gen-class)
  (:require [clj-time.coerce  :as time-coerce]
            [clj-time.format  :as time]
            [clojure.string   :refer [split trim]]
            [qcast.cache      :as cache]
            [qcast.html       :refer :all]
            [qcast.infoq.site :as infoq]
            [qcast.util       :refer :all]
            [taoensso.timbre  :refer :all])
  (:refer-clojure :exclude [meta]))

;;; Internals

(defn- host-url [& s]
  (let [host (or (System/getenv "HOST") "localhost:8080")]
    (apply str "http://" host s)))

;; Scraping Internals

(defn- poster [dom]
  (meta :property "og:image" infoq/poster-url dom))

(defn- keywords [dom]
  (letfn [(split-keywords [s]
            (let [[lowercase-kw & uppercase-kw] (split s #",")
                  lowercase-kw (split lowercase-kw #" ")]
              (map trim (concat lowercase-kw uppercase-kw))))]
    (meta "keywords" split-keywords dom)))

(defn- summary [dom]
  (meta "description" trim dom))

(defn- title [dom]
  (select [:head :title] inner-text dom))

(defn- authors [dom]
  (let [authors-split #(split % #"(\s*[,;&]\s*|\s+and\s+)")
        transformer #(some->> % inner-text authors-split (map trim))]
    (select [:.author_general :> :a] transformer dom)))

(defn- length [dom]
  (let [transformer #(some-> % inner-text interval->sec)]
    (select [:.videolength2] transformer dom)))

(defn- pdf [dom]
  (let [transformer #(some->> % (attr :value) (host-url "/"))
        url (select [:#pdfForm :> [:input (attr= :name "filename")]] transformer dom)]
  (when url
    [url 0 "application/pdf"]))) ;; Size yet unknown

(defn- audio [dom]
  (let [transformer #(some->> % (attr :value) (host-url "/"))
        url (select [:#mp3Form :> [:input (attr= :name "filename")]] transformer dom)]
    (when url
      [url 0 "audio/mpeg"]))) ;; Size yet unknown

(defn- video [dom]
  (let [transformer #(some->> % (attr :src) infoq/media-meta)]
    (select [:#video :> :source] transformer dom)))

(defn- record-date [dom]
  (let [transformer #(some->> % (attr :src)
                              (re-find #"/([0-9]{2}-[a-z]{3})-.*$") second
                              (time/parse (time/formatter "yy-MMM"))
                              time-coerce/to-date)]
    (select [:#video :> :source] transformer dom)))

(defn- publish-date [dom]
  (meta "tprox" (comp time-coerce/to-date parse-int) dom))

(defn- online-date [dom]
  (let [transformer #(some->> % (inner-text 2)
                              (re-find #"(?s)on\s*(.*)") second
                              (time/parse (time/formatter "MMM dd, yyyy"))
                              time-coerce/to-date)]
    (select [:.author_general] transformer dom)))

(defn- slides [dom]
  (let [transformer #(some->> % inner-text (re-find #"var slides.*"))
        filter #(some->> % (some identity) (re-seq #"'(.+?)'")
                         (map (comp infoq/slide-url second)))]
    (select-all [:script] transformer filter dom)))

(defn- times [dom]
  (let [transformer #(some->> % inner-text (re-find #"TIMES.*"))
        filter #(some->> % (some identity) (re-seq #"(\d+?),")
                         (map (comp parse-int second)))]
    (select-all [:script] transformer filter dom)))

;; Scraping API

(defn- metadata [id]
  (let [md-keys [:id :link :poster :keywords :summary :title :authors
                 :record-date :publish-date :online-date
                 :length :pdf :audio :video :slides :times]
        md-vals (juxt (constantly id) (constantly (infoq/presentation-url id))
                      poster keywords summary title authors
                      record-date publish-date online-date
                      length pdf audio video slides times)]
    (debug "Fetching presentation" id)
    (log-errors (some->> id
                         infoq/presentation
                         dom
                         md-vals
                         (zipmap md-keys)))))

(defn- latest
  ([] (latest 0))
  ([marker]
     (debug "Fetching overview from index" marker)
     (let [items (log-errors (infoq/presentations marker))]
       (if (empty? items)
         (if (> marker 0)
           (info "No more items found")
           (warn "No items found. HTML/CSS layout changed?"))
         (lazy-cat items (latest (+ marker (count items))))))))

(defn- cache-updates
  "Scrape the overview sites and collect its oughly 12 items per site until
  finding an seen item (since). Scrape a maximum of limit or 100 items. This
  sequence requires one additional GET (page) + three HEAD (video, audio, pdf)
  requests per item, thus n%12 + 2*n."
  ([] (cache-updates (cache/latest)))
  ([until] (cache-updates until 100))
  ([until limit]
     (let [until-id (or (:id until) :inf)]
       (info "Check for updates up until" until-id)
       (->> (latest)
            (take-while #(not= % until-id))
            (pmap metadata)
            (filter identity)
            (take limit)
            (map cache/put)
            doall))))

;;; Interface

;; Main

(defn -main [& args]
  (info "Starting catcher")
  (let [task #(debug "Updated" (count (cache-updates)))]
    (if (= (first args) "once")
      (do (info "Running once")
          (task))
      (do (info "Running periodically")
          (interspaced (minutes 30) #(logged-future (task)))))))

(ns qcast.infoq.scraper
  (:gen-class)
  (:require [clj-time.coerce  :as time-coerce]
            [clj-time.format  :as time]
            [clojure.string   :refer [split trim]]
            [qcast.cache      :as cache]
            [qcast.html       :refer :all]
            [qcast.infoq.site :as infoq]
            [qcast.util       :refer :all]
            [taoensso.timbre  :refer :all])
  (:refer-clojure :exclude [meta]))

;;; Internals

(defn- host-url [& s]
  (let [host (or (System/getenv "HOST") "localhost:8080")]
    (apply str "http://" host s)))

;; Scraping Internals

(defn- poster [dom]
  (meta :property "og:image" infoq/poster-url dom))

(defn- keywords [dom]
  (letfn [(split-keywords [s]
            (let [[lowercase-kw & uppercase-kw] (split s #",")
                  lowercase-kw (split lowercase-kw #" ")]
              (map trim (concat lowercase-kw uppercase-kw))))]
    (meta "keywords" split-keywords dom)))

(defn- summary [dom]
  (meta "description" trim dom))

(defn- title [dom]
  (select [:head :title] inner-text dom))

(defn- authors [dom]
  (let [authors-split #(split % #"(\s*[,;&]\s*|\s+and\s+)")
        transformer #(some->> % inner-text authors-split (map trim))]
    (select [:.author_general :> :a] transformer dom)))

(defn- length [dom]
  (let [transformer #(some-> % inner-text interval->sec)]
    (select [:.videolength2] transformer dom)))

(defn- pdf [dom]
  (let [transformer #(some->> % (attr :value) (host-url "/"))
        url (select [:#pdfForm :> [:input (attr= :name "filename")]] transformer dom)]
  (when url
    [url 0 "application/pdf"]))) ;; Size yet unknown

(defn- audio [dom]
  (let [transformer #(some->> % (attr :value) (host-url "/"))
        url (select [:#mp3Form :> [:input (attr= :name "filename")]] transformer dom)]
    (when url
      [url 0 "audio/mpeg"]))) ;; Size yet unknown

(defn- video [dom]
  (let [transformer #(some->> % (attr :src) infoq/media-meta)]
    (select [:#video :> :source] transformer dom)))

(defn- record-date [dom]
  (let [transformer #(some->> % (attr :src)
                              (re-find #"/([0-9]{2}-[a-z]{3})-.*$") second
                              (time/parse (time/formatter "yy-MMM"))
                              time-coerce/to-date)]
    (select [:#video :> :source] transformer dom)))

(defn- publish-date [dom]
  (meta "tprox" (comp time-coerce/to-date parse-int) dom))

(defn- online-date [dom]
  (let [transformer #(some->> % (inner-text 2)
                              (re-find #"(?s)on\s*(.*)") second
                              (time/parse (time/formatter "MMM dd, yyyy"))
                              time-coerce/to-date)]
    (select [:.author_general] transformer dom)))

(defn- slides [dom]
  (let [transformer #(some->> % inner-text (re-find #"var slides.*"))
        filter #(some->> % (some identity) (re-seq #"'(.+?)'")
                         (map (comp infoq/slide-url second)))]
    (select-all [:script] transformer filter dom)))

(defn- times [dom]
  (let [transformer #(some->> % inner-text (re-find #"TIMES.*"))
        filter #(some->> % (some identity) (re-seq #"(\d+?),")
                         (map (comp parse-int second)))]
    (select-all [:script] transformer filter dom)))

;; Scraping API

(defn- metadata [id]
  (let [md-keys [:id :link :poster :keywords :summary :title :authors
                 :record-date :publish-date :online-date
                 :length :pdf :audio :video :slides :times]
        md-vals (juxt (constantly id) (constantly (infoq/presentation-url id))
                      poster keywords summary title authors
                      record-date publish-date online-date
                      length pdf audio video slides times)]
    (debug "Fetching presentation" id)
    (log-errors (some->> id
                         infoq/presentation
                         dom
                         md-vals
                         (zipmap md-keys)))))

(defn- latest
  ([] (latest 0))
  ([marker]
     (debug "Fetching overview from index" marker)
     (let [items (log-errors (infoq/presentations marker))]
       (if (empty? items)
         (if (> marker 0)
           (info "No more items found")
           (warn "No items found. HTML/CSS layout changed?"))
         (lazy-cat items (latest (+ marker (count items))))))))

(defn- cache-updates
  "Scrape the overview sites and collect its oughly 12 items per site until
  finding an seen item (since). Scrape a maximum of limit or 1000 items. This
  sequence requires one additional GET (page) + three HEAD (video, audio, pdf)
  requests per item, thus n%12 + 2*n."
  ([] (cache-updates (cache/latest)))
  ([until] (cache-updates until 1000))
  ([until limit]
     (let [until-id (or (:id until) :inf)]
       (info "Check for updates up until" until-id)
       (->> (latest)
            (take-while #(not= % until-id))
            (pmap metadata)
            (filter identity)
            (take limit)
            (map cache/put)
            doall))))

;;; Interface

;; Main

(defn -main [& args]
  (info "Starting catcher")
  (let [task #(debug "Updated" (count (cache-updates)))]
    (if (= (first args) "once")
      (do (info "Running once")
          (task))
      (do (info "Running periodically")
          (interspaced (minutes 30) #(logged-future (task)))))))

Increase initial scraping limit to 1000

Increase initial scraping limit to 1000

Change-Id: I70966049f503e9d1d67f7f1a50c62f3528a959ea


(ns haystack.search
  (:require [clojure.set :as set]
            [clojure.string :refer [split join]]
            [clojure.set :refer [rename-keys]]

            [clj-http.client :as client]
            [bidi.bidi :as bidi]
            ;; [clojurewerkz.elastisch.rest.index :as esi]
            ;; [clojurewerkz.elastisch.rest :as esr] ;; for connect
            [clojurewerkz.elastisch.rest.document :as esd]

            [haystack.repo :refer [repo]]
            [haystack.query :as query]

            [haystack.ecommerce :refer [find-category-by-path find-manufacturer]]
            ))

(defn merge-aggregation-names
  [aggregations]
  (let [cats (:category-path aggregations)
        manuf (:manufacturer-id aggregations)
        ancestors (:category-path-ancestors aggregations)
        ancestor-paths
        (map (fn [facet]
               (let [m (find-category-by-path (:key facet))]
                 (cond-> facet
                   m (assoc :name (:name m)))))
             ancestors)
        ancestor-paths
        (if (empty? ancestor-paths)
          ancestor-paths
          (let [last-key (:key (last ancestor-paths))
                dropped-counts (map #(if (= last-key (:key %))
                                       %
                                       (dissoc % :doc_count))
                                    ancestor-paths)
                ]
            (concat [{:key "" :name "All Categories"}] dropped-counts)))
        ]
    {:category-path (map (fn [facet]
                           (let [m (find-category-by-path (:key facet))]
                             (cond-> facet
                               m (assoc :name (:name m)))))
                         cats)
     :manufacturer-id (map (fn [facet] (let [m (find-manufacturer (:key facet))]
                                   (cond-> facet
                                     m (assoc :name (:name m)))))
                           manuf)
     :category-path-ancestors ancestor-paths
     }
    ))

;; (def q {:query {:query_string "copper"}})
;; (esd/search repo "searchecommerce" "productplus" q)
;; (:uri repo)

(defn process-search
  [query-map]
  (let [q (query/build-search-query query-map)
        response (try (esd/search repo "searchecommerce" "productplus" q) (catch Throwable e {}))
        aggregations (query/extract-aggregations query-map response)
        named-aggregations (merge-aggregation-names aggregations)
        ]
    (if (:total-items-only query-map)
      {:total-items (-> response :hits :total)
       :elasticsearch-query q
       }
      {:paging (query/extract-paging query-map response)
       ;; :transform (query/transform-search-query query-map)
       ;; :q q
       :search-request query-map
       :documents (query/extract-documents response)
       :aggregations named-aggregations
       :elasticsearch-query q
       :response response
       })))

(defn search
  [query-map]
  (let [query-map (let [m (:manufacturer-ids query-map)]
                    (cond-> query-map
                      m (assoc :manufacturer-ids (read-string m))
                      (= "" (:category-path query-map)) (dissoc :category-path)
                      ))
        _ (prn query-map)
        sc-id (:service-center-id query-map)
        entire? (or (= "true" (:query-entire query-map)) (not sc-id))
        query-map (dissoc query-map :query-entire)
        main-query-map (if entire? (dissoc query-map :service-center-id) query-map)
        main-response (future (process-search main-query-map))
        secondary-query-map (if entire?
                              (if sc-id query-map)
                              (dissoc query-map :service-center-id))
        secondary-query-map (when secondary-query-map
                              (assoc secondary-query-map :total-items-only true))
        secondary-response (when secondary-query-map
                             (future (process-search secondary-query-map)))
        hits (if entire?
               {:entire-item-count (-> @main-response :paging :total-items)
                :local-item-count (when secondary-response (-> @secondary-response :total-items))}
               {:entire-item-count (when secondary-response (-> @secondary-response :total-items))
                :local-item-count (-> @main-response :paging :total-items)}
               )
        ]
    (dissoc
     (assoc
      (assoc-in @main-response [:paging]
                (merge (:paging @main-response) hits))
      :query-maps {:main main-query-map
                   :secondary secondary-query-map
                   :main-elasticsearch (:elasticsearch-query @main-response)
                   :secondary-elasticsearch (when secondary-response
                                              (:elasticsearch-query @secondary-response))
                   })
     :elasticsearch-query)
    ))

;; (search {:search "copper"})

(ns haystack.search
  (:require [clojure.set :as set]
            [clojure.string :refer [split join]]
            [clojure.set :refer [rename-keys]]

            [clj-http.client :as client]
            [bidi.bidi :as bidi]
            ;; [clojurewerkz.elastisch.rest.index :as esi]
            ;; [clojurewerkz.elastisch.rest :as esr] ;; for connect
            [clojurewerkz.elastisch.rest.document :as esd]

            [haystack.repo :refer [repo]]
            [haystack.query :as query]

            [haystack.ecommerce :refer [find-category-by-path find-manufacturer]]
            )
  (:import [java.net ConnectException SocketException]))

(defn merge-aggregation-names
  [aggregations]
  (let [cats (:category-path aggregations)
        manuf (:manufacturer-id aggregations)
        ancestors (:category-path-ancestors aggregations)
        ancestor-paths
        (map (fn [facet]
               (let [m (find-category-by-path (:key facet))]
                 (cond-> facet
                   m (assoc :name (:name m)))))
             ancestors)
        ancestor-paths
        (if (empty? ancestor-paths)
          ancestor-paths
          (let [last-key (:key (last ancestor-paths))
                dropped-counts (map #(if (= last-key (:key %))
                                       %
                                       (dissoc % :doc_count))
                                    ancestor-paths)
                ]
            (concat [{:key "" :name "All Categories"}] dropped-counts)))
        ]
    {:category-path (map (fn [facet]
                           (let [m (find-category-by-path (:key facet))]
                             (cond-> facet
                               m (assoc :name (:name m)))))
                         cats)
     :manufacturer-id (map (fn [facet] (let [m (find-manufacturer (:key facet))]
                                   (cond-> facet
                                     m (assoc :name (:name m)))))
                           manuf)
     :category-path-ancestors ancestor-paths
     }
    ))

;; (def q {:query {:query_string "copper"}})
;; (esd/search repo "searchecommerce" "productplus" q)
;; (:uri repo)

(defn process-search
  [query-map]
  (let [q (query/build-search-query query-map)
        response (try (esd/search repo "searchecommerce" "productplus" q)
                      (catch Throwable e
                        (println e) (println "err type:" (type e)) (prn (type e))
                        (condp = (type e)
                          java.net.ConnectException (println "connection error")
                          java.net.SocketException (println "socket error. Elasticsearch may have just come back and next search request may work.")
                          (println "error type:" (type e))
                          )
                        {}))
        aggregations (query/extract-aggregations query-map response)
        named-aggregations (merge-aggregation-names aggregations)
        ]
    (if (:total-items-only query-map)
      {:total-items (-> response :hits :total)
       :elasticsearch-query q
       }
      {:paging (query/extract-paging query-map response)
       ;; :transform (query/transform-search-query query-map)
       ;; :q q
       :search-request query-map
       :documents (query/extract-documents response)
       :aggregations named-aggregations
       :elasticsearch-query q
       :response response
       })))

(defn search
  [query-map]
  (let [query-map (let [m (:manufacturer-ids query-map)]
                    (cond-> query-map
                      m (assoc :manufacturer-ids (read-string m))
                      (= "" (:category-path query-map)) (dissoc :category-path)
                      ))
        _ (prn query-map)
        sc-id (:service-center-id query-map)
        entire? (or (= "true" (:query-entire query-map)) (not sc-id))
        query-map (dissoc query-map :query-entire)
        main-query-map (if entire? (dissoc query-map :service-center-id) query-map)
        main-response (future (process-search main-query-map))
        secondary-query-map (if entire?
                              (if sc-id query-map)
                              (dissoc query-map :service-center-id))
        secondary-query-map (when secondary-query-map
                              (assoc secondary-query-map :total-items-only true))
        secondary-response (when secondary-query-map
                             (future (process-search secondary-query-map)))
        hits (if entire?
               {:entire-item-count (-> @main-response :paging :total-items)
                :local-item-count (when secondary-response (-> @secondary-response :total-items))}
               {:entire-item-count (when secondary-response (-> @secondary-response :total-items))
                :local-item-count (-> @main-response :paging :total-items)}
               )
        ]
    (dissoc
     (assoc
      (assoc-in @main-response [:paging]
                (merge (:paging @main-response) hits))
      :query-maps {:main main-query-map
                   :secondary secondary-query-map
                   :main-elasticsearch (:elasticsearch-query @main-response)
                   :secondary-elasticsearch (when secondary-response
                                              (:elasticsearch-query @secondary-response))
                   })
     :elasticsearch-query)
    ))

;; (search {:search "copper"})

Add exception printing to process-search.


(ns overseer.schema
  (:require [datomic.api :as d]))

 (def schema-txn
   [{:db/id (d/tempid :db.part/db)
     :db/ident :job/id
     :db/valueType :db.type/string
     :db/unique :db.unique/identity
     :db/cardinality :db.cardinality/one
     :db/doc "A job's unique ID (a semi-sequential UUID)"
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job/type
     :db/valueType :db.type/keyword
     :db/cardinality :db.cardinality/one
     :db/doc "A job's type, represented by a keyword"
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job/status
     :db/valueType :db.type/keyword
     :db/cardinality :db.cardinality/one
     :db/doc "A job's status (unstarted|started|aborted|failed|finished)"
     :db/index true
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job/dep
     :db/valueType :db.type/ref
     :db/cardinality :db.cardinality/many
     :db/doc
     "Dependency of this job ('parent'). Refers to other jobs
     that must be completed before this job can run."
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job.status/updated-at
     :db/valueType :db.type/instant
     :db/cardinality :db.cardinality/one
     :db/doc "Time at which a job's status was last updated."
     :db.install/_attribute :db.part/db}])

(def reserve-job
  "Datomic database function to atomically reserve a job.
   Either reserves the given job id, or throws."
  {:db/id (d/tempid :db.part/user)
   :db/ident :reserve-job
   :db/fn (datomic.function/construct
            {:lang "clojure"
             :params '[db job-id]
             :code
             '(let [result (datomic.api/q '[:find ?s
                                            :in $data ?job-id
                                            :where [$data ?e :job/id ?job-id]
                                                   [$data ?e :job/status ?s]]
                             db
                             job-id)
                    status (ffirst result)]
                (if (= :unstarted status)
                  [[:db/add entity-id :job/status :started]
                   [:db/add entity-id :job.status/updated-at (java.util.Date.)]]
                  (throw (Exception. "Job status not eligible for start."))))})})

 (defn install
   "Install Overseer's schema and DB functions into Datomic"
   [conn]
   @(d/transact conn (conj schema-txn reserve-job))
   :ok)

(ns overseer.schema
  (:require [datomic.api :as d]))

 (def schema-txn
   [{:db/id (d/tempid :db.part/db)
     :db/ident :job/id
     :db/valueType :db.type/string
     :db/unique :db.unique/identity
     :db/cardinality :db.cardinality/one
     :db/doc "A job's unique ID (a semi-sequential UUID)"
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job/type
     :db/valueType :db.type/keyword
     :db/cardinality :db.cardinality/one
     :db/doc "A job's type, represented by a keyword"
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job/status
     :db/valueType :db.type/keyword
     :db/cardinality :db.cardinality/one
     :db/doc "A job's status (unstarted|started|aborted|failed|finished)"
     :db/index true
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job/dep
     :db/valueType :db.type/ref
     :db/cardinality :db.cardinality/many
     :db/doc
     "Dependency of this job ('parent'). Refers to other jobs
     that must be completed before this job can run."
     :db.install/_attribute :db.part/db}

    {:db/id (d/tempid :db.part/db)
     :db/ident :job.status/updated-at
     :db/valueType :db.type/instant
     :db/cardinality :db.cardinality/one
     :db/doc "Time at which a job's status was last updated."
     :db.install/_attribute :db.part/db}])

(def reserve-job
  "Datomic database function to atomically reserve a job.
   Either reserves the given job id, or throws."
  {:db/id (d/tempid :db.part/user)
   :db/ident :reserve-job
   :db/fn (datomic.function/construct
            {:lang "clojure"
             :params '[db job-id]
             :code
             '(let [result (datomic.api/q '[:find ?s
                                            :in $data ?job-id
                                            :where [$data ?e :job/id ?job-id]
                                                   [$data ?e :job/status ?s]]
                             db
                             job-id)
                    status (ffirst result)]
                (if (= :unstarted status)
                  [[:db/add [:job/id job-id] :job/status :started]
                   [:db/add [:job/id job-id] :job.status/updated-at (java.util.Date.)]]
                  (throw (Exception. "Job status not eligible for start."))))})})

 (defn install
   "Install Overseer's schema and DB functions into Datomic"
   [conn]
   @(d/transact conn (conj schema-txn reserve-job))
   :ok)

Fix entity ids in schema/reserve

Fix entity ids in schema/reserve

Since this function was updated to take job ids, we need to update the
query appropriately as well. Doh!


(ns frontrow.handler-test
  (:require [clojure.test :refer [deftest is testing]]
            [frontrow.handler :refer [average]]))

;;;; Tests for pure functions in handler.clj
;;;; lein test :only frontrow.handler-test/test-pure-fns

(deftest test-pure-fns
  (testing "Test average"
    (is (= (average [0 1 2 3 4]) 2))
    (is (= (float (average [-4 2 0 0])) -0.5))
    (is (thrown? AssertionError (average [])))))

(ns frontrow.handler-test
  (:require [clojure.test :refer [deftest is testing]]
            [frontrow.handler :refer [average create-or-conj]]))

;;;; Tests for pure functions in handler.clj
;;;; lein test :only frontrow.handler-test/test-pure-fns

(deftest test-pure-fns
  (testing "Test average"
    (is (= (average [0 1 2 3 4]) 2))
    (is (= (float (average [-4 2 0 0])) -0.5))
    (is (thrown? AssertionError (average []))))
  (testing "Test create-or-conj"
    (is (= (create-or-conj {} :a 4) {:a [4]}))
    (is (= (create-or-conj {:a [4]} :a 5) {:a [4 5]}))
    (is (= (create-or-conj {:a [4]} :b -4) {:a [4] :b [-4]}))))

Add test for create-or-conj.

Add test for create-or-conj.


(ns midje.util.t-laziness
  (:use [midje.sweet]
        [midje.util laziness thread-safe-var-nesting]
        [midje.test-util]))

;; Justification for use of eagerly
(def counter (atom :needs-to-be-initialized))
(def #^:dynamic *mocked-function-produces-next-element* inc)

(defn function-under-test-produces-a-lazy-list []
  (iterate *mocked-function-produces-next-element* 1))

(defn mock-use []
  (binding [*mocked-function-produces-next-element* (fn [n] (swap! counter inc) (inc n))]
    (eagerly (take 5 (function-under-test-produces-a-lazy-list)))))

(fact "eagerly forces evaluation"
  (reset! counter 1)
  (mock-use)
  @counter => 5)

;; After justification, more facts.

(unfinished exploder)
(map exploder [1 2 3])

(defrecord Foo [x y])

(facts "about what happens in the absence of eagerly"
  (with-altered-roots {#'exploder identity} (map #'exploder [1 2 3]))
  => (throws Error)
  (first (with-altered-roots {#'exploder identity} [(map #'exploder [1 2 3])]))
  => (throws Error)
  (first (with-altered-roots {#'exploder identity} (list (map #'exploder [1 2 3]))))
  => (throws Error)
  (:k (with-altered-roots {#'exploder identity} {:k (map #'exploder [1 2 3])}))
  => (throws Error)
  (first (keys (with-altered-roots {#'exploder identity} {(map #'exploder [1 2 3]) 'foo})))
  => (throws Error)
  (:x (with-altered-roots {#'exploder identity} (Foo. (map #'exploder [1 2 3]) 'x)))
  => (throws Error)
)

(fact "about how eagerly improves things"
  (with-altered-roots {#'exploder identity} (eagerly (map #'exploder [1 2 3])))
  => [1 2 3]
  (first (with-altered-roots {#'exploder identity} (eagerly [(map #'exploder [1 2 3])])))
  => [1 2 3]
  (first (with-altered-roots {#'exploder identity} (eagerly (list (map #'exploder [1 2 3])))))
  => [1 2 3]
  (:k (with-altered-roots {#'exploder identity} (eagerly {:k (map #'exploder [1 2 3])})))
  => [1 2 3]
  (first (keys (with-altered-roots {#'exploder identity} (eagerly {(map #'exploder [1 2 3]) 'foo}))))
  => [1 2 3]
  (first (with-altered-roots {#'exploder identity} (eagerly #{(map #'exploder [1 2 3])})))
  => [1 2 3]
  (:x (with-altered-roots {#'exploder identity} (eagerly (Foo. (map #'exploder [1 2 3]) 'x))))
  => [1 2 3]
  )

(fact "eagerly preserves metadata"
  (meta (eagerly (with-meta (map identity [1 2 3]) {:hi :mom})))
  => {:hi :mom})

(fact "eagerly preserves identical? for non-collections."
  (let [eagered (first (eagerly (map identity [odd?])))]
    eagered => #(identical? % odd?)
    (:name (meta eagered)) => #(identical? % (:name (meta odd?)))))

(fact "eagerly preserves record types"
  (class (eagerly (Foo. 4 5))) => Foo
  (eagerly (Foo. 4 5)) => (Foo. 4 5)
  (eagerly [(Foo. 4 5)]) => [(Foo. 4 5)])

(defn- nearby-item-comparator [a b]
  (let [item-key (juxt :timestamp :id)]
    (compare (item-key b) (item-key a))))

(fact "eagerly doesn't barf on sorted-sets with custom comparators... See issue: #158"
      (eagerly (sorted-set-by nearby-item-comparator {:timestamp 0 :id 0} {:timestamp 1 :id 1}))
      => (sorted-set-by nearby-item-comparator {:timestamp 0 :id 0} {:timestamp 1 :id 1}))

(fact "eagerly does NOT preserve identical? for collections even if they had no lazy seqs"
  (let [lazied (with-meta '(1 2 3) {:original :metadata})
        eagered (eagerly lazied)]
    (identical? eagered lazied) => falsey
    (= eagered lazied) => truthy
    (identical? (meta eagered) (meta lazied))))

(ns midje.util.t-laziness
  (:use [midje.sweet]
        [midje.util laziness thread-safe-var-nesting]
        [midje.test-util]))

;; Justification for use of eagerly
(def counter (atom :needs-to-be-initialized))
(def #^:dynamic *mocked-function-produces-next-element* inc)

(defn function-under-test-produces-a-lazy-list []
  (iterate *mocked-function-produces-next-element* 1))

(defn mock-use []
  (binding [*mocked-function-produces-next-element* (fn [n] (swap! counter inc) (inc n))]
    (eagerly (take 5 (function-under-test-produces-a-lazy-list)))))

(fact "eagerly forces evaluation"
  (reset! counter 1)
  (mock-use)
  @counter => 5)

;; After justification, more facts.

(unfinished exploder)
; (map exploder [1 2 3])

(defrecord Foo [x y])

(facts "about what happens in the absence of eagerly"
  (with-altered-roots {#'exploder identity} (map #'exploder [1 2 3]))
  => (throws Error)
  (first (with-altered-roots {#'exploder identity} [(map #'exploder [1 2 3])]))
  => (throws Error)
  (first (with-altered-roots {#'exploder identity} (list (map #'exploder [1 2 3]))))
  => (throws Error)
  (:k (with-altered-roots {#'exploder identity} {:k (map #'exploder [1 2 3])}))
  => (throws Error)
  (first (keys (with-altered-roots {#'exploder identity} {(map #'exploder [1 2 3]) 'foo})))
  => (throws Error)
  (:x (with-altered-roots {#'exploder identity} (Foo. (map #'exploder [1 2 3]) 'x)))
  => (throws Error)
)

(fact "about how eagerly improves things"
  (with-altered-roots {#'exploder identity} (eagerly (map #'exploder [1 2 3])))
  => [1 2 3]
  (first (with-altered-roots {#'exploder identity} (eagerly [(map #'exploder [1 2 3])])))
  => [1 2 3]
  (first (with-altered-roots {#'exploder identity} (eagerly (list (map #'exploder [1 2 3])))))
  => [1 2 3]
  (:k (with-altered-roots {#'exploder identity} (eagerly {:k (map #'exploder [1 2 3])})))
  => [1 2 3]
  (first (keys (with-altered-roots {#'exploder identity} (eagerly {(map #'exploder [1 2 3]) 'foo}))))
  => [1 2 3]
  (first (with-altered-roots {#'exploder identity} (eagerly #{(map #'exploder [1 2 3])})))
  => [1 2 3]
  (:x (with-altered-roots {#'exploder identity} (eagerly (Foo. (map #'exploder [1 2 3]) 'x))))
  => [1 2 3]
  )

(fact "eagerly preserves metadata"
  (meta (eagerly (with-meta (map identity [1 2 3]) {:hi :mom})))
  => {:hi :mom})

(fact "eagerly preserves identical? for non-collections."
  (let [eagered (first (eagerly (map identity [odd?])))]
    eagered => #(identical? % odd?)
    (:name (meta eagered)) => #(identical? % (:name (meta odd?)))))

(fact "eagerly preserves record types"
  (class (eagerly (Foo. 4 5))) => Foo
  (eagerly (Foo. 4 5)) => (Foo. 4 5)
  (eagerly [(Foo. 4 5)]) => [(Foo. 4 5)])

(defn- nearby-item-comparator [a b]
  (let [item-key (juxt :timestamp :id)]
    (compare (item-key b) (item-key a))))

(fact "eagerly doesn't barf on sorted-sets with custom comparators... See issue: #158"
      (eagerly (sorted-set-by nearby-item-comparator {:timestamp 0 :id 0} {:timestamp 1 :id 1}))
      => (sorted-set-by nearby-item-comparator {:timestamp 0 :id 0} {:timestamp 1 :id 1}))

(fact "eagerly does NOT preserve identical? for collections even if they had no lazy seqs"
  (let [lazied (with-meta '(1 2 3) {:original :metadata})
        eagered (eagerly lazied)]
    (identical? eagered lazied) => falsey
    (= eagered lazied) => truthy
    (identical? (meta eagered) (meta lazied))))

Comment out possible cause of 1.7 problem


(ns lens.system
  (:use plumbing.core)
  (:require [com.stuartsierra.component :as comp]
            [lens.server :refer [new-server]]
            [lens.broker :refer [new-broker]]
            [lens.util :as u]
            [lens.import-clinical-data]))

(defnk new-system [lens-sds-batch-version port broker-host]
  (comp/system-map
    :version lens-sds-batch-version
    :port (u/parse-long port)
    :thread 1

    :broker
    (new-broker {:host broker-host :num-batch-threads 1})

    :server
    (comp/using (new-server) [:port :thread :broker])))

(ns lens.system
  (:use plumbing.core)
  (:require [com.stuartsierra.component :as comp]
            [lens.server :refer [new-server]]
            [lens.broker :refer [new-broker]]
            [lens.util :as u]
            [lens.import-clinical-data]))

(defnk new-system [lens-sds-batch-version port broker-host {broker-port "5672"}]
  (comp/system-map
    :version lens-sds-batch-version
    :port (u/parse-long port)
    :thread 1

    :broker
    (new-broker {:host broker-host :port (u/parse-long broker-port)
                 :num-batch-threads 1})

    :server
    (comp/using (new-server) [:port :thread :broker])))

Add Broker Port Config

Add Broker Port Config


(defproject nightweb-android/Nightweb "0.0.21"
  :license {:name "Public Domain"
            :url "http://unlicense.org/UNLICENSE"}
  :min-lein-version "2.0.0"

  :warn-on-reflection true

  :source-paths ["src/clojure" "../common/clojure"]
  :java-source-paths ["src/java" "../common/java" "gen"]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]

  :dependencies [[com.h2database/h2 "1.3.173"]
                 [neko/neko "3.0.0-preview1"]
                 [markdown-clj "0.9.31"]
                 [org.clojure-android/clojure "1.5.1-jb" :use-resources true]]
  :profiles {:dev {:dependencies [[android/tools.nrepl "0.2.0-bigstack"]]
                   :android {:aot :all-with-unused}}
             :release {:android {:aot :all}}}

  :android {:support-libraries ["v13"]
            :target-version "15"
            :aot-exclude-ns ["clojure.parallel" "clojure.core.reducers"]
            :dex-opts ["-JXmx4096M" "--no-optimize"]})

(defproject nightweb-android/Nightweb "0.0.21"
  :license {:name "Public Domain"
            :url "http://unlicense.org/UNLICENSE"}
  :min-lein-version "2.0.0"

  :warn-on-reflection true

  :source-paths ["src/clojure" "../common/clojure"]
  :java-source-paths ["src/java" "../common/java" "gen"]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]

  :dependencies [[com.h2database/h2 "1.3.173"]
                 [neko/neko "3.0.0-preview1"]
                 [markdown-clj "0.9.31"]
                 [org.clojure-android/clojure "1.5.1-jb" :use-resources true]]
  :profiles {:dev {:dependencies [[android/tools.nrepl "0.2.0-bigstack"]]
                   :android {:aot :all-with-unused}}
             :release {:android
                       {;; Specify the path to your private
                        ;; keystore and the the alias of the
                        ;; key you want to sign APKs with.
                        ;; :keystore-path "/home/user/.android/private.keystore"
                        ;; :key-alias "mykeyalias"
                        :aot :all}}}

  :android {:support-libraries ["v13"]
            :target-version "15"
            :aot-exclude-ns ["clojure.parallel" "clojure.core.reducers"]
            :dex-opts ["-JXmx4096M" "--no-optimize"]})

Add comments back

Add comments back


(ns onyx.schema
  (:require [schema.core :as s]))

(def NamespacedKeyword
  (s/pred (fn [kw]
                 (and (keyword? kw)
                      (namespace kw)))
               'keyword-namespaced?))

(def Function
  (s/pred fn? 'fn?))

(def TaskName
  (s/pred (fn [v]
                 (and (not= :all v)
                      (not= :none v)
                      (keyword? v)))
               'task-name?))

(defn ^{:private true} edge-two-nodes? [edge]
  (= (count edge) 2))

(def ^{:private true} edge-validator
  (s/->Both [(s/pred vector? 'vector?)
                  (s/pred edge-two-nodes? 'edge-two-nodes?)
                  [TaskName]]))

(def Workflow
  (s/->Both [(s/pred vector? 'vector?)
                  [edge-validator]]))

(def Language
  (s/enum :java :clojure))

(def ^{:private true} base-task-map
  {:onyx/name TaskName
   :onyx/type (s/enum :input :output :function)
   :onyx/batch-size (s/pred pos? 'pos?)
   (s/optional-key :onyx/restart-pred-fn) s/Keyword
   (s/optional-key :onyx/language) Language
   (s/optional-key :onyx/batch-timeout) (s/pred pos? 'pos?)
   (s/optional-key :onyx/doc) s/Str
   (s/optional-key :onyx/max-peers) (s/pred pos? 'pos?)
   s/Keyword s/Any})

(def FluxPolicy
  (s/enum :continue :kill :recover))

(def ^{:private true} partial-grouping-task
  {(s/optional-key :onyx/group-by-key) s/Any
   (s/optional-key :onyx/group-by-fn) NamespacedKeyword
   :onyx/min-peers s/Int
   :onyx/flux-policy FluxPolicy})

(defn grouping-task? [task-map]
  (and (#{:function :output} (:onyx/type task-map))
       (or (not (nil? (:onyx/group-by-key task-map)))
           (not (nil? (:onyx/group-by-fn task-map))))))

(def ^{:private true} partial-input-output-task
  {:onyx/plugin NamespacedKeyword
   :onyx/medium s/Keyword
   (s/optional-key :onyx/fn) NamespacedKeyword})

(def ^{:private true} partial-fn-task
  {:onyx/fn NamespacedKeyword})

(def TaskMap
  (s/conditional #(or (= (:onyx/type %) :input) (= (:onyx/type %) :output))
                      (merge base-task-map partial-input-output-task)
                      grouping-task?
                      (merge base-task-map partial-fn-task partial-grouping-task)
                      #(= (:onyx/type %) :function)
                      (merge base-task-map partial-fn-task)))

(def Catalog
  [TaskMap])

(def Lifecycle
  {:lifecycle/task s/Keyword
   :lifecycle/calls NamespacedKeyword
   (s/optional-key :lifecycle/doc) s/Str
   s/Any s/Any})

(def LifecycleCall
  {(s/optional-key :lifecycle/doc) s/Str
   (s/optional-key :lifecycle/start-task?) Function
   (s/optional-key :lifecycle/before-task-start) Function
   (s/optional-key :lifecycle/before-batch) Function
   (s/optional-key :lifecycle/after-batch) Function
   (s/optional-key :lifecycle/after-task-stop) Function
   (s/optional-key :lifecycle/after-ack-segment) Function
   (s/optional-key :lifecycle/after-retry-segment) Function})

(def FlowCondition
  {:flow/from s/Keyword
   :flow/to (s/either s/Keyword [s/Keyword])
   (s/optional-key :flow/short-circuit?) s/Bool
   (s/optional-key :flow/exclude-keys) [s/Keyword]
   (s/optional-key :flow/doc) s/Str
   (s/optional-key :flow/params) [s/Keyword]
   :flow/predicate (s/either s/Keyword [s/Any])
   s/Keyword s/Any})

(defn valid-units [[a b :as x]]
  (and (= 2 (count x))
       (s/validate s/Int a)
       (s/validate s/Keyword b)))

(def Window
  {:window/id s/Keyword
   :window/task s/Keyword
   :window/type (s/pred #(some #{%} #{:fixed :sliding}) 'window-type)
   :window/window-key s/Any
   :window/aggregation s/Keyword
   :window/range (s/pred valid-units 'valid-units)
   (s/optional-key :window/slide) (s/pred valid-units 'valid-units)
   (s/optional-key :window/doc) s/Str
   s/Keyword s/Any})

(def Trigger
  {:trigger/window-id s/Keyword
   :trigger/refinement (s/pred #(some #{%} #{:accumulating :discarding}) 'refinement-type)
   :trigger/on s/Keyword
   :trigger/sync s/Keyword
   (s/optional-key :trigger/fire-all-extents?) s/Bool
   (s/optional-key :trigger/doc) s/Str
   s/Keyword s/Any})

(def Job
  {:catalog Catalog
   :workflow Workflow
   :task-scheduler s/Keyword
   (s/optional-key :percentage) s/Int
   (s/optional-key :flow-conditions) [FlowCondition]
   (s/optional-key :windows) [Window]
   (s/optional-key :triggers) [Trigger]
   (s/optional-key :lifecycles) [Lifecycle]
   (s/optional-key :acker/percentage) s/Int
   (s/optional-key :acker/exempt-input-tasks?) s/Bool
   (s/optional-key :acker/exempt-output-tasks?) s/Bool
   (s/optional-key :acker/exempt-tasks) [s/Keyword]})

(def ClusterId
  (s/either s/Uuid s/Str))

(def EnvConfig
  {:zookeeper/address s/Str
   :onyx/id ClusterId
   (s/optional-key :zookeeper/server?) s/Bool
   (s/optional-key :zookeeper.server/port) s/Int
   s/Keyword s/Any})

(def ^{:private true} PortRange
  [(s/one s/Int "port-range-start")
   (s/one s/Int "port-range-end")])

(def AeronIdleStrategy
  (s/enum :busy-spin :low-restart-latency :high-restart-latency))

(def JobScheduler
  s/Keyword)

(def Messaging
  (s/enum :aeron :dummy-messenger))

(def PeerConfig
  {:zookeeper/address s/Str
   :onyx/id ClusterId
   :onyx.peer/job-scheduler JobScheduler
   :onyx.messaging/impl Messaging
   :onyx.messaging/bind-addr s/Str
   (s/optional-key :onyx.messaging/peer-port-range) PortRange
   (s/optional-key :onyx.messaging/peer-ports) [s/Int]
   (s/optional-key :onyx.messaging/external-addr) s/Str
   (s/optional-key :onyx.peer/inbox-capacity) s/Int
   (s/optional-key :onyx.peer/outbox-capacity) s/Int
   (s/optional-key :onyx.peer/retry-start-interval) s/Int
   (s/optional-key :onyx.peer/join-failure-back-off) s/Int
   (s/optional-key :onyx.peer/drained-back-off) s/Int
   (s/optional-key :onyx.peer/peer-not-ready-back-off) s/Int
   (s/optional-key :onyx.peer/job-not-ready-back-off) s/Int
   (s/optional-key :onyx.peer/fn-params) s/Any
   (s/optional-key :onyx.peer/backpressure-check-interval) s/Int
   (s/optional-key :onyx.peer/backpressure-low-water-pct) s/Int
   (s/optional-key :onyx.peer/backpressure-high-water-pct) s/Int
   (s/optional-key :onyx.zookeeper/backoff-base-sleep-time-ms) s/Int
   (s/optional-key :onyx.zookeeper/backoff-max-sleep-time-ms) s/Int
   (s/optional-key :onyx.zookeeper/backoff-max-retries) s/Int
   (s/optional-key :onyx.messaging/inbound-buffer-size) s/Int
   (s/optional-key :onyx.messaging/completion-buffer-size) s/Int
   (s/optional-key :onyx.messaging/release-ch-buffer-size) s/Int
   (s/optional-key :onyx.messaging/retry-ch-buffer-size) s/Int
   (s/optional-key :onyx.messaging/peer-link-gc-interval) s/Int
   (s/optional-key :onyx.messaging/peer-link-idle-timeout) s/Int
   (s/optional-key :onyx.messaging/ack-daemon-timeout) s/Int
   (s/optional-key :onyx.messaging/ack-daemon-clear-interval) s/Int
   (s/optional-key :onyx.messaging/decompress-fn) Function
   (s/optional-key :onyx.messaging/compress-fn) Function
   (s/optional-key :onyx.messaging/allow-short-circuit?) s/Bool
   (s/optional-key :onyx.messaging.aeron/embedded-driver?) s/Bool
   (s/optional-key :onyx.messaging.aeron/subscriber-count) s/Int
   (s/optional-key :onyx.messaging.aeron/write-buffer-size) s/Int
   (s/optional-key :onyx.messaging.aeron/poll-idle-strategy) AeronIdleStrategy
   (s/optional-key :onyx.messaging.aeron/offer-idle-strategy) AeronIdleStrategy
   s/Keyword s/Any})

(def PeerId
  (s/either s/Uuid s/Keyword))

(def PeerState
  (s/enum :idle :backpressure :active))

(def PeerSite
  {s/Any s/Any})

(def JobId
  (s/either s/Uuid s/Keyword))

(def TaskId
  (s/either s/Uuid s/Keyword))

(def TaskScheduler
  s/Keyword)

(def Replica
  {:job-scheduler JobScheduler
   :messaging {:onyx.messaging/impl Messaging
               s/Keyword s/Any}
   :peers [PeerId]
   :peer-state {PeerId PeerState}
   :peer-sites {PeerId PeerSite}
   :prepared {PeerId PeerId}
   :accepted {PeerId PeerId}
   :pairs {PeerId PeerId}
   :jobs [JobId]
   :task-schedulers {JobId TaskScheduler}
   :tasks {JobId [TaskId]}
   :allocations {JobId {TaskId [PeerId]}}
   :task-metadata {JobId {TaskId s/Any}}
   :saturation {JobId s/Num}
   :task-saturation {JobId {TaskId s/Num}}
   :flux-policies {JobId {TaskId s/Any}}
   :min-required-peers {JobId {TaskId s/Num}}
   :input-tasks {JobId [TaskId]}
   :output-tasks {JobId [TaskId]}
   :exempt-tasks  {JobId [TaskId]}
   :sealed-outputs {JobId #{TaskId}}
   :ackers {JobId [PeerId]}
   :acker-percentage {JobId s/Int}
   :acker-exclude-inputs {TaskId s/Bool}
   :acker-exclude-outputs {TaskId s/Bool}
   :task-percentages {JobId {TaskId s/Num}}
   :percentages {JobId s/Num}
   :completed-jobs [JobId]
   :killed-jobs [JobId]
   :task-slot-ids {JobId {TaskId {PeerId s/Int}}}
   :exhausted-inputs {JobId #{TaskId}}})

(def LogEntry
  {:fn s/Keyword
   :args {s/Any s/Any}
   (s/optional-key :immediate?) s/Bool
   (s/optional-key :message-id) s/Int
   (s/optional-key :created-at) s/Int})

(def Reactions
  (s/maybe [LogEntry]))

(def ReplicaDiff
  (s/maybe (s/either {s/Any s/Any} #{s/Any})))

(def State
  {s/Any s/Any})

(ns onyx.schema
  (:require [schema.core :as s]))

(def NamespacedKeyword
  (s/pred (fn [kw]
                 (and (keyword? kw)
                      (namespace kw)))
               'keyword-namespaced?))

(def Function
  (s/pred fn? 'fn?))

(def TaskName
  (s/pred (fn [v]
                 (and (not= :all v)
                      (not= :none v)
                      (keyword? v)))
               'task-name?))

(defn ^{:private true} edge-two-nodes? [edge]
  (= (count edge) 2))

(def ^{:private true} edge-validator
  (s/->Both [(s/pred vector? 'vector?)
                  (s/pred edge-two-nodes? 'edge-two-nodes?)
                  [TaskName]]))

(def Workflow
  (s/->Both [(s/pred vector? 'vector?)
                  [edge-validator]]))

(def Language
  (s/enum :java :clojure))

(def ^{:private true} base-task-map
  {:onyx/name TaskName
   :onyx/type (s/enum :input :output :function)
   :onyx/batch-size (s/pred pos? 'pos?)
   (s/optional-key :onyx/restart-pred-fn) s/Keyword
   (s/optional-key :onyx/language) Language
   (s/optional-key :onyx/batch-timeout) (s/pred pos? 'pos?)
   (s/optional-key :onyx/doc) s/Str
   (s/optional-key :onyx/max-peers) (s/pred pos? 'pos?)
   s/Keyword s/Any})

(def FluxPolicy
  (s/enum :continue :kill :recover))

(def ^{:private true} partial-grouping-task
  {(s/optional-key :onyx/group-by-key) s/Any
   (s/optional-key :onyx/group-by-fn) NamespacedKeyword
   :onyx/min-peers s/Int
   :onyx/flux-policy FluxPolicy})

(defn grouping-task? [task-map]
  (and (#{:function :output} (:onyx/type task-map))
       (or (not (nil? (:onyx/group-by-key task-map)))
           (not (nil? (:onyx/group-by-fn task-map))))))

(def ^{:private true} partial-input-output-task
  {:onyx/plugin NamespacedKeyword
   :onyx/medium s/Keyword
   (s/optional-key :onyx/fn) NamespacedKeyword})

(def ^{:private true} partial-fn-task
  {:onyx/fn NamespacedKeyword})

(def TaskMap
  (s/conditional #(or (= (:onyx/type %) :input) (= (:onyx/type %) :output))
                      (merge base-task-map partial-input-output-task)
                      grouping-task?
                      (merge base-task-map partial-fn-task partial-grouping-task)
                      #(= (:onyx/type %) :function)
                      (merge base-task-map partial-fn-task)))

(def Catalog
  [TaskMap])

(def Lifecycle
  {:lifecycle/task s/Keyword
   :lifecycle/calls NamespacedKeyword
   (s/optional-key :lifecycle/doc) s/Str
   s/Any s/Any})

(def LifecycleCall
  {(s/optional-key :lifecycle/doc) s/Str
   (s/optional-key :lifecycle/start-task?) Function
   (s/optional-key :lifecycle/before-task-start) Function
   (s/optional-key :lifecycle/before-batch) Function
   (s/optional-key :lifecycle/after-batch) Function
   (s/optional-key :lifecycle/after-task-stop) Function
   (s/optional-key :lifecycle/after-ack-segment) Function
   (s/optional-key :lifecycle/after-retry-segment) Function})

(def FlowCondition
  {:flow/from s/Keyword
   :flow/to (s/either s/Keyword [s/Keyword])
   (s/optional-key :flow/short-circuit?) s/Bool
   (s/optional-key :flow/exclude-keys) [s/Keyword]
   (s/optional-key :flow/doc) s/Str
   (s/optional-key :flow/params) [s/Keyword]
   :flow/predicate (s/either s/Keyword [s/Any])
   s/Keyword s/Any})

(def Unit
  [(s/one s/Int "number")
   (s/one s/Keyword "unit-type")])

(def WindowType
  (s/enum :fixed :sliding))

(def Window
  {:window/id s/Keyword
   :window/task s/Keyword
   :window/type WindowType
   :window/window-key s/Any
   :window/aggregation s/Keyword
   :window/range Unit
   (s/optional-key :window/slide) Unit
   (s/optional-key :window/doc) s/Str
   s/Keyword s/Any})

(def TriggerRefinement
  (s/enum :accumulating :discarding))

(def Trigger
  {:trigger/window-id s/Keyword
   :trigger/refinement TriggerRefinement
   :trigger/on s/Keyword
   :trigger/sync s/Keyword
   (s/optional-key :trigger/fire-all-extents?) s/Bool
   (s/optional-key :trigger/doc) s/Str
   s/Keyword s/Any})

(def Job
  {:catalog Catalog
   :workflow Workflow
   :task-scheduler s/Keyword
   (s/optional-key :percentage) s/Int
   (s/optional-key :flow-conditions) [FlowCondition]
   (s/optional-key :windows) [Window]
   (s/optional-key :triggers) [Trigger]
   (s/optional-key :lifecycles) [Lifecycle]
   (s/optional-key :acker/percentage) s/Int
   (s/optional-key :acker/exempt-input-tasks?) s/Bool
   (s/optional-key :acker/exempt-output-tasks?) s/Bool
   (s/optional-key :acker/exempt-tasks) [s/Keyword]})

(def ClusterId
  (s/either s/Uuid s/Str))

(def EnvConfig
  {:zookeeper/address s/Str
   :onyx/id ClusterId
   (s/optional-key :zookeeper/server?) s/Bool
   (s/optional-key :zookeeper.server/port) s/Int
   s/Keyword s/Any})

(def ^{:private true} PortRange
  [(s/one s/Int "port-range-start")
   (s/one s/Int "port-range-end")])

(def AeronIdleStrategy
  (s/enum :busy-spin :low-restart-latency :high-restart-latency))

(def JobScheduler
  s/Keyword)

(def Messaging
  (s/enum :aeron :dummy-messenger))

(def PeerConfig
  {:zookeeper/address s/Str
   :onyx/id ClusterId
   :onyx.peer/job-scheduler JobScheduler
   :onyx.messaging/impl Messaging
   :onyx.messaging/bind-addr s/Str
   (s/optional-key :onyx.messaging/peer-port-range) PortRange
   (s/optional-key :onyx.messaging/peer-ports) [s/Int]
   (s/optional-key :onyx.messaging/external-addr) s/Str
   (s/optional-key :onyx.peer/inbox-capacity) s/Int
   (s/optional-key :onyx.peer/outbox-capacity) s/Int
   (s/optional-key :onyx.peer/retry-start-interval) s/Int
   (s/optional-key :onyx.peer/join-failure-back-off) s/Int
   (s/optional-key :onyx.peer/drained-back-off) s/Int
   (s/optional-key :onyx.peer/peer-not-ready-back-off) s/Int
   (s/optional-key :onyx.peer/job-not-ready-back-off) s/Int
   (s/optional-key :onyx.peer/fn-params) s/Any
   (s/optional-key :onyx.peer/backpressure-check-interval) s/Int
   (s/optional-key :onyx.peer/backpressure-low-water-pct) s/Int
   (s/optional-key :onyx.peer/backpressure-high-water-pct) s/Int
   (s/optional-key :onyx.zookeeper/backoff-base-sleep-time-ms) s/Int
   (s/optional-key :onyx.zookeeper/backoff-max-sleep-time-ms) s/Int
   (s/optional-key :onyx.zookeeper/backoff-max-retries) s/Int
   (s/optional-key :onyx.messaging/inbound-buffer-size) s/Int
   (s/optional-key :onyx.messaging/completion-buffer-size) s/Int
   (s/optional-key :onyx.messaging/release-ch-buffer-size) s/Int
   (s/optional-key :onyx.messaging/retry-ch-buffer-size) s/Int
   (s/optional-key :onyx.messaging/peer-link-gc-interval) s/Int
   (s/optional-key :onyx.messaging/peer-link-idle-timeout) s/Int
   (s/optional-key :onyx.messaging/ack-daemon-timeout) s/Int
   (s/optional-key :onyx.messaging/ack-daemon-clear-interval) s/Int
   (s/optional-key :onyx.messaging/decompress-fn) Function
   (s/optional-key :onyx.messaging/compress-fn) Function
   (s/optional-key :onyx.messaging/allow-short-circuit?) s/Bool
   (s/optional-key :onyx.messaging.aeron/embedded-driver?) s/Bool
   (s/optional-key :onyx.messaging.aeron/subscriber-count) s/Int
   (s/optional-key :onyx.messaging.aeron/write-buffer-size) s/Int
   (s/optional-key :onyx.messaging.aeron/poll-idle-strategy) AeronIdleStrategy
   (s/optional-key :onyx.messaging.aeron/offer-idle-strategy) AeronIdleStrategy
   s/Keyword s/Any})

(def PeerId
  (s/either s/Uuid s/Keyword))

(def PeerState
  (s/enum :idle :backpressure :active))

(def PeerSite
  {s/Any s/Any})

(def JobId
  (s/either s/Uuid s/Keyword))

(def TaskId
  (s/either s/Uuid s/Keyword))

(def TaskScheduler
  s/Keyword)

(def Replica
  {:job-scheduler JobScheduler
   :messaging {:onyx.messaging/impl Messaging
               s/Keyword s/Any}
   :peers [PeerId]
   :peer-state {PeerId PeerState}
   :peer-sites {PeerId PeerSite}
   :prepared {PeerId PeerId}
   :accepted {PeerId PeerId}
   :pairs {PeerId PeerId}
   :jobs [JobId]
   :task-schedulers {JobId TaskScheduler}
   :tasks {JobId [TaskId]}
   :allocations {JobId {TaskId [PeerId]}}
   :task-metadata {JobId {TaskId s/Any}}
   :saturation {JobId s/Num}
   :task-saturation {JobId {TaskId s/Num}}
   :flux-policies {JobId {TaskId s/Any}}
   :min-required-peers {JobId {TaskId s/Num}}
   :input-tasks {JobId [TaskId]}
   :output-tasks {JobId [TaskId]}
   :exempt-tasks  {JobId [TaskId]}
   :sealed-outputs {JobId #{TaskId}}
   :ackers {JobId [PeerId]}
   :acker-percentage {JobId s/Int}
   :acker-exclude-inputs {TaskId s/Bool}
   :acker-exclude-outputs {TaskId s/Bool}
   :task-percentages {JobId {TaskId s/Num}}
   :percentages {JobId s/Num}
   :completed-jobs [JobId]
   :killed-jobs [JobId]
   :task-slot-ids {JobId {TaskId {PeerId s/Int}}}
   :exhausted-inputs {JobId #{TaskId}}})

(def LogEntry
  {:fn s/Keyword
   :args {s/Any s/Any}
   (s/optional-key :immediate?) s/Bool
   (s/optional-key :message-id) s/Int
   (s/optional-key :created-at) s/Int})

(def Reactions
  (s/maybe [LogEntry]))

(def ReplicaDiff
  (s/maybe (s/either {s/Any s/Any} #{s/Any})))

(def State
  {s/Any s/Any})

schema: use one and enum so users are given info


;; Copyright 2015 Andrey Antukh <niwi@niwi.be>
;;
;; 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.

(ns bytebuf.core-tests
  (:require [clojure.test :refer :all]
            [bytebuf.core :as buf])
  (:import java.nio.ByteBuffer
           io.netty.buffer.ByteBuf))

(deftest allocate
  (testing "Allocate heap nio buffer"
    (let [buffer (buf/allocate 16)]
      (is (not (.isDirect buffer)))
      (is (instance? ByteBuffer buffer))))

  (testing "Allocate direct nio buffer"
    (let [buffer (buf/allocate 16 {:type :direct})]
      (is (.isDirect buffer))
      (is (instance? ByteBuffer buffer))))

  (testing "Allocate heap netty buffer"
    (let [buffer (buf/allocate 16 {:type :heap :impl :netty})]
      (is (not (.isDirect buffer)))
      (is (instance? ByteBuf buffer))))

  (testing "Allocate direct netty buffer"
    (let [buffer (buf/allocate 16 {:type :direct :impl :netty})]
      (is (.isDirect buffer))
      (is (instance? ByteBuf buffer))))
)

(deftest spec-constructor
  (testing "creating spec"
    (let [spec (buf/spec :field1 (buf/int32)
                         :field2 (buf/int64))]
      (is (= (count spec) 2))
      (is (= (buf/size spec) 12))))
)

(deftest associative-static-specs
  (testing "write data"
    (let [spec (buf/spec :field1 (buf/int32)
                         :field2 (buf/int64))
          buffer (buf/allocate 12)
          data {:field1 1 :field2 4}]
      (is (= (buf/write! buffer data spec) 12))
      (is (= (.getInt buffer 0) 1))
      (is (= (.getLong buffer 4) 4))))

  (testing "write data with offset"
    (let [spec (buf/spec :field1 (buf/int32))
          buffer (buf/allocate 12)
          data {:field1 500}]
      (is (= (buf/write! buffer data spec {:offset 3}) 4))
      (is (= (.getInt buffer 3) 500))))

  (testing "write data to wrong buffer (less space)"
    (let [spec (buf/spec :field1 (buf/int32))
          buffer (buf/allocate 2)
          data {:field1 1}]
      (is (thrown? java.lang.IndexOutOfBoundsException
                   (buf/write! buffer data spec) 12))))

  (testing "read data"
    (let [spec (buf/spec :field1 (buf/int32)
                         :field2 (buf/int64))
          buffer (buf/allocate 12)]
      (.putInt buffer 0 10)
      (.putLong buffer 4 100)
      (let [[readed data] (buf/read* buffer spec)]
        (is (= readed 12))
        (is (= data {:field2 100 :field1 10})))))

  (testing "read data with offset"
    (let [spec (buf/spec :field1 (buf/int32))
          buffer (buf/allocate 12)]
      (.putInt buffer 8 1000)
      (let [[readed data] (buf/read* buffer spec {:offset 8})]
        (is (= readed 4))
        (is (= data {:field1 1000})))))
)

;; Copyright 2015 Andrey Antukh <niwi@niwi.be>
;;
;; 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.

(ns bytebuf.core-tests
  (:require [clojure.test :refer :all]
            [bytebuf.core :as buf])
  (:import java.nio.ByteBuffer
           io.netty.buffer.ByteBuf))

(deftest allocate
  (testing "Allocate heap nio buffer"
    (let [buffer (buf/allocate 16)]
      (is (not (.isDirect buffer)))
      (is (instance? ByteBuffer buffer))))

  (testing "Allocate direct nio buffer"
    (let [buffer (buf/allocate 16 {:type :direct})]
      (is (.isDirect buffer))
      (is (instance? ByteBuffer buffer))))

  (testing "Allocate heap netty buffer"
    (let [buffer (buf/allocate 16 {:type :heap :impl :netty})]
      (is (not (.isDirect buffer)))
      (is (instance? ByteBuf buffer))))

  (testing "Allocate direct netty buffer"
    (let [buffer (buf/allocate 16 {:type :direct :impl :netty})]
      (is (.isDirect buffer))
      (is (instance? ByteBuf buffer))))
)

(deftest spec-constructor
  (testing "creating spec"
    (let [spec (buf/spec :field1 (buf/int32)
                         :field2 (buf/int64))]
      (is (= (count spec) 2))
      (is (= (buf/size spec) 12))))
)

(deftest associative-specs
  (testing "write data"
    (let [spec (buf/spec :field1 (buf/int32)
                         :field2 (buf/int64))
          buffer (buf/allocate 12)
          data {:field1 1 :field2 4}]
      (is (= (buf/write! buffer data spec) 12))
      (is (= (.getInt buffer 0) 1))
      (is (= (.getLong buffer 4) 4))))

  (testing "write data with offset"
    (let [spec (buf/spec :field1 (buf/int32))
          buffer (buf/allocate 12)
          data {:field1 500}]
      (is (= (buf/write! buffer data spec {:offset 3}) 4))
      (is (= (.getInt buffer 3) 500))))

  (testing "write data to wrong buffer (less space)"
    (let [spec (buf/spec :field1 (buf/int32))
          buffer (buf/allocate 2)
          data {:field1 1}]
      (is (thrown? java.lang.IndexOutOfBoundsException
                   (buf/write! buffer data spec) 12))))

  (testing "read data"
    (let [spec (buf/spec :field1 (buf/int32)
                         :field2 (buf/int64))
          buffer (buf/allocate 12)]
      (.putInt buffer 0 10)
      (.putLong buffer 4 100)
      (let [[readed data] (buf/read* buffer spec)]
        (is (= readed 12))
        (is (= data {:field2 100 :field1 10})))))

  (testing "read data with offset"
    (let [spec (buf/spec :field1 (buf/int32))
          buffer (buf/allocate 12)]
      (.putInt buffer 8 1000)
      (let [[readed data] (buf/read* buffer spec {:offset 8})]
        (is (= readed 4))
        (is (= data {:field1 1000})))))
  )

(deftest indexed-specs
  (testing "write data"
    (let [spec (buf/spec (buf/int32) (buf/int64))
          buffer (buf/allocate 12)
          data [1 4]]
      (is (= (buf/write! buffer data spec) 12))
      (is (= (.getInt buffer 0) 1))
      (is (= (.getLong buffer 4) 4))))

  (testing "write data with offset"
    (let [spec (buf/spec (buf/int32))
          buffer (buf/allocate 12)
          data [500]]
      (is (= (buf/write! buffer data spec {:offset 3}) 4))
      (is (= (.getInt buffer 3) 500))))

  (testing "write data to wrong buffer (less space)"
    (let [spec (buf/spec (buf/int32))
          buffer (buf/allocate 2)
          data [1]]
      (is (thrown? java.lang.IndexOutOfBoundsException
                   (buf/write! buffer data spec) 12))))

  (testing "read data"
    (let [spec (buf/spec (buf/int32) (buf/int64))
          buffer (buf/allocate 12)]
      (.putInt buffer 0 10)
      (.putLong buffer 4 100)
      (let [[readed data] (buf/read* buffer spec)]
        (is (= readed 12))
        (is (= data [10 100])))))

  (testing "read data with offset"
    (let [spec (buf/spec (buf/int32))
          buffer (buf/allocate 12)]
      (.putInt buffer 8 1000)
      (let [[readed data] (buf/read* buffer spec {:offset 8})]
        (is (= readed 4))
        (is (= data [1000])))))
  )

(deftest spec-data-types
  (testing "Read/Write static string"
    (let [spec (buf/spec (buf/string 5))
          buffer (buf/allocate 20)]
      (buf/write! buffer ["1234567890"] spec)
      (let [[readed data] (buf/read* buffer spec)]
        (is (= readed 5))
        (is (= data ["12345"])))))
)

;; (deftest experiments

;; )

Add tests for indexed specs.

Add tests for indexed specs.


(ns metabase.task-test
  (:require [expectations :refer :all]
            (metabase [task :refer :all]
                      [test-setup :refer :all]))
  (:import java.util.Calendar))

(defhook task-test-hook "Hook for test purposes.")

(def task-test-atom-counter
  (atom 0))

(defn- inc-task-test-atom-counter []
  (swap! task-test-atom-counter inc))

(defn- inc-task-test-atom-counter-twice []
  (swap! task-test-atom-counter (partial + 2)))

;; ## HOOK TESTS

(expect
    [0  ; (1)
     1  ; (2)
     3  ; (3)
     6  ; (4)
     9] ; (5)
  [;; (1) get initial value
   (do (reset! task-test-atom-counter 0)   ; reset back to 0
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (2) now add a hook function. Should increment the counter once
   (do (add-hook! #'task-test-hook inc-task-test-atom-counter)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (3) ok, run the hook twice. Should increment counter twice
   (do (run-hook #'task-test-hook)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (4) add another hook function that increments counter twice on each call (for a total of + 3)
   (do (add-hook! #'task-test-hook inc-task-test-atom-counter-twice)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (5) check that we can't add duplicate hooks - should still be just +3
   (do (add-hook! #'task-test-hook inc-task-test-atom-counter-twice)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)])

;; ## TASK RUNNER TESTS

(defn- system-hour []
  (.get (Calendar/getInstance) Calendar/HOUR))

(defn- inc-task-test-atom-counter-by-system-hour [hour]
  (swap! task-test-atom-counter (partial + (system-hour))))

(defhook mock-hourly-tasks-hook
  "Hook that will replace the actual hourly-tasks-hook in our unit test.")

(expect [[0
          (system-hour)       ; we can also check that the `hourly-tasks-hook` is passing the correct param to its functions
          (* 3 (system-hour))
          :stopped]
         :restarted]
  [(do
     (stop-task-runner!)
     (with-redefs [metabase.task/hourly-task-delay (constantly 50)
                   metabase.task/hourly-tasks-hook mock-hourly-tasks-hook]
       (add-hook! #'hourly-tasks-hook inc-task-test-atom-counter-by-system-hour)
       (reset! task-test-atom-counter 0)
       (start-task-runner!)

       [@task-test-atom-counter      ; should be 0, since not enough time has elaspsed for the hook to be executed
        (do (Thread/sleep 75)
            @task-test-atom-counter) ; should have been called once (~25ms ago)
        (do (Thread/sleep 100)
            @task-test-atom-counter) ; should have been called two more times
        (do (stop-task-runner!)
            :stopped)]))
   (do (start-task-runner!)
       :restarted)])

(ns metabase.task-test
  (:require [expectations :refer :all]
            (metabase [task :refer :all]
                      [test-setup :refer :all]))
  (:import java.util.Calendar))

(defhook task-test-hook "Hook for test purposes.")

(def task-test-atom-counter
  (atom 0))

(defn- inc-task-test-atom-counter []
  (swap! task-test-atom-counter inc))

(defn- inc-task-test-atom-counter-twice []
  (swap! task-test-atom-counter (partial + 2)))

;; ## HOOK TESTS

(expect
    [0  ; (1)
     1  ; (2)
     3  ; (3)
     6  ; (4)
     9] ; (5)
  [;; (1) get initial value
   (do (reset! task-test-atom-counter 0)   ; reset back to 0
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (2) now add a hook function. Should increment the counter once
   (do (add-hook! #'task-test-hook inc-task-test-atom-counter)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (3) ok, run the hook twice. Should increment counter twice
   (do (run-hook #'task-test-hook)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (4) add another hook function that increments counter twice on each call (for a total of + 3)
   (do (add-hook! #'task-test-hook inc-task-test-atom-counter-twice)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)

   ;; (5) check that we can't add duplicate hooks - should still be just +3
   (do (add-hook! #'task-test-hook inc-task-test-atom-counter-twice)
       (run-hook #'task-test-hook)
       @task-test-atom-counter)])

;; ## TASK RUNNER TESTS

(defn- system-hour []
  (.get (Calendar/getInstance) Calendar/HOUR))

(defn- inc-task-test-atom-counter-by-system-hour [hour]
  (swap! task-test-atom-counter (partial + (system-hour))))

(defhook mock-hourly-tasks-hook
  "Hook that will replace the actual hourly-tasks-hook in our unit test.")

(expect [[0
          (system-hour)       ; we can also check that the `hourly-tasks-hook` is passing the correct param to its functions
          (* 3 (system-hour))
          :stopped]
         :restarted]
  [(do
     (stop-task-runner!)
     (with-redefs [metabase.task/hourly-task-delay (constantly 100)
                   metabase.task/hourly-tasks-hook mock-hourly-tasks-hook]
       (add-hook! #'hourly-tasks-hook inc-task-test-atom-counter-by-system-hour)
       (reset! task-test-atom-counter 0)
       (start-task-runner!)

       [@task-test-atom-counter      ; should be 0, since not enough time has elaspsed for the hook to be executed
        (do (Thread/sleep 150)
            @task-test-atom-counter) ; should have been called once (~50ms ago)
        (do (Thread/sleep 200)
            @task-test-atom-counter) ; should have been called two more times
        (do (stop-task-runner!)
            :stopped)]))
   (do (start-task-runner!)
       :restarted)])

fix occasional test failures, again :sob:


;; Copyright (C) 2013 Anders Sundman <anders@4zm.org>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

(ns spira.core.system
  (:require [spira.dm.garden :as garden]
            [spira.dm.plant-desc :as plant-desc]
            [spira.dm.in-memory-repo :as mem-repo]))

;; A representation of the applications total top level state.
(defrecord SystemState [garden-repo plant-desc-repo])

(defn dev-system []
  "Create a light weight development state"
  (->SystemState
   (mem-repo/memory-garden-repo)
   (mem-repo/memory-plant-description-repo)))

;; Copyright (C) 2013 Anders Sundman <anders@4zm.org>
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

(ns spira.core.system
  (:require [spira.dm.garden :as garden]
            [spira.dm.plant-desc :as plant-desc]
            [spira.dm.in-memory-repo :as mem-repo]
            [spira.datomic-adapter.repo :as da]))

;; A representation of the applications total top level state.
(defrecord SystemState [garden-repo plant-desc-repo])

(defn mem-dev-system []
  "Create a light weight development state"
  (->SystemState
   (mem-repo/memory-garden-repo)
   (mem-repo/memory-plant-description-repo)))

(defn dev-system []
  "Create a light weight development state"
  (let [uri da/test-uri]
    (da/create-test-db uri)
    (->SystemState
     (da/datomic-garden-repo uri)
     (da/datomic-plant-description-repo uri))))

Use in memory datomic db by default

Use in memory datomic db by default


(ns braid.ui.styles.thread
  (:require [braid.ui.styles.vars :as vars]
            [garden.arithmetic :as m]
            [braid.ui.styles.mixins :as mixins]
            [garden.units :refer [px em rem]]))

(defn thread [pad]
  [:.thread
   mixins/flex
   {:margin-right pad

    :min-width vars/card-width
    :width vars/card-width
    :box-sizing "border-box"

    :flex-direction "column"
    :height "100%"
    :z-index 101}

   [:&.new
    {:z-index 99}]
   [:&:before ; switch to :after to align at top
    {:content "\"\""
     :flex-grow 1}]

   [:.card
    mixins/flex
    {:flex-direction "column"
     :box-shadow [[0 (px 1) (px 2) 0 "#ccc"]]
     :transition [["box-shadow" "0.2s"]]
     :max-height "100%"
     :background "white"
     :border-radius vars/border-radius}]])

(defn notice [pad]
  [:.thread

   [:.notice
    {:box-shadow [[0 (px 1) (px 2) 0 "#ccc"]]
     :padding pad
     :margin-bottom pad}

    [:&:before
     {:float "left"
      :font-size vars/avatar-size
      :margin-right (rem 0.5)
      :content "\"\""}]]

   [:&.private :&.limbo
    [:.card
     {; needs to be a better way
      ; which is based on the height of the notice
      :max-height "85%"}]

    [:.head:before
     {:content "\"\""
      :display "block"
      :width "100%"
      :height (px 5)
      :position "absolute"
      :top 0
      :left 0}]]

   [:&.private
    [:.head:before
     {:background "#5f7997"}]

    [:.notice
     {:background "#D2E7FF"
      :color "#5f7997"}

     [:&:before
      (mixins/fontawesome \uf21b)]]]

   [:&.limbo
    [:.head:before
     {:background "#CA1414"}]

    [:.notice
     {:background "#ffe4e4"
      :color "#CA1414"}

     [:&:before
      (mixins/fontawesome \uf071)]]]])

(defn head [pad]
  [:.thread
   [:.head
    {:min-height "3.5em"
     :position "relative"
     :width "100%"
     :flex-shrink 0
     :padding [[pad (m/* 2 pad) pad pad]]
     :box-sizing "border-box"}

    [:.tags

     [:.add
      mixins/pill-box]

     [:.user :.tag :.add
      {:margin-bottom (em 0.5)
       :margin-right (em 0.5)} ] ]

    [:.close
     {:position "absolute"
      :padding pad
      :top 0
      :right 0
      :z-index 10
      :cursor "pointer"}]]])

(defn messages [pad]
  [:.thread
   [:.messages
    {:position "relative"
     :overflow-y "scroll"
     :padding [[0 pad]]}]])

(defn new-message [pad]
  [:.message.new
   {:flex-shrink 0
    :paddgin-bottom pad
    :padding-left (m/+ pad (rem 2))
    :padding-top pad
    :padding-right pad
    :margin-bottom pad}

    [:textarea
     {:width "100%"
      :resize "none"
      :border "none"
      :box-sizing "border-box"
      :min-height (em 3.5)
      :box-shadow "0 0 1px 1px #ccc"
      :border-radius vars/border-radius
    }

      [:&:focus
       {:outline "none"}]]

    [:.autocomplete
     {:z-index 1000
      :box-shadow [[0 (px 1) (px 4) 0 "#ccc"]]
      :background "white"
      :max-height (em 20)
      :overflow "scroll"
      :width vars/card-width
      ; will be an issue when text area expands:
      :position "absolute"
      :bottom (m/* pad 3)}

      [:.result
       {:padding "0.25em 0.5em"
        :clear "both"}
       [:.emojione :.avatar :.color-block
        {:display "block"
         :width "2em"
         :height "2em"
         :float "left"
         :margin "0.25em 0.5em 0.25em 0"}]

       [:.color-block
        {:width "1em"}]

       [:.name
        {:height "1em"
         :white-space "nowrap"}]

       [:.extra
        {:color "#ccc"
         :overflow-y "hidden"
         :max-height "2.5em"}]

       [:&:hover
        {:background "#eee"}]

       [:&.highlight
        [:.name
         {:font-weight "bold"}]]]]])

(defn drag-and-drop [pad]
  [:.thread :.setting.avatar

   [:&.dragging
    {:background-color "gray"
     :border [[(px 5) "dashed" "black"]]}]

   [:&.focused
    [:.card
     {:box-shadow [[0 (px 10) (px 10) (px 10) "#ccc"]]}]]

   [:.uploading-indicator
    (mixins/fontawesome \uf110)
    mixins/spin
    {:font-size (em 1.5)
     :text-align "center"}]])

Remove new line

Remove new line


(ns airhead-cljs.components
  (:require [reagent.core :as r]
            [airhead-cljs.state :refer [app-state update-state!]]
            [airhead-cljs.requests :as req]))

(defn header []
  (let [cursor  (r/cursor app-state [:info])
        title   (@cursor :name)
        message (@cursor :greet_message)]
    [:header
     [:h1 title]
     [:p message]]))

(defn now-playing []
  (let [track (@app-state :now-playing)]
    [:p#now-playing
     [:span]
     (if track
       (str " " (:artist track) " - " (:title track))
       [:em "Nothing is playing"])]))

(defn player-section []
  (let [cursor  (r/cursor app-state [:info])
        url     (@cursor :stream_url)]
  [:section#player
   [:div
    [:audio {:controls "controls"}
    [:source {:src url}]]
    [:a {:href url}]]
   [now-playing]]))

(defn upload-section []
  [:section#upload
   [:h2 "Upload"]
   [:form {:id "upload-form"}
    [:input {:type "file" :name "track"}]
    [:input {:type "button" :value "Upload" :on-click req/upload!}]]])

(defn playlist-add-button [track]
  [:button.add
   {:on-click #(req/playlist-add! (:uuid track))}])

(defn playlist-remove-button [track]
  [:button.remove
   {:on-click #(req/playlist-remove! (:uuid track))}])

(defn track-tr [track action-button]
  [:tr.track
   [:td
    (when action-button
      [action-button track])]
   [:td (track :title)] [:td (track :artist)] [:td (track :album)]])

(defn tracks-table [tracks action-button]
  [:table.tracks
   [:thead
    [:tr [:th] [:th  "Title"] [:th "Artist"] [:th "Album"]]]
   [:tbody (for [track tracks]
             [track-tr track action-button])]])

(defn playlist-section []
  [:section#playlist
   [:h2 "Playlist"]
   [tracks-table (@app-state :playlist) playlist-remove-button]])

(defn on-query-change [e]
  ;(get-library!)
  (update-state! :query (-> e .-target .-value)))

(defn search-form []
  [:section#search
   [:form
    [:label {:for "query"} "Search:"]
    [:input {:type "text"
             :id "query"
             :value (@app-state :query)
             :on-change on-query-change}]]])

(defn library-section []
  [:section#library
   [:h2 "Library"]
   [search-form]
   [tracks-table (@app-state :library) playlist-add-button]])

(defn page-component []
  [:main
   [header]
   [player-section]
   [upload-section]
   [playlist-section]
   [library-section]])

(ns airhead-cljs.components
  (:require [reagent.core :as r]
            [airhead-cljs.state :refer [app-state update-state!]]
            [airhead-cljs.requests :as req]))

(defn header []
  (let [cursor  (r/cursor app-state [:info])
        title   (@cursor :name)
        message (@cursor :greet_message)]
    [:header
     [:h1 title]
     [:p message]]))

(defn now-playing []
  (let [track (@app-state :now-playing)]
    [:p#now-playing
     (if track
       (str " " (:artist track) " - " (:title track))
       [:em "Nothing is playing"])]))

(defn player-section []
  (let [cursor  (r/cursor app-state [:info])
        url     (@cursor :stream_url)]
    [:section#player
     [:div
      [:audio {:controls "controls"}
       [:source {:src url}]]
      [:a {:href url}]]
     [now-playing]]))

(defn upload-section []
  [:section#upload
   [:h2 "Upload"]
   [:form {:id "upload-form"}
    [:input {:type "file" :name "track"}]
    [:input {:type "button" :value "Upload" :on-click req/upload!}]]])

(defn playlist-add-button [track]
  [:button.add
   {:on-click #(req/playlist-add! (:uuid track))}])

(defn playlist-remove-button [track]
  [:button.remove
   {:on-click #(req/playlist-remove! (:uuid track))}])

(defn track-tr [track action-button]
  [:tr.track
   [:td
    (when action-button
      [action-button track])]
   [:td (track :title)] [:td (track :artist)] [:td (track :album)]])

(defn tracks-table [tracks action-button]
  [:table.tracks
   [:thead
    [:tr [:th] [:th  "Title"] [:th "Artist"] [:th "Album"]]]
   [:tbody (for [track tracks]
             [track-tr track action-button])]])

(defn playlist-section []
  [:section#playlist
   [:h2 "Playlist"]
   [tracks-table (@app-state :playlist) playlist-remove-button]])

(defn on-query-change [e]
  ;(get-library!)
  (update-state! :query (-> e .-target .-value)))

(defn search-form []
  [:section#search
   [:form
    [:label {:for "query"} "Search:"]
    [:input {:type "text"
             :id "query"
             :value (@app-state :query)
             :on-change on-query-change}]]])

(defn library-section []
  [:section#library
   [:h2 "Library"]
   [search-form]
   [tracks-table (@app-state :library) playlist-add-button]])

(defn page-component []
  [:main
   [header]
   [player-section]
   [upload-section]
   [playlist-section]
   [library-section]])

Fix indentation

Fix indentation