Matching on map key-value pairs

gistfile1.clj

(ns pallet.nodes
 "Node templates. Provide node size and image selection for pallet."
 (:require
  [clojure.core.logic.match :as match]
  [clojure.core.logic.minikanren :as mk]
  [clojure.core.logic.prelude :as prelude])
 (:use
  clojure.test))

(def spec-data
  [[{:os-family :fedora} :aws {:image-id "1"}]
   [{:os-family :ubuntu} :aws {:image-id "1"}]
   [{:os-family :fedora :other 1} :gogrid {:image-id "2"}]])

(defmacro handle-clauses [t as]
  `(~t
   ~@(map
      (match/handle-clause as)
      (map list spec-data))))

(defn template-specs [spec-when provider node-spec]
  (handle-clauses mk/conde [spec-when provider node-spec]))

;; The above is equivalent to this
;; (prelude/defne template-specs [spec-when provider node-spec]
;;   ([{:os-family :fedora} :aws {:image-id "1"}])
;;   ([{:os-family :ubuntu} :aws {:image-id "1"}])
;;   ([{:os-family :fedora :other 1} :gogrid {:image-id "2"}]))

(defn members
  "Checks that all map entries in x are in l. Other keys may exist in l.
   Equivalent of (= x (select-keys l (keys x)))."
  [x l]
  (mk/conde
   ((mk/== '() x))
   ((mk/exist [f r]
              (prelude/firsto x f)
              (prelude/membero f l)
              (prelude/resto x r)
              (members r l)))))

(prelude/defne spec-for [in-spec provider out]
  ([_ _ ?out] (mk/exist
               [w]
               (template-specs w provider ?out)
               (members w (seq in-spec)))))

(defn template-for [in-spec provider]
  (merge in-spec
         (into {}
               (apply concat
                      (mk/run* [q] (spec-for in-spec provider q))))))

(deftest spec-for-tests
  (is (= [[[:image-id "1"]]]
         (mk/run* [q] (spec-for {:os-family :fedora} :aws q))))
  (is (= [[[:image-id "1"]]]
         (mk/run* [q] (spec-for {:os-family :ubuntu :extra 1} :aws q))))
  (is (= []
         (mk/run* [q w] (spec-for {:os-family :fedora} :rackspace q))))
  (is (= [[[:image-id "2"]]]
         (mk/run* [q w] (spec-for {:os-family :fedora :other 1} :gogrid q)))))

(deftest template-for-tests
  (is (= {:os-family :fedora :image-id "1"}
         (template-for {:os-family :fedora} :aws)))
  (is (= {:image-id "1" :os-family :ubuntu :extra 1}
         (template-for {:os-family :ubuntu :extra 1} :aws)))
  (is (= {:os-family :fedora}
         (template-for {:os-family :fedora} :rackspace)))
  (is (= {:os-family :fedora :other 1 :image-id "2"}
         (template-for {:os-family :fedora :other 1} :gogrid))))