(ns cider-ci.utils.http
  (:refer-clojure
    :exclude [get])
  (:require
    [cider-ci.utils.debug :as debug]
    [cider-ci.utils.with :as with]
    [clj-http.client :as http-client]
    [clj-logging-config.log4j :as logging-config]
    [clojure.tools.logging :as logging]
    [ring.middleware.basic-authentication :refer [wrap-basic-authentication]]
    ))

(defonce conf (atom nil))

;### build url ##################################################################

(defn sanitize-query-params [params]
  (into {} (sort (for [[k v] params]
                   [(-> k name clojure.string/trim
                        clojure.string/lower-case
                        (clojure.string/replace " " "-")
                        (clojure.string/replace "_" "-")
                        (clojure.string/replace #"-+" "-")
                        keyword)
                    v]))))

(defn build-url-query-string [params]
  (-> params sanitize-query-params
      http-client/generate-query-string))

(defn build-url

  ([config path]
   (let [ protocol (if (or (:server_ssl config) (:ssl config)) "https" "http")
         host (or (:server_host config) (:host config))
         port (or (:server_port config) (:port config))
         context (:context config) ]
     (str protocol "://" host (when port (str ":" port)) context path)))

  ([config path query-params]
   (str (build-url config path)
        "?" (build-url-query-string query-params))))

;### Http request #############################################################

(defn- request [method url params]
  (logging/debug [method url params])
  (let [basic-auth (:basic_auth @conf)]
    (with/logging
      (logging/debug "http/post" {:url url :basic-auth basic-auth})
      (http-client/request
        (conj {:basic-auth [(:user basic-auth) (:secret basic-auth)]
               :url url
               :method method
               :insecure? true
               :content-type :json
               :accept :json
               :socket-timeout 1000
               :conn-timeout 1000 }
              params)))))

(defn get [url params]
  (logging/debug get [url params])
  (request :get url params))

(defn post [url params]
  (logging/debug post [url params])
  (request :post url params))

(defn put [url params]
  (logging/debug put [url params])
  (request :put url params))

(defn patch [url params]
  (logging/debug patch [url params])
   (request :patch url params))

;### Initialize ###############################################################

(defn initialize [new-conf]
  (reset! conf new-conf))

;### Debug ####################################################################
;(debug/debug-ns *ns*)
;(logging-config/set-logger! :level :debug)
;(logging-config/set-logger! :level :info)

(ns cider-ci.utils.http
  (:refer-clojure
    :exclude [get])
  (:require
    [cider-ci.utils.debug :as debug]
    [cider-ci.utils.with :as with]
    [clj-http.client :as http-client]
    [clj-logging-config.log4j :as logging-config]
    [clojure.tools.logging :as logging]
    ))

(defonce conf (atom nil))

;### build url ##################################################################

(defn sanitize-query-params [params]
  (into {} (sort (for [[k v] params]
                   [(-> k name clojure.string/trim
                        clojure.string/lower-case
                        (clojure.string/replace " " "-")
                        (clojure.string/replace "_" "-")
                        (clojure.string/replace #"-+" "-")
                        keyword)
                    v]))))

(defn build-url-query-string [params]
  (-> params sanitize-query-params
      http-client/generate-query-string))

(defn build-url

  ([config path]
   (let [ protocol (if (or (:server_ssl config) (:ssl config)) "https" "http")
         host (or (:server_host config) (:host config))
         port (or (:server_port config) (:port config))
         context (:context config) ]
     (str protocol "://" host (when port (str ":" port)) context path)))

  ([config path query-params]
   (str (build-url config path)
        "?" (build-url-query-string query-params))))

;### Http request #############################################################

(defn- request [method url params]
  (logging/debug [method url params])
  (let [basic-auth (:basic_auth @conf)]
    (with/logging
      (logging/debug "http/post" {:url url :basic-auth basic-auth})
      (http-client/request
        (conj {:basic-auth [(:user basic-auth) (:secret basic-auth)]
               :url url
               :method method
               :insecure? true
               :content-type :json
               :accept :json
               :socket-timeout 1000
               :conn-timeout 1000 }
              params)))))

(defn get [url params]
  (logging/debug get [url params])
  (request :get url params))

(defn post [url params]
  (logging/debug post [url params])
  (request :post url params))

(defn put [url params]
  (logging/debug put [url params])
  (request :put url params))

(defn patch [url params]
  (logging/debug patch [url params])
   (request :patch url params))

;### Initialize ###############################################################

(defn initialize [new-conf]
  (reset! conf new-conf))

;### Debug ####################################################################
;(debug/debug-ns *ns*)
;(logging-config/set-logger! :level :debug)
;(logging-config/set-logger! :level :info)

Remove vestige require ns

Remove vestige require ns


(ns deathrow.utils
  (:require [cognitect.transit :as t]
            [deathrow.constants :as C]
            [goog.events :as gevts]
            [goog.net.XhrIo :as xhr]
            [goog.string :as gstr])
  (:import [goog.net XhrIo]
           [goog.dom DomHelper]))

(defn set-display-name
  [c name]
  (set! (-> c
          .-prototype
          .-displayName) name))

(defn log [v & text]
  (let [vs (if (string? v)
             (apply str v text)
             v)]
    (. js/console (log vs))
    v))

(defn normalize-string
  [html-string]
  (let [dom-helper (DomHelper.)
        html-string (gstr/unescapeEntities html-string)]
    (->> html-string
         (.htmlToDocumentFragment dom-helper)
         (.getTextContent dom-helper))))

(defn display-name
  ([{:keys [firstName lastName]}]
    display-name [firstName lastName])
  ([first last]
    (str first " " last)))

(defn highlight-nav
  [n]
  (let [all (-> js/Array
              .-prototype
              .-slice
              (.call (.querySelectorAll js/document "nav > ul > li")))
        el (.querySelector js/document (str "nav > ul > li:nth-child(" n ")"))]
    (doseq [elem all] (.setAttribute elem "class" ""))
    (set! (.-className el) "active")))

(defn get-ajax
  [path settings]
  (let [request (new goog.net.XhrIo)
        success-fn (:success settings)
        error-fn (:error settings)
        opts (apply dissoc settings [:success :error])]
    (.setTimeoutInterval request C/REMOTE-TIMEOUT)
    (gevts/listen request goog.net.EventType.COMPLETE
      (fn []
        (if (.isSuccess request)
          (success-fn (.getResponseJson request))
          (error-fn (.getLastError request)))))
    (.send request (str C/AJAX-ENDPOINT path) "GET" (.toString opts))))

(ns deathrow.utils
  (:require [cognitect.transit :as t]
            [deathrow.constants :as C]
            [goog.events :as gevts]
            [goog.net.XhrIo :as xhr]
            [goog.string :as gstr])
  (:import [goog.net XhrIo]
           [goog.dom DomHelper]))

(defn set-display-name
  [c name]
  (set! (-> c
          .-prototype
          .-displayName) name))

(defn log [v & text]
  (let [vs (if (string? v)
             (apply str v text)
             v)]
    (. js/console (log vs))
    v))

(defn normalize-string
  [html-string]
  (let [dom-helper (DomHelper.)
        html-string (gstr/unescapeEntities html-string)]
    (->> html-string
         (.htmlToDocumentFragment dom-helper)
         (.getTextContent dom-helper))))

(defn display-name
  ([{:keys [firstName lastName]}]
    (display-name firstName lastName))
  ([first last]
    (str first " " last)))

(defn highlight-nav
  [n]
  (let [all (-> js/Array
              .-prototype
              .-slice
              (.call (.querySelectorAll js/document "nav > ul > li")))
        el (.querySelector js/document (str "nav > ul > li:nth-child(" n ")"))]
    (doseq [elem all] (.setAttribute elem "class" ""))
    (set! (.-className el) "active")))

(defn get-ajax
  [path settings]
  (let [request (new goog.net.XhrIo)
        success-fn (:success settings)
        error-fn (:error settings)
        opts (apply dissoc settings [:success :error])]
    (.setTimeoutInterval request C/REMOTE-TIMEOUT)
    (gevts/listen request goog.net.EventType.COMPLETE
      (fn []
        (if (.isSuccess request)
          (success-fn (.getResponseJson request))
          (error-fn (.getLastError request)))))
    (.send request (str C/AJAX-ENDPOINT path) "GET" (.toString opts))))

fix display-name

fix display-name

was not showing a space between first & last names


(in-ns 'degasolv.resolver)

(defmacro dbg2 [body]
  `(let [x# ~body]
     (println "dbg:" '~body "=" x#)
     x#))

(def ^:private relation-strings
  {:greater-than ">"
   :greater-equal ">="
   :equal-to "=="
   :not-equal "!="
   :less-equal "<="
   :less-than "<"})

(defrecord VersionPredicate [relation version]
  Object
  (toString [this]
    (str
     ((:relation this) relation-strings)
     version)))

(defrecord Requirement [status id spec]
  Object
  (toString [this]
    (str
     (if (= (:status this) :absent)
       "!"
       "")
     (:id this)
     (clj-str/join
      ";"
      (map
       (fn conjoin-preds [conjunction]
         (clj-str/join
          ","
          (map
           #(str %)
           conjunction)))
       (:spec this))))))

(defrecord PackageInfo [id version location requirements])

                                        ; deprecated, do not use
(def ->requirement ->Requirement)
(def ->package ->PackageInfo)
(def ->version-predicate ->VersionPredicate)

(defmethod
  print-method
  degasolv.resolver.PackageInfo
  [this w]
  (tag/pr-tagged-record-on this w))

(defmethod
  print-method
  degasolv.resolver.VersionPredicate
  [this w]
  (tag/pr-tagged-record-on this w))

(defmethod
  print-method
  degasolv.resolver.Requirement
  [this w]
  (tag/pr-tagged-record-on this w))

(defn present
  ([id] (present id nil))
  ([id spec] (->Requirement :present id spec)))

(defn absent
  ([id] (absent id nil))
  ([id spec] (->Requirement :absent id spec)))

(defn- spec-call [f v]
  (f v))

(def ^:private nil-safe-spec-call
  (fnil spec-call (fn [v] true)))

(defn- successful? [result]
  (and (sequential? result)
       (= (first result) :successful)))

(defn- first-successful
  [result]
  (if (successful? result)
    result
    nil))

(defprotocol ^:private SpecCaller
  (p-safe-spec-call [this spec present-package]))

(extend-protocol SpecCaller
  nil
  (p-safe-spec-call [this spec present-package]
    (nil-safe-spec-call spec present-package))
  clojure.lang.IFn
  (p-safe-spec-call [cmp spec present-package]
    (if (nil? spec)
      true
      (let [pkg-ver (:version present-package)]
        (reduce
         (fn [disj-cum disj-val]
           (or disj-cum
               (reduce
                (fn [conj-cum conj-val]
                  conj-val
                  (let [chk-ver (:version conj-val)
                        cmp-result (cmp pkg-ver chk-ver)]
                    (and conj-cum
                         (case (:relation conj-val)
                           :greater-than
                           (pos? cmp-result)
                           :greater-equal
                           (not (neg? cmp-result))
                           :equal-to
                           (zero? cmp-result)
                           :not-equal
                           (not (zero? cmp-result))
                           :less-equal
                           (not (pos? cmp-result))
                           :less-than
                           (neg? cmp-result)
                           false)))) true disj-val)))
         false
         spec)))))

(defn- aggregate-attempts [c v]
  (conj c v))

(defn make-spec-call [cmp]
  (partial p-safe-spec-call cmp))

(defn- cull-nothing [candidates]
  candidates)

(defn- cull-all-but-first [candidates]
  [(first candidates)])

(defn- hoist [alternatives
              absent-specs
              found-packages
              present-packages]
  (if (= 1 (count alternatives))
    alternatives
    (let [partn
          (group-by
           (fn [term]
             (let [id (get term :id)]
               (cond
                 (get
                  absent-specs
                  id)
                 :absent
                 (or
                  (get
                   found-packages
                   id)
                  (get
                   present-packages
                   id))
                 :present
                 :else
                 :unspecified)))
           alternatives)]
      (concat (:absent partn) (:present partn) (:unspecified partn)))))

                                        ; If transformed value passes test,
                                        ; return a singleton list of those;
                                        ; otherwise, return the full list of transformed stuffs.
                                        ; This is because lazy seqs in clojure aren't exactly lazy;
                                        ; they're chunked lazy, which is sad.
(defn- first-found
  [f pred coll]
  (reduce
   (fn find-first
     [c v]
     (let [new-v (f v)]
       (if (pred new-v)
         (reduced [new-v])
         (conj c new-v))))
   []
   coll))

(defn resolve-dependencies
  [requirements
   query & {:keys [present-packages
                   conflicts
                   strategy
                   conflict-strat
                   compare
                   allow-alternatives]
            :or {present-packages {}
                 conflicts {}
                 strategy :thorough
                 conflict-strat :exclusive
                 compare nil
                 allow-alternatives true}}]
  (let [safe-spec-call (make-spec-call compare)
        cull (case strategy
               :thorough
               cull-nothing
               :fast
               cull-all-but-first
               (throw
                (ex-info (str
                          "Invalid strategy `"
                          strategy
                          "`.")
                         {:strategy strategy})))
        cull-alternatives
        (if allow-alternatives
          cull-nothing
          cull-all-but-first)]
    (letfn [(resolve-deps
              [repo
               present-packages
               found-packages
               absent-specs
               clauses]
              (if (empty? clauses)
                (if (= conflict-strat :inclusive)
                  [:successful (set (flatten (vals found-packages)))]
                  [:successful (set (vals found-packages))])
                (let [fclause (first clauses)
                      rclauses (subvec clauses 1)]
                  (if (empty? fclause)
                    [:unsuccessful
                     {:problems
                      [{:term fclause
                        :found-packages found-packages
                        :present-packages present-packages
                        :absent-specs absent-specs
                        :reason :empty-alternative-set}]}]
                    (let [clause-result
                          (first-found
                           (fn try-alternative
                             [alternative]
                             (println alternative)
                             (let [{status :status id :id spec :spec}
                                   alternative
                                   present-package
                                   (or (get present-packages id)
                                       (get found-packages id))]
                               (cond
                                 (and (not (= conflict-strat :inclusive))
                                      (not (nil? present-package)))
                                 (if (or (= conflict-strat :prioritized)
                                         (and (= status :absent)
                                              (not (safe-spec-call spec present-package)))
                                         (and (= status :present)
                                              (safe-spec-call spec present-package)))
                                   (resolve-deps
                                    repo
                                    present-packages
                                    found-packages
                                    absent-specs
                                    rclauses)
                                   [:unsuccessful
                                    {:problems
                                     [
                                      {:term fclause
                                       :found-packages found-packages
                                       :present-packages present-packages
                                       :absent-specs absent-specs
                                       :reason :present-package-conflict
                                       :alternative alternative
                                       :package-id id}]}])
                                 (= status :absent)
                                 (resolve-deps
                                  repo
                                  present-packages
                                  found-packages
                                  (update-in
                                   absent-specs
                                   [id] conj spec)
                                  rclauses)
                                 (= status :present)
                                 (let [query-results (repo id)]
                                   (if (empty? query-results)
                                     [:unsuccessful
                                      {:problems
                                       [
                                        {:term fclause
                                         :alternative alternative
                                         :found-packages found-packages
                                         :present-packages present-packages
                                         :absent-specs absent-specs
                                         :reason :package-not-found
                                         :package-id id}]}]
                                     (let [filtered-query-results
                                           (cull
                                            (filter
                                             (fn vet-candidate
                                               [candidate]
                                               (and
                                                (safe-spec-call spec candidate)
                                                (reduce
                                                 (fn [x y]
                                                   (and
                                                    x
                                                    (not
                                                     (safe-spec-call
                                                      y
                                                      candidate))))
                                                 true
                                                 (get absent-specs id))))
                                             query-results))]
                                       (if (empty? filtered-query-results)
                                         [:unsuccessful
                                          {:problems
                                           [{:term fclause
                                             :alternative alternative
                                             :found-packages found-packages
                                             :present-packages present-packages
                                             :absent-specs absent-specs
                                             :reason :package-rejected
                                             :package-id id}]}]
                                         (let [candidate-results
                                               (first-found
                                                #(resolve-deps
                                                  repo
                                                  present-packages
                                                  (if (= conflict-strat :inclusive)
                                                    (update-in found-packages [id]
                                                               conj
                                                               %)
                                                    (assoc found-packages
                                                           id %))
                                                  absent-specs
                                                  (into rclauses
                                                        (:requirements %)))
                                                successful?
                                                filtered-query-results)]
                                           (or
                                            (some
                                             first-successful
                                             candidate-results)
                                            [:unsuccessful
                                             {:problems
                                              (flatten
                                               (map
                                                #(:problems
                                                  (get % 1))
                                                candidate-results))}]))))))
                                 :else
                                 [:unsuccessful {:problems
                                                 [{:term fclause
                                                   :reason :uncovered-case
                                                   :alternative alternative
                                                   :found-packages found-packages
                                                   :present-packages present-packages
                                                   :absent-specs absent-specs}]}])))
                           successful?
                           ;; Hoisting
                           (hoist (cull-alternatives
                                   fclause)
                                  absent-specs
                                  found-packages
                                  present-packages))]
                      (or
                       (some
                        first-successful
                        clause-result)
                       [:unsuccessful
                        {:problems
                         (flatten
                          (map
                           #(:problems
                             (get % 1))
                           clause-result))}]))))))]
      (resolve-deps
       query
       present-packages
       {}
       conflicts
       (vec requirements)))))

