Created
May 28, 2011 14:34
-
-
Save hugoduncan/996901 to your computer and use it in GitHub Desktop.
Matching on map key-value pairs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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