Skip to content

Instantly share code, notes, and snippets.

@zentrope zentrope/core.clj
Created Jan 21, 2016

Embed
What would you like to do?
core.logic scratch
(ns ls.core
(:gen-class)
(:refer-clojure :exclude [==])
(:require [clojure.core.logic :refer :all]
[clojure.core.logic.pldb :refer :all]))
;;-----------------------------------------------------------------------------
;; Interesting Links
;;
;; http://michaelrbernste.in/2013/05/12/featurec-and-maps.html
;; https://gist.github.com/martintrojer/3792630
;; http://stackoverflow.com/questions/6713424/how-do-i-express-this-in-clojure-core-logic
;;-----------------------------------------------------------------------------
;;-----------------------------------------------------------------------------
;; Finding and resolving resources
;;-----------------------------------------------------------------------------
(db-rel resource id data)
(def rdb
(db [resource :r01 {:mac "01:23:45:67:89:ab" :inet "192.168.0.1" :dns "r01.host.com"}]
[resource :r02 {:mac "06:44:23:66:99:ab" :inet "192.168.0.2" :dns "r02.host.com"}]
[resource :r03 {:mac "01:23:45:67:89:ab" :inet "10.0.1.1" :dns "r01adm.host.com"}]
[resource :r03 {:mac "01:23:45:67:89:ac" :inet "10.0.1.2" :dns "r02adm.host.com"}]
[resource :r03 {:mac "01:23:45:67:89:ab" :x 2 :inet "10.0.1.3" :dns "r02adm.host.com"}]
[resource :r03 {:mac "01:23:45:67:89:ab" :inet "10.0.1.4" :dns "r04adm.host.com"}]
))
(defn by-attr
"Return resources when any one it its attributes match 'attr'."
[attr]
(run-db* rdb [q]
(fresh [?data ?id ?mac ?inet ?dns]
(resource ?id ?data)
(conde
[(featurec ?data {:mac attr :inet ?inet :dns ?dns})]
[(featurec ?data {:mac ?mac :inet attr :dns ?dns})]
[(featurec ?data {:mac ?mac :inet ?inet :dns attr})])
(== q ?data))))
(defn attrs
"Return a unique set of values for the specified resource key."
[key]
(-> (run-db* rdb [q]
(fresh [?data ?attr]
(resource (lvar) ?data)
(featurec ?data {key ?attr})
(== q ?attr)))
(set)))
(defn macs
[]
(attrs :mac))
;;-----------------------------------------------------------------------------
;; Resources without maps.
;;-----------------------------------------------------------------------------
(db-rel asset id mac ip dns)
(def ^:private rdb2
(db [asset :r01 "01:23:45:67:89:ab" "192.168.0.1" "r01.host.com"]
[asset :r02 "06:44:23:66:99:ab" "192.168.0.2" "r02.host.com"]
[asset :r03 "01:23:45:67:89:ab" "10.0.1.1" "r01adm.host.com"]
[asset :r04 "01:23:45:67:89:ac" "10.0.1.2" "r02adm.host.com"]
[asset :r05 "01:23:45:67:89:ab" "10.0.1.3" "r02adm.host.com"]
[asset :r06 "01:23:45:67:89:ab" "10.0.1.4" "r04adm.host.com"]))
(defn find-mac
[m]
(run-db* rdb2 [q]
(fresh [?id ?mac ?ip ?dns]
(asset ?id m ?ip ?dns)
(== q {:id ?id :mac m :ip ?ip :dns ?dns}))))
(defn find-attr
[attr]
(run-db* rdb2 [q]
(fresh [?id ?mac ?ip ?dns]
(asset ?id ?mac ?ip ?dns)
(conde
[(asset attr ?mac ?ip ?dns)]
[(asset ?id attr ?ip ?dns)]
[(asset ?id ?mac attr ?dns)]
[(asset ?id ?mac ?ip attr)])
(== q {:id ?id :mac ?mac :ip ?ip :dns ?dns}))))
;;-----------------------------------------------------------------------------
;; Try that "movie metadata" thing where you have lots of info coming in
;; about stuff but the IDs are only tangentially linked. Then put them all
;; together via a search, if that's possible.
;;
;; Given various facts, each of which has one or more of X ids, Y ids,
;; and Z ids, can we start with an X id, the find related Y ids, and
;; from there, Z ids, but without an endless loop?
;;
;; Can we do this with, say, IP addresses? Servers, Apps, Devices that
;; have one or more IP addresses, that depend on IP addresses, etc?
;; Does that even make sense as a way to track things? What about
;; 'recv' IP addresses? Sure, why not?
;; -----------------------------------------------------------------------------
;;-----------------------------------------------------------------------------
;; Data Center Deployment Map
;;-----------------------------------------------------------------------------
(db-rel server p)
(db-rel app p)
(db-rel depends-on p1 p2)
(def facts
(db [server 'db.host.com]
[server 'mq1.host.com]
[server 'mq2.host.com]
[server 'mq3.host.com]
[server 'ldap.host.com]
[server 'app1.host.com]
[server 'san.host.com]
[app 'rabbit-mq]
[app 'open-ldap]
[app 'postgres]
[app 'biz-app]
[depends-on 'biz-app 'app1.host.com]
[depends-on 'app1.host.com 'san.host.com]
[depends-on 'biz-app 'rabbit-mq]
[depends-on 'rabbit-mq 'mq1.host.com]
[depends-on 'rabbit-mq 'mq2.host.com]
[depends-on 'rabbit-mq 'mq3.host.com]
[depends-on 'biz-app 'open-ldap]
[depends-on 'open-ldap 'ldap.host.com]
[depends-on 'biz-app 'postgres]
[depends-on 'postgres 'db.host.com]
[depends-on 'db.host.com 'san.host.com]))
(def dependo
;; tabled prevents infinite loops
(tabled [s r]
(conde
[(depends-on s r)]
[(fresh [svcs]
(depends-on svcs r)
(dependo s svcs))])))
(defn all-deps-for
"The things obj depends on, and the things depending on them, all
the way down."
[obj]
(with-db facts
(run* [q]
(dependo obj q))))
(defn all-users-of
"All entities that depend on obj, or depend on things that depend on
obj, all the way up."
[obj]
(with-db facts (run* [q] (dependo q obj))))
(defn resources-used-by
[obj]
(with-db facts (run* [q] (depends-on obj q))))
(defn what-uses
[obj]
(with-db facts (run* [q] (depends-on q obj))))
;;----
(defn full-deps
"Returns a tree of all the dependencies on 'obj', avoiding
cyclic dependencies."
[obj]
(letfn [(traverse [obj seen]
(let [deps (resources-used-by obj)]
(if (empty? deps)
{:node obj :deps []}
(into {:node obj}
{:deps (vec (for [d deps :while (not (contains? seen d))]
(traverse d (conj seen d))))}))))]
(traverse obj #{})))
(defn servers
[]
(with-db facts (run* [q] (server q))))
(defn apps
[]
(with-db facts (run* [q] (app q))))
(defn entities
[]
(with-db facts
(run* [q]
(fresh [x]
(conde
[(app x) (== q [x :app])]
[(server x) (== q [x :server])])))))
(defn -main
"I am not floating at the right depth."
[& args]
(println "Logic Scratch: repl only at this point."))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.