(in-ns 'degasolv.resolver)

(defmacro dbg2 [body]
  `(let [x# ~body]
     (println "dbg:" '~body "=" x#)
     x#))

(def ^:private relation-strings
  {:greater-than ">"
   :greater-equal ">="
   :equal-to "=="
   :not-equal "!="
   :less-equal "<="
   :less-than "<"})

(defrecord VersionPredicate [relation version]
  Object
  (toString [this]
    (str
     ((:relation this) relation-strings)
     version)))

(defrecord Requirement [status id spec]
  Object
  (toString [this]
    (str
     (if (= (:status this) :absent)
       "!"
       "")
     (:id this)
     (clj-str/join
      ";"
      (map
       (fn conjoin-preds [conjunction]
         (clj-str/join
          ","
          (map
           #(str %)
           conjunction)))
       (:spec this))))))

(defrecord PackageInfo [id version location requirements])

                                        ; deprecated, do not use
(def ->requirement ->Requirement)
(def ->package ->PackageInfo)
(def ->version-predicate ->VersionPredicate)

(defmethod
  print-method
  degasolv.resolver.PackageInfo
  [this w]
  (tag/pr-tagged-record-on this w))

(defmethod
  print-method
  degasolv.resolver.VersionPredicate
  [this w]
  (tag/pr-tagged-record-on this w))

(defmethod
  print-method
  degasolv.resolver.Requirement
  [this w]
  (tag/pr-tagged-record-on this w))

(defn present
  ([id] (present id nil))
  ([id spec] (->Requirement :present id spec)))

(defn absent
  ([id] (absent id nil))
  ([id spec] (->Requirement :absent id spec)))

(defn- spec-call [f v]
  (f v))

(def ^:private nil-safe-spec-call
  (fnil spec-call (fn [v] true)))

(defn- successful? [result]
  (and (sequential? result)
       (= (first result) :successful)))

(defn- first-successful
  [result]
  (if (successful? result)
    result
    nil))

(defprotocol ^:private SpecCaller
  (p-safe-spec-call [this spec present-package]))

(extend-protocol SpecCaller
  nil
  (p-safe-spec-call [this spec present-package]
    (nil-safe-spec-call spec present-package))
  clojure.lang.IFn
  (p-safe-spec-call [cmp spec present-package]
    (if (nil? spec)
      true
      (let [pkg-ver (:version present-package)]
        (reduce
         (fn [disj-cum disj-val]
           (or disj-cum
               (reduce
                (fn [conj-cum conj-val]
                  conj-val
                  (let [chk-ver (:version conj-val)
                        cmp-result (cmp pkg-ver chk-ver)]
                    (and conj-cum
                         (case (:relation conj-val)
                           :greater-than
                           (pos? cmp-result)
                           :greater-equal
                           (not (neg? cmp-result))
                           :equal-to
                           (zero? cmp-result)
                           :not-equal
                           (not (zero? cmp-result))
                           :less-equal
                           (not (pos? cmp-result))
                           :less-than
                           (neg? cmp-result)
                           false)))) true disj-val)))
         false
         spec)))))

(defn- aggregate-attempts [c v]
  (conj c v))

(defn make-spec-call [cmp]
  (partial p-safe-spec-call cmp))

(defn- cull-nothing [candidates]
  candidates)

(defn- cull-all-but-first [candidates]
  [(first candidates)])

(defn- hoist [alternatives
              absent-specs
              found-packages
              present-packages]
  (if (= 1 (count alternatives))
    alternatives
    (let [partn
          (group-by
           (fn [term]
             (let [id (get term :id)]
               (cond
                 (get
                  absent-specs
                  id)
                 :absent
                 (or
                  (get
                   found-packages
                   id)
                  (get
                   present-packages
                   id))
                 :present
                 :else
                 :unspecified)))
           alternatives)]
      (concat (:absent partn) (:present partn) (:unspecified partn)))))

                                        ; If transformed value passes test,
                                        ; return a singleton list of those;
                                        ; otherwise, return the full list of transformed stuffs.
                                        ; This is because lazy seqs in clojure aren't exactly lazy;
                                        ; they're chunked lazy, which is sad.
(defn- first-found
  [f pred coll]
  (reduce
   (fn find-first
     [c v]
     (let [new-v (f v)]
       (if (pred new-v)
         (reduced [new-v])
         (conj c new-v))))
   []
   coll))

(defn resolve-dependencies
  [requirements
   query & {:keys [present-packages
                   conflicts
                   strategy
                   conflict-strat
                   compare
                   allow-alternatives]
            :or {present-packages {}
                 conflicts {}
                 strategy :thorough
                 conflict-strat :exclusive
                 compare nil
                 allow-alternatives true}}]
  (let [safe-spec-call (make-spec-call compare)
        cull (case strategy
               :thorough
               cull-nothing
               :fast
               cull-all-but-first
               (throw
                (ex-info (str
                          "Invalid strategy `"
                          strategy
                          "`.")
                         {:strategy strategy})))
        cull-alternatives
        (if allow-alternatives
          cull-nothing
          cull-all-but-first)]
    (letfn [(resolve-deps
              [repo
               present-packages
               found-packages
               absent-specs
               clauses]
              (if (empty? clauses)
                (if (= conflict-strat :inclusive)
                  [:successful (set (flatten (vals found-packages)))]
                  [:successful (set (vals found-packages))])
                (let [fclause (first clauses)
                      rclauses (subvec clauses 1)]
                  (if (empty? fclause)
                    [:unsuccessful
                     {:problems
                      [{:term fclause
                        :found-packages found-packages
                        :present-packages present-packages
                        :absent-specs absent-specs
                        :reason :empty-alternative-set}]}]
                    (let [clause-result
                          (first-found
                           (fn try-alternative
                             [alternative]
                             (let [{status :status id :id spec :spec}
                                   alternative
                                   present-package
                                   (or (get present-packages id)
                                       (get found-packages id))]
                               (cond
                                 (and (not (= conflict-strat :inclusive))
                                      (not (nil? present-package)))
                                 (if (or (= conflict-strat :prioritized)
                                         (and (= status :absent)
                                              (not (safe-spec-call spec present-package)))
                                         (and (= status :present)
                                              (safe-spec-call spec present-package)))
                                   (resolve-deps
                                    repo
                                    present-packages
                                    found-packages
                                    absent-specs
                                    rclauses)
                                   [:unsuccessful
                                    {:problems
                                     [
                                      {:term fclause
                                       :found-packages found-packages
                                       :present-packages present-packages
                                       :absent-specs absent-specs
                                       :reason :present-package-conflict
                                       :alternative alternative
                                       :package-id id}]}])
                                 (= status :absent)
                                 (resolve-deps
                                  repo
                                  present-packages
                                  found-packages
                                  (update-in
                                   absent-specs
                                   [id] conj spec)
                                  rclauses)
                                 (= status :present)
                                 (let [query-results (repo id)]
                                   (if (empty? query-results)
                                     [:unsuccessful
                                      {:problems
                                       [
                                        {:term fclause
                                         :alternative alternative
                                         :found-packages found-packages
                                         :present-packages present-packages
                                         :absent-specs absent-specs
                                         :reason :package-not-found
                                         :package-id id}]}]
                                     (let [filtered-query-results
                                           (cull
                                            (filter
                                             (fn vet-candidate
                                               [candidate]
                                               (and
                                                (safe-spec-call spec candidate)
                                                (reduce
                                                 (fn [x y]
                                                   (and
                                                    x
                                                    (not
                                                     (safe-spec-call
                                                      y
                                                      candidate))))
                                                 true
                                                 (get absent-specs id))))
                                             query-results))]
                                       (if (empty? filtered-query-results)
                                         [:unsuccessful
                                          {:problems
                                           [{:term fclause
                                             :alternative alternative
                                             :found-packages found-packages
                                             :present-packages present-packages
                                             :absent-specs absent-specs
                                             :reason :package-rejected
                                             :package-id id}]}]
                                         (let [candidate-results
                                               (first-found
                                                #(resolve-deps
                                                  repo
                                                  present-packages
                                                  (if (= conflict-strat :inclusive)
                                                    (update-in found-packages [id]
                                                               conj
                                                               %)
                                                    (assoc found-packages
                                                           id %))
                                                  absent-specs
                                                  (into rclauses
                                                        (:requirements %)))
                                                successful?
                                                filtered-query-results)]
                                           (or
                                            (some
                                             first-successful
                                             candidate-results)
                                            [:unsuccessful
                                             {:problems
                                              (flatten
                                               (map
                                                #(:problems
                                                  (get % 1))
                                                candidate-results))}]))))))
                                 :else
                                 [:unsuccessful {:problems
                                                 [{:term fclause
                                                   :reason :uncovered-case
                                                   :alternative alternative
                                                   :found-packages found-packages
                                                   :present-packages present-packages
                                                   :absent-specs absent-specs}]}])))
                           successful?
                           ;; Hoisting
                           (hoist (cull-alternatives
                                   fclause)
                                  absent-specs
                                  found-packages
                                  present-packages))]
                      (or
                       (some
                        first-successful
                        clause-result)
                       [:unsuccessful
                        {:problems
                         (flatten
                          (map
                           #(:problems
                             (get % 1))
                           clause-result))}]))))))]
      (resolve-deps
       query
       present-packages
       {}
       conflicts
       (vec requirements)))))

