Skip to content

Instantly share code, notes, and snippets.

@hugoduncan
Created May 28, 2011 14:34
Show Gist options
  • Save hugoduncan/996901 to your computer and use it in GitHub Desktop.
Save hugoduncan/996901 to your computer and use it in GitHub Desktop.
Matching on map key-value pairs
(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))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment