multi-version dispatched functions

gistfile1.clj

(ns version-dispatch.dispatch-test
  (:use
   clojure.test
   version-dispatch.dispatch))

(def os-hierarchy
  (-> (make-hierarchy)
      (derive :linux :os)

      ;; base distibutions
      (derive :rh-base :linux)
      (derive :debian-base :linux)
      (derive :arch-base :linux)
      (derive :suse-base :linux)
      (derive :bsd-base :linux)
      (derive :gentoo-base :linux)

      ;; distibutions
      (derive :centos :rh-base)
      (derive :rhel :rh-base)
      (derive :amzn-linux :rh-base)
      (derive :fedora :rh-base)

      (derive :debian :debian-base)
      (derive :ubuntu :debian-base)
      (derive :jeos :debian-base)

      (derive :arch :arch-base)
      (derive :gentoo :gentoo-base)
      (derive :darwin :bsd-base)
      (derive :osx :bsd-base)))

(deftest range-compare-test
  (is (neg? (range-compare ["1.2" "1.3"] ["1.0" "1.4"])))
  (is (pos? (range-compare ["1.0" "1.4"] ["1.2" "1.3"])))
  (is (zero? (range-compare ["1.2" "1.3"] ["1.2" "1.3"])))
  (is (neg? (range-compare ["1.2" "1.3"] ["1.2" "1.4"])))
  (is (neg? (range-compare ["1.3" "1.4"] ["1.2" "1.4"]))))

(deftest version-less-test
  (is (neg? (version-less "1.2" "1.3")))
  (is (pos? (version-less "1.3" "1.2")))
  (is (zero? (version-less "1.2" "1.2"))))

(deftest compare-match-test
  (testing "strings"
    (is (false? (compare-match
                 os-hierarchy
                 [{:os :ubuntu :os-version "1.2" :version "1.1"} :unused]
                 [{:os :ubuntu :os-version "1.2" :version "1.1"} :unused])))
    (is (true? (compare-match
               os-hierarchy
               [{:os :ubuntu :os-version "1.2" :version "1.1"} :unused]
               [{:os :ubuntu :os-version "1.3" :version "1.1"} :unused])))
    (is (false? (compare-match
               os-hierarchy
               [{:os :ubuntu :os-version "1.3" :version "1.1"} :unused]
               [{:os :ubuntu :os-version "1.2" :version "1.1"} :unused])))))