FIX the non-laziness of clojure bug. BEGONE


(ns rp.util.string-spec
  (:require [rp.util.string :as util-string]
            [rp.util.number :as util-number]
            [clojure.spec :as s]
            [clojure.spec.gen :as g]))

(def invalid ::s/invalid)

(defn conformer
  [f]
  (s/conformer (fn [x]
                 (if-let [result (f x)]
                   result
                   invalid))
               str))

(defn generator
  [gen]
  (fn []
    (g/bind gen
            #(g/return (str %)))))

(s/def ::long (s/spec (conformer util-string/parse-long)
                      :gen (generator (s/gen int?))))
(s/def ::double (s/spec (conformer util-string/parse-double)
                        :gen (generator (s/gen double?))))
(s/def ::nat-long (s/and ::long util-number/nat-num?))
(s/def ::nat-double (s/and ::double util-number/nat-num?))

(ns rp.util.string-spec
  (:require [rp.util.string :as util-string]
            [rp.util.number :as util-number]
            [clojure.spec :as s]
            [clojure.spec.gen :as g]))

(def invalid ::s/invalid)

(defn conformer
  [f]
  (s/conformer (fn [x]
                 (if-some [result (f x)]
                   result
                   invalid))
               str))

(defn generator
  [gen]
  (fn []
    (g/bind gen
            #(g/return (str %)))))

(s/def ::boolean (s/spec (conformer util-string/parse-boolean)
                         :gen (generator (s/gen boolean?))))
(s/def ::long (s/spec (conformer util-string/parse-long)
                      :gen (generator (s/gen int?))))
(s/def ::double (s/spec (conformer util-string/parse-double)
                        :gen (generator (s/gen double?))))
(s/def ::nat-long (s/and ::long util-number/nat-num?))
(s/def ::nat-double (s/and ::double util-number/nat-num?))

Add ::boolean spec

Add ::boolean spec


(ns docker-clojure.core
  (:require
   [clojure.java.shell :refer [sh with-sh-dir]]
   [clojure.math.combinatorics :as combo]
   [clojure.spec.alpha :as s]
   [clojure.string :as str]
   [docker-clojure.dockerfile :as df]))

(s/def ::non-blank-string
  (s/and string? #(not (str/blank? %))))

(s/def ::jdk-version
  (s/and pos-int? #(<= 8 %)))
(s/def ::jdk-versions (s/coll-of ::jdk-version :distinct true :into #{}))

(s/def ::base-image ::non-blank-string)
(s/def ::base-images (s/coll-of ::base-image :distinct true :into #{}))

(s/def ::distro qualified-keyword?)
(s/def ::distros (s/coll-of ::distro :distinct true :into #{}))

(s/def ::build-tool (s/or ::specific-tool ::non-blank-string
                          ::all-tools #(= ::all %)))
(s/def ::build-tool-version
  (s/nilable (s/and ::non-blank-string #(re-matches #"[\d\.]+" %))))
(s/def ::build-tools (s/map-of ::build-tool ::build-tool-version))

(s/def ::exclusions
  (s/keys :opt-un [::jdk-version ::distro ::build-tool ::build-tool-version]))

(s/def ::maintainers
  (s/coll-of ::non-blank-string :distinct true :into #{}))

(def base-image "openjdk")

(def jdk-versions #{8 11 16 17 18})

;; The default JDK version to use for tags that don't specify one; usually the latest LTS release
(def default-jdk-version 11)

(def distros
  #{:debian/buster :debian-slim/slim-buster :debian/bullseye :debian-slim/slim-bullseye :alpine/alpine})

;; The default distro to use for tags that don't specify one, keyed by jdk-version.
(def default-distros
  {:default :debian-slim/slim-bullseye})

(def build-tools
  {"lein"       "2.9.7"
   "boot"       "2.8.3"
   "tools-deps" "1.10.3.986"})

(def installer-hashes
  {"lein"       {"2.9.7" "f78f20d1931f028270e77bc0f0c00a5a0efa4ecb7a5676304a34ae4f469e281d"
                 "2.9.6" "094b58e2b13b42156aaf7d443ed5f6665aee27529d9512f8d7282baa3cc01429"}
   "boot"       {"2.8.3" "0ccd697f2027e7e1cd3be3d62721057cbc841585740d0aaa9fbb485d7b1f17c3"}
   "tools-deps" {"1.10.3.967" "d1fba0cd0733b7cb66e47620845ecedfd757a9bf84e8b276fdb37ed9c272d3ae"
                 "1.10.3.981" "c6463a4f8950de6ce7982d01b72b660b9849c9a66d870081f5ee6b108220cf29"
                 "1.10.3.986" "f2a271d6892fb04f7377148f6770185486ca194245721ab34a62ae03e8d1149f"}})

(def exclusions ; don't build these for whatever reason(s)
  #{{:jdk-version 8
     :distro      :alpine/alpine}
    {:jdk-version 11
     :distro      :alpine/alpine}
    {:jdk-version 16
     :distro      :alpine/alpine}
    {:jdk-version 17
     :distro      :alpine/alpine}})

(def maintainers
  "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>")

(defn default-distro [jdk-version]
  (get default-distros jdk-version (:default default-distros)))

(defn contains-every-key-value?
  "Returns true if the map `haystack` contains every key-value pair in the map
  `needles`. `haystack` may contain additional keys that are not in `needles`.
  Returns false if any of the keys in `needles` are missing from `haystack` or
  have different values."
  [haystack needles]
  (every? (fn [[k v]]
            (= v (get haystack k)))
          needles))

(defn base-image-name [jdk-version distro]
  (str base-image ":" jdk-version "-" (name distro)))

(defn exclude?
  "Returns true if `variant` matches one of `exclusions` elements (meaning
  `(contains-every-key-value? variant exclusion)` returns true)."
  [exclusions variant]
  (some (partial contains-every-key-value? variant) exclusions))

(defn docker-tag
  [{:keys [jdk-version distro build-tool build-tool-version]}]
  (if (= ::all build-tool)
    "latest"
    (let [jdk-label (if (= default-jdk-version jdk-version)
                      nil
                      (str base-image "-" jdk-version))
          dd (default-distro jdk-version)
          distro-label (if (= dd distro) nil (when distro (name distro)))]
      (str/join "-" (remove nil? [jdk-label build-tool build-tool-version
                                  distro-label])))))

(s/def ::variant
  (s/keys :req-un [::jdk-version ::base-image ::distro ::build-tool
                   ::build-tool-version ::maintainer ::docker-tag]
          :opt-un [::build-tool-versions]))

(defn assoc-if [m pred k v]
  (if (pred)
    (assoc m k v)
    m))

(defn variant-map [[jdk-version distro [build-tool build-tool-version]]]
  (let [base {:jdk-version        jdk-version
              :base-image         (base-image-name jdk-version distro)
              :distro             distro
              :build-tool         build-tool
              :build-tool-version build-tool-version
              :maintainer         maintainers}]
    (-> base
        (assoc :docker-tag (docker-tag base))
        (assoc-if #(nil? (:build-tool-version base)) :build-tool-versions build-tools))))

(defn pull-image [image]
  (sh "docker" "pull" image))

(defn generate-dockerfile! [installer-hashes variant]
  (let [build-dir (df/build-dir variant)
        filename "Dockerfile"]
    (println "Generating" (str build-dir "/" filename))
    (df/write-file build-dir filename installer-hashes variant)
    (assoc variant
      :build-dir build-dir
      :dockerfile filename)))

(defn build-image [installer-hashes {:keys [docker-tag base-image] :as variant}]
  (let [image-tag (str "clojure:" docker-tag)
        _         (println "Pulling base image" base-image)
        _         (pull-image base-image)

        {:keys [dockerfile build-dir]}
        (generate-dockerfile! installer-hashes variant)

        ;; TODO: Build for all appropriate platforms instead of just linux/amd64.
        ;;       alpine won't build for arm64.
        build-cmd ["docker" "buildx" "build" "--no-cache" "--platform"
                   "linux/amd64" "--load" "-t" image-tag "-f" dockerfile "."]]
    (apply println "Running" build-cmd)
    (let [{:keys [out err exit]}
          (with-sh-dir build-dir (apply sh build-cmd))]
      (if (zero? exit)
        (println "Succeeded")
        (do
          (println "ERROR:" err)
          (print out)))))
  (println))

(def latest-variant
  "The latest variant is special because we include all 3 build tools via the
  [::all] value on the end."
  (list default-jdk-version (default-distro default-jdk-version) [::all]))

(defn image-variants [jdk-versions distros build-tools]
  (->> (combo/cartesian-product jdk-versions distros build-tools)
       (cons latest-variant)
       (map variant-map)
       (remove #(= ::s/invalid (s/conform ::variant %)))
       set))

(defn build-images [installer-hashes variants]
  (println "Building images")
  (doseq [variant variants]
    (build-image installer-hashes variant)))

(defn generate-dockerfiles! [installer-hashes variants]
  (doseq [variant variants]
    (generate-dockerfile! installer-hashes variant)))

(defn valid-variants []
  (remove (partial exclude? exclusions)
          (image-variants jdk-versions distros build-tools)))

(defn -main [& args]
  (case (first args)
    "clean" (df/clean-all)
    "dockerfiles" (generate-dockerfiles! installer-hashes (valid-variants))
    (build-images installer-hashes (valid-variants)))
  (System/exit 0))

(ns docker-clojure.core
  (:require
   [clojure.java.shell :refer [sh with-sh-dir]]
   [clojure.math.combinatorics :as combo]
   [clojure.spec.alpha :as s]
   [clojure.string :as str]
   [docker-clojure.dockerfile :as df]))

(s/def ::non-blank-string
  (s/and string? #(not (str/blank? %))))

(s/def ::jdk-version
  (s/and pos-int? #(<= 8 %)))
(s/def ::jdk-versions (s/coll-of ::jdk-version :distinct true :into #{}))

(s/def ::base-image ::non-blank-string)
(s/def ::base-images (s/coll-of ::base-image :distinct true :into #{}))

(s/def ::distro qualified-keyword?)
(s/def ::distros (s/coll-of ::distro :distinct true :into #{}))

(s/def ::build-tool (s/or ::specific-tool ::non-blank-string
                          ::all-tools #(= ::all %)))
(s/def ::build-tool-version
  (s/nilable (s/and ::non-blank-string #(re-matches #"[\d\.]+" %))))
(s/def ::build-tools (s/map-of ::build-tool ::build-tool-version))

(s/def ::exclusions
  (s/keys :opt-un [::jdk-version ::distro ::build-tool ::build-tool-version]))

(s/def ::maintainers
  (s/coll-of ::non-blank-string :distinct true :into #{}))

(def base-image "openjdk")

(def jdk-versions #{8 11 17 18})

;; The default JDK version to use for tags that don't specify one; usually the latest LTS release
(def default-jdk-version 11)

(def distros
  #{:debian/buster :debian-slim/slim-buster :debian/bullseye :debian-slim/slim-bullseye :alpine/alpine})

;; The default distro to use for tags that don't specify one, keyed by jdk-version.
(def default-distros
  {:default :debian-slim/slim-bullseye})

(def build-tools
  {"lein"       "2.9.7"
   "boot"       "2.8.3"
   "tools-deps" "1.10.3.986"})

(def installer-hashes
  {"lein"       {"2.9.7" "f78f20d1931f028270e77bc0f0c00a5a0efa4ecb7a5676304a34ae4f469e281d"
                 "2.9.6" "094b58e2b13b42156aaf7d443ed5f6665aee27529d9512f8d7282baa3cc01429"}
   "boot"       {"2.8.3" "0ccd697f2027e7e1cd3be3d62721057cbc841585740d0aaa9fbb485d7b1f17c3"}
   "tools-deps" {"1.10.3.967" "d1fba0cd0733b7cb66e47620845ecedfd757a9bf84e8b276fdb37ed9c272d3ae"
                 "1.10.3.981" "c6463a4f8950de6ce7982d01b72b660b9849c9a66d870081f5ee6b108220cf29"
                 "1.10.3.986" "f2a271d6892fb04f7377148f6770185486ca194245721ab34a62ae03e8d1149f"}})

(def exclusions ; don't build these for whatever reason(s)
  #{{:jdk-version 8
     :distro      :alpine/alpine}
    {:jdk-version 11
     :distro      :alpine/alpine}
    {:jdk-version 17
     :distro      :alpine/alpine}})

(def maintainers
  "Paul Lam <paul@quantisan.com> & Wes Morgan <wesmorgan@icloud.com>")

(defn default-distro [jdk-version]
  (get default-distros jdk-version (:default default-distros)))

(defn contains-every-key-value?
  "Returns true if the map `haystack` contains every key-value pair in the map
  `needles`. `haystack` may contain additional keys that are not in `needles`.
  Returns false if any of the keys in `needles` are missing from `haystack` or
  have different values."
  [haystack needles]
  (every? (fn [[k v]]
            (= v (get haystack k)))
          needles))

(defn base-image-name [jdk-version distro]
  (str base-image ":" jdk-version "-" (name distro)))

(defn exclude?
  "Returns true if `variant` matches one of `exclusions` elements (meaning
  `(contains-every-key-value? variant exclusion)` returns true)."
  [exclusions variant]
  (some (partial contains-every-key-value? variant) exclusions))

(defn docker-tag
  [{:keys [jdk-version distro build-tool build-tool-version]}]
  (if (= ::all build-tool)
    "latest"
    (let [jdk-label (if (= default-jdk-version jdk-version)
                      nil
                      (str base-image "-" jdk-version))
          dd (default-distro jdk-version)
          distro-label (if (= dd distro) nil (when distro (name distro)))]
      (str/join "-" (remove nil? [jdk-label build-tool build-tool-version
                                  distro-label])))))

(s/def ::variant
  (s/keys :req-un [::jdk-version ::base-image ::distro ::build-tool
                   ::build-tool-version ::maintainer ::docker-tag]
          :opt-un [::build-tool-versions]))

(defn assoc-if [m pred k v]
  (if (pred)
    (assoc m k v)
    m))

(defn variant-map [[jdk-version distro [build-tool build-tool-version]]]
  (let [base {:jdk-version        jdk-version
              :base-image         (base-image-name jdk-version distro)
              :distro             distro
              :build-tool         build-tool
              :build-tool-version build-tool-version
              :maintainer         maintainers}]
    (-> base
        (assoc :docker-tag (docker-tag base))
        (assoc-if #(nil? (:build-tool-version base)) :build-tool-versions build-tools))))

(defn pull-image [image]
  (sh "docker" "pull" image))

(defn generate-dockerfile! [installer-hashes variant]
  (let [build-dir (df/build-dir variant)
        filename "Dockerfile"]
    (println "Generating" (str build-dir "/" filename))
    (df/write-file build-dir filename installer-hashes variant)
    (assoc variant
      :build-dir build-dir
      :dockerfile filename)))

(defn build-image [installer-hashes {:keys [docker-tag base-image] :as variant}]
  (let [image-tag (str "clojure:" docker-tag)
        _         (println "Pulling base image" base-image)
        _         (pull-image base-image)

        {:keys [dockerfile build-dir]}
        (generate-dockerfile! installer-hashes variant)

        ;; TODO: Build for all appropriate platforms instead of just linux/amd64.
        ;;       alpine won't build for arm64.
        build-cmd ["docker" "buildx" "build" "--no-cache" "--platform"
                   "linux/amd64" "--load" "-t" image-tag "-f" dockerfile "."]]
    (apply println "Running" build-cmd)
    (let [{:keys [out err exit]}
          (with-sh-dir build-dir (apply sh build-cmd))]
      (if (zero? exit)
        (println "Succeeded")
        (do
          (println "ERROR:" err)
          (print out)))))
  (println))

(def latest-variant
  "The latest variant is special because we include all 3 build tools via the
  [::all] value on the end."
  (list default-jdk-version (default-distro default-jdk-version) [::all]))

(defn image-variants [jdk-versions distros build-tools]
  (->> (combo/cartesian-product jdk-versions distros build-tools)
       (cons latest-variant)
       (map variant-map)
       (remove #(= ::s/invalid (s/conform ::variant %)))
       set))

(defn build-images [installer-hashes variants]
  (println "Building images")
  (doseq [variant variants]
    (build-image installer-hashes variant)))

(defn generate-dockerfiles! [installer-hashes variants]
  (doseq [variant variants]
    (generate-dockerfile! installer-hashes variant)))

(defn valid-variants []
  (remove (partial exclude? exclusions)
          (image-variants jdk-versions distros build-tools)))

(defn -main [& args]
  (case (first args)
    "clean" (df/clean-all)
    "dockerfiles" (generate-dockerfiles! installer-hashes (valid-variants))
    (build-images installer-hashes (valid-variants)))
  (System/exit 0))

Remove openjdk 16 variants now that it's EOL


(ns whisper2cyanite.cli
  (:require [clojure.string :as str]
            [clojure.tools.cli :as cli]
            [whisper2cyanite.metric-store :as mstore]
            [whisper2cyanite.path-store :as pstore]
            [whisper2cyanite.core :as core]
            [whisper2cyanite.logging :as wlog]
            [org.spootnik.logconfig :as logconfig])
  (:gen-class))

(def cli-commands #{"migrate" "validate" "list" "info" "fetch" "help"})

(defn- check-rollups
  "Check rollups."
  [rollups]
  (not-any? nil? rollups))

(defn- parse-rollups
  "Parse rollups."
  [rollups]
  (->> (str/split rollups #",")
       (map #(re-matches #"^((\d+)(:(\d+))*)$" %))
       (map #(if % [(Integer/parseInt (nth % 2))
                    (Integer/parseInt (nth % 4))] %))))

(defn- usage
  "Construct usage message."
  [options-summary]
  (->> ["Whisper to Cyanite data migration tool"
        ""
        "Usage: "
        "  whisper2cyanite [options] migrate <directory | file> <tenant> <cassandra-host,...> <elasticsearch-url>"
        "  whisper2cyanite [options] validate <directory | file> <tenant> <cassandra-host,...> <elasticsearch-url>"
        "  whisper2cyanite list <directory>"
        "  whisper2cyanite info <file>"
        "  whisper2cyanite [options] fetch <file> <rollup>"
        "  whisper2cyanite help"
        ""
        "Options:"
        options-summary]
       (str/join \newline)))

(defn- error-msg
  "Combine error messages."
  [errors]
  (str "The following errors occurred while parsing your command:\n\n"
       (str/join \newline errors)))

(defn- exit
  "Print message and exit with status."
  [status msg]
  (println msg)
  (System/exit status))

(defn- check-arguments
  [command arguments min max]
  (let [n-args (count arguments)]
    (when (or (< n-args min) (> n-args max))
      (exit 1 (error-msg
               [(format "Invalid number of arguments for the command \"%s\""
                        command)])))))

(defn- check-options
  "Check options."
  [command valid-options options]
  (doseq [option (keys options)]
    (when (not (contains? valid-options option))
      (exit 1 (error-msg
               [(format "Option \"--%s\" conflicts with the command \"%s\""
                        (name option) command)])))))

(defn- prepare-common-args
  "Prepare common arguments."
  [arguments options]
  (let [source (nth arguments 0)
        tenant (nth arguments 1)
        cass-hosts (str/split (nth arguments 2) #",")
        es-url (nth arguments 3)
        rollups (->> (:rollups options [])
                     (filter #(not (nil? %)))
                     (flatten)
                     (apply hash-map))
        options (assoc options :rollups rollups)]
    {:source source :tenant tenant :cass-hosts cass-hosts :es-url es-url
     :options options}))

(defn- run-migrate
  "Run command 'migrate'."
  [command arguments options summary]
  (check-arguments "migrate" arguments 4 4)
  (check-options command #{:from :to :run :rollups :jobs :min-ttl :root-dir
                           :cassandra-keyspace :cassandra-options
                           :cassandra-channel-size :disable-metric-store
                           :elasticsearch-index :elasticsearch-channel-size
                           :disable-path-store :log-file :log-level
                           :disable-log :stop-on-error :disable-progress}
                 options)
  (let [{:keys [source tenant cass-hosts es-url
                options]} (prepare-common-args arguments options)]
    (core/migrate source tenant cass-hosts es-url options)))

(defn- run-validate
  "Run command 'validate'."
  [command arguments options summary]
  (check-arguments "validate" arguments 4 4)
  (check-options command #{:from :to :rollups :jobs :min-ttl :root-dir
                           :cassandra-keyspace :cassandra-options
                           :disable-metric-store :elasticsearch-index
                           :disable-path-store :log-file :log-level
                           :disable-log :stop-on-error :disable-progress}
                 options)
  (let [{:keys [source tenant cass-hosts es-url
                options]} (prepare-common-args arguments options)]
    (core/validate source tenant cass-hosts es-url options)))

(defn- run-list
  "Run command 'list'."
  [command arguments options summary]
  (check-arguments command arguments 1 1)
  (check-options command #{} options)
  (core/list-paths (first arguments)))

(defn- run-info
  "Run command 'info'."
  [command arguments options summary]
  (check-arguments command arguments 1 1)
  (check-options command #{} options)
  (core/show-info (first arguments)))

(defn- run-fetch
  "Run command 'fetch'."
  [command arguments options summary]
  (check-arguments command arguments 2 2)
  (check-options command #{:from :to} options)
  (let [rollup (Integer/parseInt (second arguments))]
    (core/fetch (first arguments) rollup options)))

(defn- run-help
  "Run command 'help'."
  [command arguments options summary]
  (exit 0 (usage summary)))

(def cli-options
  [["-f" "--from FROM" "From time (Unix epoch)"
    :parse-fn #(Integer/parseInt %)
    :validate [#(<= 0 %)]]
   ["-t" "--to TO" "To time (Unix epoch)"
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   ["-r" "--run" "Force normal run (dry run using on default)"]
   ["-R" "--rollups ROLLUPS"
    "Define rollups. Format: <seconds_per_point[:retention],...> Example: 60,300:31536000"
    :parse-fn #(parse-rollups %)
    :validate [check-rollups]]
   ["-j" "--jobs JOBS" "Number of jobs to run simultaneously"
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   ["-T" "--min-ttl TTL" (str "Minimal TTL. Default: " core/default-min-ttl)
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   ["-D" "--root-dir DIRECTORY" "Root directory"]
   [nil "--cassandra-keyspace KEYSPACE"
    (str "Cassandra keyspace. Default: " mstore/default-cassandra-keyspace)]
   ["-O" "--cassandra-options OPTIONS"
    "Cassandra options. Example: \"{:compression :lz4}\""
    :parse-fn #(read-string %)
    :validate [#(= clojure.lang.PersistentArrayMap (type %))]]
   [nil "--cassandra-channel-size SIZE"
    (str "Cassandra channel size. Default: "
         mstore/default-cassandra-channel-size)
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   [nil "--disable-metric-store" "Disable writing to metric store"]
   [nil "--elasticsearch-index INDEX"
    (str "Elasticsearch index. Default: " pstore/default-es-index)]
   [nil "--elasticsearch-channel-size SIZE"
    (str "Elasticsearch channel size. Default: "
         pstore/default-es-channel-size)
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   [nil "--disable-path-store" "Disable writing to path store"]
   ["-l" "--log-file FILE" (str "Log file. Default: " wlog/default-log-file)]
   ["-L" "--log-level LEVEL"
    (str "Log level (all, trace, debug, info, warn, error, fatal, off). "
         "Default: " wlog/default-log-level)
    :validate [#(or (= (count %) 0)
                    (not= (get logconfig/levels % :not-found) :not-found))]]
   ["-S" "--stop-on-error" "Stop on first non-fatal error"]
   ["-P" "--disable-progress" "Disable progress bar"]])

(defn- run-command
  "Run command."
  [arguments options summary]
  (let [command (first arguments)]
    (when (not (contains? cli-commands command))
      (exit 1 (error-msg [(format "Unknown command: \"%s\"" command)])))
    (apply (resolve (symbol (str "whisper2cyanite.cli/run-" command)))
           [command (drop 1 arguments) options summary])))

(defn -main
  "Main function."
  [& args]
  (let [{:keys [options arguments errors summary]}
        (cli/parse-opts args cli-options)]
    ;; Handle help and error conditions
    (cond
     (< (count args) 1) (exit 0 (usage summary))
     errors (exit 1 (error-msg errors)))
    ;; Run command
    (run-command arguments options summary)
    (System/exit 0)))

(ns whisper2cyanite.cli
  (:require [clojure.string :as str]
            [clojure.tools.cli :as cli]
            [whisper2cyanite.logging :as wlog]
            [whisper2cyanite.metric-store :as mstore]
            [whisper2cyanite.path-store :as pstore]
            [whisper2cyanite.core :as core]
            [org.spootnik.logconfig :as logconfig])
  (:gen-class))

(def cli-commands #{"migrate" "validate" "list" "info" "fetch" "help"})

(defn- check-rollups
  "Check rollups."
  [rollups]
  (not-any? nil? rollups))

(defn- parse-rollups
  "Parse rollups."
  [rollups]
  (->> (str/split rollups #",")
       (map #(re-matches #"^((\d+)(:(\d+))*)$" %))
       (map #(if % [(Integer/parseInt (nth % 2))
                    (Integer/parseInt (nth % 4))] %))))

(defn- usage
  "Construct usage message."
  [options-summary]
  (->> ["Whisper to Cyanite data migration tool"
        ""
        "Usage: "
        "  whisper2cyanite [options] migrate <directory | file> <tenant> <cassandra-host,...> <elasticsearch-url>"
        "  whisper2cyanite [options] validate <directory | file> <tenant> <cassandra-host,...> <elasticsearch-url>"
        "  whisper2cyanite list <directory>"
        "  whisper2cyanite info <file>"
        "  whisper2cyanite [options] fetch <file> <rollup>"
        "  whisper2cyanite help"
        ""
        "Options:"
        options-summary]
       (str/join \newline)))

(defn- error-msg
  "Combine error messages."
  [errors]
  (str "The following errors occurred while parsing your command:\n\n"
       (str/join \newline errors)))

(defn- exit
  "Print message and exit with status."
  [status msg]
  (println msg)
  (System/exit status))

(defn- check-arguments
  [command arguments min max]
  (let [n-args (count arguments)]
    (when (or (< n-args min) (> n-args max))
      (exit 1 (error-msg
               [(format "Invalid number of arguments for the command \"%s\""
                        command)])))))

(defn- check-options
  "Check options."
  [command valid-options options]
  (doseq [option (keys options)]
    (when (not (contains? valid-options option))
      (exit 1 (error-msg
               [(format "Option \"--%s\" conflicts with the command \"%s\""
                        (name option) command)])))))

(defn- prepare-common-args
  "Prepare common arguments."
  [arguments options]
  (let [source (nth arguments 0)
        tenant (nth arguments 1)
        cass-hosts (str/split (nth arguments 2) #",")
        es-url (nth arguments 3)
        rollups (->> (:rollups options [])
                     (filter #(not (nil? %)))
                     (flatten)
                     (apply hash-map))
        options (assoc options :rollups rollups)]
    {:source source :tenant tenant :cass-hosts cass-hosts :es-url es-url
     :options options}))

(defn- run-migrate
  "Run command 'migrate'."
  [command arguments options summary]
  (check-arguments "migrate" arguments 4 4)
  (check-options command #{:from :to :run :rollups :jobs :min-ttl :root-dir
                           :cassandra-keyspace :cassandra-options
                           :cassandra-channel-size :disable-metric-store
                           :elasticsearch-index :elasticsearch-channel-size
                           :disable-path-store :log-file :log-level
                           :disable-log :stop-on-error :disable-progress}
                 options)
  (let [{:keys [source tenant cass-hosts es-url
                options]} (prepare-common-args arguments options)]
    (core/migrate source tenant cass-hosts es-url options)))

(defn- run-validate
  "Run command 'validate'."
  [command arguments options summary]
  (check-arguments "validate" arguments 4 4)
  (check-options command #{:from :to :rollups :jobs :min-ttl :root-dir
                           :cassandra-keyspace :cassandra-options
                           :disable-metric-store :elasticsearch-index
                           :disable-path-store :log-file :log-level
                           :disable-log :stop-on-error :disable-progress}
                 options)
  (let [{:keys [source tenant cass-hosts es-url
                options]} (prepare-common-args arguments options)]
    (core/validate source tenant cass-hosts es-url options)))

(defn- run-list
  "Run command 'list'."
  [command arguments options summary]
  (check-arguments command arguments 1 1)
  (check-options command #{} options)
  (core/list-paths (first arguments)))

(defn- run-info
  "Run command 'info'."
  [command arguments options summary]
  (check-arguments command arguments 1 1)
  (check-options command #{} options)
  (core/show-info (first arguments)))

(defn- run-fetch
  "Run command 'fetch'."
  [command arguments options summary]
  (check-arguments command arguments 2 2)
  (check-options command #{:from :to} options)
  (let [rollup (Integer/parseInt (second arguments))]
    (core/fetch (first arguments) rollup options)))

(defn- run-help
  "Run command 'help'."
  [command arguments options summary]
  (exit 0 (usage summary)))

(def cli-options
  [["-f" "--from FROM" "From time (Unix epoch)"
    :parse-fn #(Integer/parseInt %)
    :validate [#(<= 0 %)]]
   ["-t" "--to TO" "To time (Unix epoch)"
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   ["-r" "--run" "Force normal run (dry run using on default)"]
   ["-R" "--rollups ROLLUPS"
    "Define rollups. Format: <seconds_per_point[:retention],...> Example: 60,300:31536000"
    :parse-fn #(parse-rollups %)
    :validate [check-rollups]]
   ["-j" "--jobs JOBS" "Number of jobs to run simultaneously"
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   ["-T" "--min-ttl TTL" (str "Minimal TTL. Default: " core/default-min-ttl)
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   ["-D" "--root-dir DIRECTORY" "Root directory"]
   [nil "--cassandra-keyspace KEYSPACE"
    (str "Cassandra keyspace. Default: " mstore/default-cassandra-keyspace)]
   ["-O" "--cassandra-options OPTIONS"
    "Cassandra options. Example: \"{:compression :lz4}\""
    :parse-fn #(read-string %)
    :validate [#(= clojure.lang.PersistentArrayMap (type %))]]
   [nil "--cassandra-channel-size SIZE"
    (str "Cassandra channel size. Default: "
         mstore/default-cassandra-channel-size)
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   [nil "--disable-metric-store" "Disable writing to metric store"]
   [nil "--elasticsearch-index INDEX"
    (str "Elasticsearch index. Default: " pstore/default-es-index)]
   [nil "--elasticsearch-channel-size SIZE"
    (str "Elasticsearch channel size. Default: "
         pstore/default-es-channel-size)
    :parse-fn #(Integer/parseInt %)
    :validate [#(< 0 %)]]
   [nil "--disable-path-store" "Disable writing to path store"]
   ["-l" "--log-file FILE" (str "Log file. Default: " wlog/default-log-file)]
   ["-L" "--log-level LEVEL"
    (str "Log level (all, trace, debug, info, warn, error, fatal, off). "
         "Default: " wlog/default-log-level)
    :validate [#(or (= (count %) 0)
                    (not= (get logconfig/levels % :not-found) :not-found))]]
   ["-S" "--stop-on-error" "Stop on first non-fatal error"]
   ["-P" "--disable-progress" "Disable progress bar"]])

(defn- run-command
  "Run command."
  [arguments options summary]
  (let [command (first arguments)]
    (when (not (contains? cli-commands command))
      (exit 1 (error-msg [(format "Unknown command: \"%s\"" command)])))
    (apply (resolve (symbol (str "whisper2cyanite.cli/run-" command)))
           [command (drop 1 arguments) options summary])))

(defn -main
  "Main function."
  [& args]
  (let [{:keys [options arguments errors summary]}
        (cli/parse-opts args cli-options)]
    ;; Handle help and error conditions
    (cond
     (< (count args) 1) (exit 0 (usage summary))
     errors (exit 1 (error-msg errors)))
    ;; Run command
    (run-command arguments options summary)
    (System/exit 0)))

Fix C* driver warnings

Fix C* driver warnings


(ns ^{:added "0.12.1"}
 grafter-2.rdf4j.sparql
  "Functions for executing SPARQL queries with grafter RDF
  repositories, that support basic binding replacement etc."
  (:require [clojure.java.io :as io :refer [resource]]
            [clojure.spec.alpha :as s]
            [clojure.string :as str]
            [grafter-2.rdf4j.io :as rio]
            [grafter-2.rdf4j.repository :as repo :refer [->connection]])
  (:import java.util.regex.Pattern
           org.eclipse.rdf4j.rio.ntriples.NTriplesUtil
           org.eclipse.rdf4j.repository.RepositoryConnection))

(defn- get-clause-pattern [clause-name key]
  (cond
    (integer? key)
    (str "(?i)" clause-name "\\s+" key)

    (or (string? key) (keyword? key))
    (str "(?i)" clause-name "\\s+\\?" (name key))

    :else nil))

(defn ^:no-doc var-key-matcher [k]
  (cond (keyword? k)
        (let [k (str "\\?" (-> k
                               name
                               (str/replace "-" "_")))]
          k)
        ;; todo pad with whitespace matcher
        (sequential? k) (str "\\s*\\(\\s*" (str/join "\\s+" (map var-key-matcher k)) "\\s*\\)")
        :else (assert false "Error replacement not expected type")))

(defn ^:no-doc key->replacer [k]
  (let [whitespace-pat "\\s+"
        values-pat "(?i)values"
        var-pat (var-key-matcher k)
        body-mat #"\{(.*?)\}"]

    (Pattern/compile (str "(" values-pat whitespace-pat var-pat whitespace-pat "\\{).*?(\\})")
                     ;; make . match newlines
                     Pattern/DOTALL)))

(defn- serialise-val [v]
  (if (= ::undef v)
    "UNDEF"
    (NTriplesUtil/toNTriplesString (rio/->backend-type v))))

(defn- ->sparql-str [k v]
  (cond
    (and (sequential? k) (sequential? v)
         (= (count k) (count v)))
    (str "(" (str/join " " (map serialise-val v)) ")")

    (and (not (sequential? k)) (not (sequential? v)))
    (serialise-val v)

    :else
    (assert false
            (str "VALUES clause keys & vals don't match up.  Key: " k " Val " v))))

(defn- rewrite-values-clauses* [q [k vals :as clause]]
  (let [regex (key->replacer k)
        values-block (str/join " " (map (partial ->sparql-str k) vals))]
    (str/replace q regex (str "$1 " values-block  " $2"))))

(defn- sequential-or-set? [c]
  (or (sequential? c) (set? c)))

(defn- rewrite-values-clauses [q bindings]
  (->> bindings
       (map (fn [[k v]]
              (cond
                (= ::undef v)
                [k [v]]

                (nil? v)
                (throw
                 (ex-info (str "nil value SPARQL binding found for key " k
                               ". Consider explicitly binding value as ::sparql/undef")
                          {:bindings bindings
                           :sparql-query q
                           :error :nil-sparql-binding}))
                :else
                [k v])))
       (filter (comp sequential-or-set? second))
       (into {})
       (reduce rewrite-values-clauses* q)))

(defn- rewrite-clauses
  "Rewrites each instance of CLAUSE (literal | ?varname) with CLAUSE
  value with the given mappings."
  [sparql-query clause-name mappings]
  (reduce (fn [memo [key val]]
            (if-let [pattern (get-clause-pattern clause-name key)]
              (str/replace memo
                           (re-pattern pattern)
                           (str clause-name " " val))
              memo))
          sparql-query
          mappings))

(defn- rewrite-limit-and-offset-clauses
  "Replaces limit and offset clauses with values supplied as maps
  against matching SPARQL ?variable names or a limit integer"
  [query-str bindings]
  (-> query-str
      (rewrite-clauses "LIMIT" (::limits bindings))
      (rewrite-clauses "OFFSET" (::offsets bindings))))

(defn- strip-comments
  "Strip comments from a SPARQL query string"
  [query-str]
  (-> (str/replace query-str
                   #"(\s+#\s*[^\n]+)|(^#\s*[^\n]+)"
                   "")
      (str/trim)))

(defn- pre-process-query [sparql-query bindings]
  (-> sparql-query
      (strip-comments)
      (rewrite-limit-and-offset-clauses bindings)
      (rewrite-values-clauses bindings)))

(s/def ::reasoning? boolean?)
(s/def ::query-opts (s/keys :req-un [::reasoning?]))
(s/def ::repo (partial instance? RepositoryConnection))
(s/def ::bindings (s/map-of keyword? any?))
(s/def ::query-args
  (s/cat :opts (s/? ::query-opts) :bind (s/? ::bindings) :repo (s/? ::repo)))

(defn ensure-sparql-file [sparql-file]
  (if (io/resource sparql-file)
    sparql-file
    (throw (ex-info "Could not find sparql file on resource path"
                    {:error :resource-file-not-found
                     :resource-path sparql-file}))))

(defmulti ^:private -query
  (fn [sparql-file & args]
    (let [{:keys [opts bind repo] :as conformed} (s/conform ::query-args args)]
      (if (s/invalid? conformed)
        conformed
        (cond-> [:sparql-file]
          opts (conj :opts)
          bind (conj :bind)
          repo (conj :repo))))))

(defmethod -query [:sparql-file]
  [sparql-file]
  (partial -query (ensure-sparql-file sparql-file)))

(defmethod -query [:sparql-file :opts]
  [sparql-file opts]
  (partial -query (ensure-sparql-file sparql-file) opts))

(defmethod -query [:sparql-file :repo]
  [sparql-file repo]
  (-query sparql-file {:reasoning? false} {} repo))

(defmethod -query [:sparql-file :bind :repo]
  [sparql-file opts bindings]
  (partial -query (ensure-sparql-file sparql-file) opts bindings))

(defmethod -query [:sparql-file :opts :repo]
  [sparql-file opts repo]
  (-query sparql-file opts {} repo))

(defmethod -query [:sparql-file :bind :repo]
  [sparql-file bindings repo]
  (-query sparql-file {:reasoning? false} bindings repo))

(defmethod -query [:sparql-file :opts :bind :repo]
  [sparql-file {:keys [reasoning?] :as opts} bindings repo]
  (let [sparql-query (slurp (resource sparql-file))
        pre-processed-qry (pre-process-query sparql-query bindings)
        prepped-query (repo/prepare-query repo pre-processed-qry nil opts)]
    (reduce (fn [pq [unbound-var val]]
              (when-not (or (sequential? val) (set? val))
                (if (and val (satisfies? rio/IRDF4jConverter val))
                  (.setBinding pq (name unbound-var) (rio/->backend-type val))
                  (throw (ex-info (str "Could not coerce nil value into SPARQL binding for variable " unbound-var)
                                  {:variable unbound-var :bindings bindings :sparql-query sparql-query}))))
              pq)
            prepped-query
            (dissoc bindings ::limits ::offsets))
    prepped-query))

(defmethod -query ::s/invalid [sparql-file & args]
  (throw
   (ex-info
    (format "Arguments did not conform to spec %s\n%s"
            ::query-args
            (s/explain-str ::query-args args))
    {:type :illegal-argument-exception
     :spec (s/explain-data ::query-args args)})))

(defn query
  "Takes a string reference to a `sparql-file` on the resource path and
  optionally a map of bindings that should map SPARQL variables from your query
  to concrete values, allowing you to restrict and customise your query.

  The `opts` map is optional. Options include:

  - `:reasoning?` `true|false` whether or not reasoning/inference should be used
  in the query. DEFAULT: `false`

  The `bindings` map is optional, and if it's not provided then the query in the
  file is run as is.

  Additionally, if your sparql query specifies a LIMIT or OFFSET the bindings
  map supports the special keys ::limits and ::offsets.  Which should be maps
  binding identifiable limits/offsets from your query to new values.

  VALUES clause bindings are supported like normal ?var bindings when there is
  just one VALUES binding.  When there are more than one, you should provide a
  vector containing the component var names as the key in the map, with a
  sequence of sequences as the values themselves.  e.g. to override a clause
  like this:

  VALUES ?a ?b { (1 2) (3 4) }

  You would provide a map that looked like this:

  {[:a :b] [[1 1] [2 2] [3 3]]}

  nil's inside the VALUES row's themselves will raise an error.

  The clojure keyword :grafter-2.rdf.sparql/undef can be used to represent a
  SPARQL UNDEF, in the bound VALUES data.

  The final argument `repo` should be the repository to query.

  If only one argument referencing a resource path to a SPARQL query then a
  partially applied function is returned. e.g.

  (def spog (query \"grafter/rdf/sparql/select-spog.sparql\"))

  (spog r) ;; ... triples ...

  (spog r {:s [(URI. \"http://s1\") (URI. \"http://s2\")]}) ;; triples for VALUES clause subjects s.

  (spog r {:s (java.net.URI. \"http://example.org/data/a-triple\")}) ;; triples for given subject s.
  "
 {:arglists '([sparql-file]
              [sparql-file opts]
              [sparql-file repo]
              [sparql-file opts repo]
              [sparql-file bindings repo]
              [sparql-file opts bindings repo])}
  ([sparql-file & args]
   (let [q (apply -query sparql-file args)]
     (if (fn? q)
       (comp repo/evaluate q)
       (repo/evaluate q)))))

(comment
  (def r (repo/resource-repo "grafter/rdf/sparql/sparql-data.trig"))

  (query "grafter/rdf/sparql/select-spog-pre-processed.sparql" {:p (java.net.URI. "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")} (->connection r))

  (query "grafter/rdf/sparql/select-spog.sparql" {:p (java.net.URI. "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")} (->connection r))

  (query "grafter/rdf/sparql/select-spog-pre-processed.sparql" r)

  ;; partial application

  (def spog (query "grafter/rdf/sparql/select-spog.sparql"))

  (spog r)

  (def pog (partial spog {:s (java.net.URI. "http://example.org/data/a-triple")}))

  (pog r)

  )

(ns ^{:added "0.12.1"}
 grafter-2.rdf4j.sparql
  "Functions for executing SPARQL queries with grafter RDF
  repositories, that support basic binding replacement etc."
  (:require [clojure.java.io :as io :refer [resource]]
            [clojure.spec.alpha :as s]
            [clojure.string :as str]
            [grafter-2.rdf4j.io :as rio]
            [grafter-2.rdf4j.repository :as repo :refer [->connection]])
  (:import java.util.regex.Pattern
           org.eclipse.rdf4j.rio.ntriples.NTriplesUtil
           org.eclipse.rdf4j.repository.RepositoryConnection))

(defn- get-clause-pattern [clause-name key]
  (cond
    (integer? key)
    (str "(?i)" clause-name "\\s+" key)

    (or (string? key) (keyword? key))
    (str "(?i)" clause-name "\\s+\\?" (name key))

    :else nil))

(defn ^:no-doc var-key-matcher [k]
  (cond (keyword? k)
        (let [k (str "\\?" (-> k
                               name
                               (str/replace "-" "_")))]
          k)
        ;; todo pad with whitespace matcher
        (sequential? k) (str "\\s*\\(\\s*" (str/join "\\s+" (map var-key-matcher k)) "\\s*\\)")
        :else (assert false "Error replacement not expected type")))

(defn ^:no-doc key->replacer [k]
  (let [whitespace-pat "\\s+"
        values-pat "(?i)values"
        var-pat (var-key-matcher k)
        body-mat #"\{(.*?)\}"]

    (Pattern/compile (str "(" values-pat whitespace-pat var-pat whitespace-pat "\\{).*?(\\})")
                     ;; make . match newlines
                     Pattern/DOTALL)))

(defn- serialise-val [v]
  (if (= ::undef v)
    "UNDEF"
    (NTriplesUtil/toNTriplesString (rio/->backend-type v))))

(defn- ->sparql-str [k v]
  (cond
    (and (sequential? k) (sequential? v)
         (= (count k) (count v)))
    (str "(" (str/join " " (map serialise-val v)) ")")

    (and (not (sequential? k)) (not (sequential? v)))
    (serialise-val v)

    :else
    (assert false
            (str "VALUES clause keys & vals don't match up.  Key: " k " Val " v))))

(defn- rewrite-values-clauses* [q [k vals :as clause]]
  (let [regex (key->replacer k)
        values-block (str/join " " (map (partial ->sparql-str k) vals))]
    (str/replace q regex (str "$1 " values-block  " $2"))))

(defn- sequential-or-set? [c]
  (or (sequential? c) (set? c)))

(defn- rewrite-values-clauses [q bindings]
  (->> bindings
       (map (fn [[k v]]
              (cond
                (= ::undef v)
                [k [v]]

                (nil? v)
                (throw
                 (ex-info (str "nil value SPARQL binding found for key " k
                               ". Consider explicitly binding value as ::sparql/undef")
                          {:bindings bindings
                           :sparql-query q
                           :error :nil-sparql-binding}))
                :else
                [k v])))
       (filter (comp sequential-or-set? second))
       (into {})
       (reduce rewrite-values-clauses* q)))

(defn- rewrite-clauses
  "Rewrites each instance of CLAUSE (literal | ?varname) with CLAUSE
  value with the given mappings."
  [sparql-query clause-name mappings]
  (reduce (fn [memo [key val]]
            (if-let [pattern (get-clause-pattern clause-name key)]
              (str/replace memo
                           (re-pattern pattern)
                           (str clause-name " " val))
              memo))
          sparql-query
          mappings))

(defn- rewrite-limit-and-offset-clauses
  "Replaces limit and offset clauses with values supplied as maps
  against matching SPARQL ?variable names or a limit integer"
  [query-str bindings]
  (-> query-str
      (rewrite-clauses "LIMIT" (::limits bindings))
      (rewrite-clauses "OFFSET" (::offsets bindings))))

(defn- strip-comments
  "Strip comments from a SPARQL query string"
  [query-str]
  (-> (str/replace query-str
                   #"(\s+#\s*[^\n]+)|(^#\s*[^\n]+)"
                   "")
      (str/trim)))

(defn- pre-process-query [sparql-query bindings]
  (-> sparql-query
      (strip-comments)
      (rewrite-limit-and-offset-clauses bindings)
      (rewrite-values-clauses bindings)))

(s/def ::reasoning? boolean?)
(s/def ::query-opts (s/keys :req-un [::reasoning?]))
(s/def ::repo (partial instance? RepositoryConnection))

(s/def ::bound-value any?)

(s/def ::binding-name (s/and keyword?
                             ;; only the keyword slug need conform
                             ;; to the regex as we ignore ns
                             #(re-matches #"[a-z,A-Z]{1}(\p{Alnum}|-|_)*" (name %))))

(s/def ::simple-binding (s/tuple ::binding-name any?))

(s/def ::same-key-and-value-arity (fn [[k v]]
                                    (let [arity (count k)]
                                      (every? #(= arity (count %))
                                              v))))

(s/def ::values-binding-pair (s/tuple
                              sequential?
                              (s/coll-of ::bound-value)))

(s/def ::values-tuple-binding (s/and ::values-binding-pair
                                     ::same-key-and-value-arity))

;; bindings are given as a map of keys (binding names) to values.
;;
;; A simple binding is for the case in a SPARQL query where we want to
;; replace a single variable e.g. `?s` with a single value e.g. a URI.
;;
;; We might do that like so {:s (URI. "http://the/uri")}
;;
;; The second case is for binding to VALUES clauses where there may be
;; multiple bindings projected into the query.
;;
;; e.g. VALUES (?s ?p) { (:some-subject rdfs:label) (:some-other-subject skos:notation) }
;;
;; This is the :values-tuple-binding case, where we spec that the
;; binding key is a tuple like [:s :p] and the value is a sequence of
;; 0 or more tuples with the same arity as the projection.
;;
;; Though these are given as a map we spec them as a coll-of tuples,
;; so we can constrain that the key arity matches the value arity,
;; within a collection of values.
(s/def ::bindings (s/coll-of
                   (s/or :simple-binding ::simple-binding
                         :values-tuple-binding ::values-tuple-binding)))

(s/def ::query-args
  (s/cat :opts (s/? ::query-opts) :bind (s/? ::bindings) :repo (s/? ::repo)))

(defn ensure-sparql-file [sparql-file]
  (if (io/resource sparql-file)
    sparql-file
    (throw (ex-info "Could not find sparql file on resource path"
                    {:error :resource-file-not-found
                     :resource-path sparql-file}))))

(defmulti ^:private -query
  (fn [sparql-file & args]
    (let [{:keys [opts bind repo] :as conformed} (s/conform ::query-args args)]
      (if (s/invalid? conformed)
        conformed
        (cond-> [:sparql-file]
          opts (conj :opts)
          bind (conj :bind)
          repo (conj :repo))))))

(defmethod -query [:sparql-file]
  [sparql-file]
  (partial -query (ensure-sparql-file sparql-file)))

(defmethod -query [:sparql-file :opts]
  [sparql-file opts]
  (partial -query (ensure-sparql-file sparql-file) opts))

(defmethod -query [:sparql-file :repo]
  [sparql-file repo]
  (-query sparql-file {:reasoning? false} {} repo))

(defmethod -query [:sparql-file :bind :repo]
  [sparql-file opts bindings]
  (partial -query (ensure-sparql-file sparql-file) opts bindings))

(defmethod -query [:sparql-file :opts :repo]
  [sparql-file opts repo]
  (-query sparql-file opts {} repo))

(defmethod -query [:sparql-file :bind :repo]
  [sparql-file bindings repo]
  (-query sparql-file {:reasoning? false} bindings repo))

(defmethod -query [:sparql-file :opts :bind :repo]
  [sparql-file {:keys [reasoning?] :as opts} bindings repo]
  (let [sparql-query (slurp (resource sparql-file))
        pre-processed-qry (pre-process-query sparql-query bindings)
        prepped-query (repo/prepare-query repo pre-processed-qry nil opts)]
    (reduce (fn [pq [unbound-var val]]
              (when-not (or (sequential? val) (set? val))
                (if (and val (satisfies? rio/IRDF4jConverter val))
                  (.setBinding pq (name unbound-var) (rio/->backend-type val))
                  (throw (ex-info (str "Could not coerce nil value into SPARQL binding for variable " unbound-var)
                                  {:variable unbound-var :bindings bindings :sparql-query sparql-query}))))
              pq)
            prepped-query
            (dissoc bindings ::limits ::offsets))
    prepped-query))

(defmethod -query ::s/invalid [sparql-file & args]
  (throw
   (ex-info
    (format "Arguments did not conform to spec %s\n%s"
            ::query-args
            (s/explain-str ::query-args args))
    {:type :illegal-argument-exception
     :spec (s/explain-data ::query-args args)})))

(defn query
  "Takes a string reference to a `sparql-file` on the resource path and
  optionally a map of bindings that should map SPARQL variables from your query
  to concrete values, allowing you to restrict and customise your query.

  The `opts` map is optional. Options include:

  - `:reasoning?` `true|false` whether or not reasoning/inference should be used
  in the query. DEFAULT: `false`

  The `bindings` map is optional, and if it's not provided then the query in the
  file is run as is.

  Additionally, if your sparql query specifies a LIMIT or OFFSET the bindings
  map supports the special keys ::limits and ::offsets.  Which should be maps
  binding identifiable limits/offsets from your query to new values.

  VALUES clause bindings are supported like normal ?var bindings when there is
  just one VALUES binding.  When there are more than one, you should provide a
  vector containing the component var names as the key in the map, with a
  sequence of sequences as the values themselves.  e.g. to override a clause
  like this:

  VALUES ?a ?b { (1 2) (3 4) }

  You would provide a map that looked like this:

  {[:a :b] [[1 1] [2 2] [3 3]]}

  nil's inside the VALUES row's themselves will raise an error.

  The clojure keyword :grafter-2.rdf.sparql/undef can be used to represent a
  SPARQL UNDEF, in the bound VALUES data.

  The final argument `repo` should be the repository to query.

  If only one argument referencing a resource path to a SPARQL query then a
  partially applied function is returned. e.g.

  (def spog (query \"grafter/rdf/sparql/select-spog.sparql\"))

  (spog r) ;; ... triples ...

  (spog r {:s [(URI. \"http://s1\") (URI. \"http://s2\")]}) ;; triples for VALUES clause subjects s.

  (spog r {:s (java.net.URI. \"http://example.org/data/a-triple\")}) ;; triples for given subject s.
  "
 {:arglists '([sparql-file]
              [sparql-file opts]
              [sparql-file repo]
              [sparql-file opts repo]
              [sparql-file bindings repo]
              [sparql-file opts bindings repo])}
  ([sparql-file & args]
   (let [q (apply -query sparql-file args)]
     (if (fn? q)
       (comp repo/evaluate q)
       (repo/evaluate q)))))

(comment
  (def r (repo/resource-repo "grafter/rdf/sparql/sparql-data.trig"))

  (query "grafter/rdf/sparql/select-spog-pre-processed.sparql" {:p (java.net.URI. "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")} (->connection r))

  (query "grafter/rdf/sparql/select-spog.sparql" {:p (java.net.URI. "http://www.w3.org/1999/02/22-rdf-syntax-ns#type")} (->connection r))

  (query "grafter/rdf/sparql/select-spog-pre-processed.sparql" r)

  ;; partial application

  (def spog (query "grafter/rdf/sparql/select-spog.sparql"))

  (spog r)

  (def pog (partial spog {:s (java.net.URI. "http://example.org/data/a-triple")}))

  (pog r)

  )

Fix #146 broaden spec to allow multi column values queries again