(defmulti-version os-ver [os os-ver ver arg] #'os-hierarchy)

(multi-version-method
    os-ver {:os :rhel :os-version "1.0" :version nil}
    [id os-version version arg]
  [arg 1])
(multi-version-method
    os-ver {:os :rh-base :os-version ["2.0" nil] :version "2.1"}
    [os os-version version arg]
  [arg 2])
(multi-version-method
    os-ver {:os :centos :os-version [nil "1.0"] :version [nil "3.1"]}
    [os os-version version arg]
  [arg 3])
(multi-version-method
    os-ver {:os :debian :os-version ["1.0" "2.0"] :version ["4.1" "4.3"]}
    [os os-version version arg]
  [arg 4])
(multi-version-method
    os-ver {:os :ubuntu :os-version ["1.0" "2.0"] :version ["4.1" "4.3"]}
    [os os-version version arg]
  [arg 5])
(multi-version-method
    os-ver {:os :ubuntu :os-version ["1.2" "1.3"] :version ["4.1" "4.3"]}
    [os os-version version arg]
  [arg 6])
(multi-version-method
    os-ver {:os :ubuntu :os-version ["1.1" "1.4"] :version ["4.1" "4.3"]}
    [os os-version version arg]
  [arg 7])

(deftest basic
  (is (:hierarchy (meta #'os-ver)))
  (is (:methods (meta #'os-ver)))
  (testing "basic dispatch"
    (is (= [::arg 1]  (os-ver :rhel "1.0" "9.9" ::arg)))
    (is (= [::arg 2]  (os-ver :rhel "3.0" "2.1" ::arg)))
    (is (= [::arg 3]  (os-ver :centos "0.9.1" "3.1" ::arg)))
    (is (= [::arg 4]  (os-ver :debian "1.9.1" "4.3" ::arg))))
  (testing "overlapped dispatch"
    (is (= [::arg 6]  (os-ver :ubuntu "1.25" "4.2" ::arg)))))

(ns version-dispatch.dispatch
  "Dispatch that is version aware.

The basic idea is that you wish to dispatch on hierarchy where the dispatched
data may provide a version.")

(defn ^{:internal true} hierarchy-vals
  "Returns all values in a hierarchy, whether parents or children."
  [hierarchy]
  (set
   (concat
    (keys (:parents hierarchy))
    (keys (:descendants hierarchy)))))

(defn range-compare
  "Compare two version ranges"
  [[l1 u1] [l2 u2]]
  (cond
    (and (= l1 l2) (= u1 u2)) 0
    (= l1 l2) (compare u1 u2)
    (= u1 u2) (compare l2 l1)
    (and (not (neg? (compare l1 l2)))
         (not (neg? (compare u2 l1)))) -1
    (and (not (neg? (compare u1 l2)))
         (not (neg? (compare u2 u1)))) -1
    (and (not (neg? (compare l2 l1)))
         (not (neg? (compare u1 l2)))) 1
    (and (not (neg? (compare u2 l1)))
         (not (neg? (compare u1 u2)))) 1
    :else 0))

(defn version-less [vi vj]
  (cond
    (and (string? vi)(string? vj)) (compare vi vj)
    (string? vi) -1
    (string? vj) 1

    (and (every? identity vi) (every? identity vj))
    (range-compare vi vj)

    (every? identity vi) -1
    (every? identity vj) 1
    :else 0))

(defn compare-match [hierarchy [i _] [j _]]
  (let [osi (:os i)
        os-versioni (:os-version i)
        versioni (:version i)
        osj (:os j)
        os-versionj (:os-version j)
        versionj (:version j)]
    (cond
      (and (isa? hierarchy osi osj) (not (isa? hierarchy osj osi))) true
      (and (isa? hierarchy osj osi) (not (isa? hierarchy osi osj))) false
      :else (let [l1 (version-less os-versioni os-versionj)]
              (if (zero? l1)
                (neg? (version-less versioni versionj))
                (neg? l1))))))

(defn ^{:internal true} dispatch-version
  [os os-version version args hierarchy methods]
  (letfn [(version-matches? [version v]
            (cond
              (string? v) (.startsWith version v)
              (vector? v) (let [[from to] v]
                            (and (or (nil? from)
                                     (not (pos? (compare from version))))
                                 (or (nil? to)
                                     (not (neg? (compare to version))))))
              (nil? v) true))
          (matches? [[i _]]
            (and (isa? hierarchy os (:os i))
                 (version-matches? os-version (:os-version i))
                 (version-matches? version (:version i))))]
    (if-let [[_ f] (first (sort
                           (comparator (partial compare-match hierarchy))
                           (filter matches? methods)))]
      (apply f os os-version version args)
      (if-let [f (:default methods)]
        (apply f os os-version version args)
        (throw (IllegalArgumentException.
                (str "No method for " os " " os-version " " version)))))))

(defmacro defmulti-version
  "Defines a multi-version funtion used to abstract over an operating system
hierarchy, where dispatch includes an optional `os-version`. The `version`
refers to a software package version of some sort, on the specified `os` and
`os-version`."
  {:indent 2}
  [name [os os-version version & args] hierarchy-place]
  `(do
     (let [h# ~hierarchy-place
           m# (atom {})]
       (defn ~name
         {:hierarchy h# :methods m#}
         [~os ~os-version ~version ~@args]
         (dispatch-version
          ~os ~os-version ~version [~@args] (var-get h#) @m#)))))

(defmacro multi-version-method
  "Adds a method to the specified multi-version function for the specified
`dispatch-value`."
  {:indent 3}
  [multi-version {:keys [os os-version version] :as dispatch-value}
   [& args] & body]
  (let [{:keys [hierarchy methods]} (meta (resolve multi-version))
        h (var-get hierarchy)]
    (when-not ((hierarchy-vals h) os)
      (throw (Exception. (str os " is not part of the hierarchy"))))
    `(swap! (:methods (meta (var ~multi-version))) assoc ~dispatch-value
            (fn ~(symbol (str (name os) "-" os-version "-" version)) [~@args]
              ~@body))))

An open question for me here is version normalization. If someone says this is ubuntu oniric, how do we go from this to a version number that can be compared to.

The other question is about whether / how something like this could be extended to packages, and then relationships between versions. E.g. this version of this requires such version of that...

The final question is how to use this to generate version numbers. For example, I want to download a file based on a particular version of OS. I need the version number with certain format (e.g. codename instead of version number).