How to do hooks in Clojure - clojure

I have a situation where I am creating and destroying objects in one clojure namespace, and want another namespace to co-ordinate. However I do not want the first namespace to have to call the second explicitly on object destruction.
In Java, I could use a listener. Unfortunately the underlying java libraries do not signal events on object destruction. If I were in Emacs-Lisp, then I'd use hooks which do the trick.
Now, in clojure I am not so sure. I have found the Robert Hooke library https://github.com/technomancy/robert-hooke. But this is more like defadvice in elisp terms -- I am composing functions. More over the documentation says:
"Hooks are meant to extend functions you don't control; if you own the target function there are obviously better ways to change its behaviour."
Sadly, I am not finding it so obvious.
Another possibility would be to use add-watch, but this is marked as alpha.
Am I missing another obvious solution?
Example Added:
So First namespace....
(ns scratch-clj.first
(:require [scratch-clj.another]))
(def listf (ref ()))
(defn add-object []
(dosync
(ref-set listf (conj
#listf (Object.))))
(println listf))
(defn remove-object []
(scratch-clj.another/do-something-useful (first #listf))
(dosync
(ref-set listf (rest #listf)))
(println listf))
(add-object)
(remove-object)
Second namespace
(ns scratch-clj.another)
(defn do-something-useful [object]
(println "object removed is:" object))
The problem here is that scratch-clj.first has to require another and explicitly push removal events across. This is a bit clunky, but also doesn't work if I had "yet-another" namespace, which also wanted to listen.
Hence I thought of hooking the first function.

Is this solution suitable to your requirements?
scratch-clj.first:
(ns scratch-clj.first)
(def listf (atom []))
(def destroy-listeners (atom []))
(def add-listeners (atom []))
(defn add-destroy-listener [f]
(swap! destroy-listeners conj f))
(defn add-add-listener [f]
(swap! add-listeners conj f))
(defn add-object []
(let [o (Object.)]
(doseq [f #add-listeners] (f o))
(swap! listf conj o)
(println #listf)))
(defn remove-object []
(doseq [f #destroy-listeners] (f (first #listf)))
(swap! listf rest)
(println #listf))
Some listeners:
(ns scratch-clj.another
(:require [scratch-clj.first :as fst]))
(defn do-something-useful-on-remove [object]
(println "object removed is:" object))
(defn do-something-useful-on-add [object]
(println "object added is:" object))
Init binds:
(ns scratch-clj.testit
(require [scratch-clj.another :as another]
[scratch-clj.first :as fst]))
(defn add-listeners []
(fst/add-destroy-listener another/do-something-useful-on-remove)
(fst/add-add-listener another/do-something-useful-on-add))
(defn test-it []
(add-listeners)
(fst/add-object)
(fst/remove-object))
test:
(test-it)
=> object added is: #<Object java.lang.Object#c7aaef>
[#<Object java.lang.Object#c7aaef>]
object removed is: #<Object java.lang.Object#c7aaef>
()

It sounds a lot like what you're describing is callbacks.
Something like:
(defn make-object
[destructor-fn]
{:destructor destructor-fn :other-data "data"})
(defn destroy-object
[obj]
((:destructor obj) obj))
; somewhere at the calling code...
user> (defn my-callback [o] (pr [:destroying o]))
#'user/my-callback
user> (destroy-object (make-object my-callback))
[:destroying {:destructor #<user$my_callback user$my_callback#73b8cdd5>, :other-data "data"}]
nil
user>

So, here is my final solution following mobytes suggestion. A bit more work, but
I suspect that I will want this in future.
Thanks for all the help
;; hook system
(defn make-hook []
(atom []))
(defn add-hook [hook func]
(do
(when-not
(some #{func} #hook)
(swap! hook conj func))
#hook))
(defn remove-hook [hook func]
(swap! hook
(partial
remove #{func})))
(defn clear-hook [hook]
(reset! hook []))
(defn run-hook
([hook]
(doseq [func #hook] (func)))
([hook & rest]
(doseq [func #hook] (apply func rest))))
(defn phils-hook []
(println "Phils hook"))
(defn phils-hook2 []
(println "Phils hook2"))
(def test-hook (make-hook))
(add-hook test-hook phils-hook)
(add-hook test-hook phils-hook2)
(run-hook test-hook)
(remove-hook test-hook phils-hook)
(run-hook test-hook)

Related

How to write a Decorator for a Reagent component

I have some similar reagent components, that can render a given number in certain ways:
(defn plain-number [n]
[:h1 n])
(defn pie-chart [n]
(render-fancy-chart n))
And there is some (simplified) state:
(def state (r/atom {:a 5 :b 10 :c 7}))
And I know how to write a component, that can access that state and use one of the components to render the state:
(def fetch-and-render-pie [k]
(let [v (get #state k)]
[pie-chart v]))
[fetch-and-render-pie :a] ; renders pie with 5
So far, so good. But that's coupled and repetitive.
The Goal:
A decorator would be nice, that can fetch some state and pass it to the children. The usage would look something like this:
[fetch :a
[pie-chart]]
Possible Solution:
(defn fetch [k wrapped]
(let [v (get #state k)]
(conj wrapped v)))
This worked, but it messes with the vector of the component definition and it assumes a lot of the wrapped component's arguments. And it failed for chained decorators.
There must be a clever and robust solution out there. Any ideas?
You can't rid of assumptions about arguments of decorated component just because you pass one to it and should know how to do it the same way as with function call. But you have no need to pass vector to your decorator, just a component itself should work:
(defn fetch [k component]
(let [v (get #state k)]
[component v]))
[fetch :test pie-chart] ; ~ [pie-chart (get #state :test)]
For chaining you'd want to support extra args for component:
(defn fetch [k component & args]
(let [v (get #state k)]
(into [component v] args)))
(defn prepare [s component & args]
(let [v (keyword s)]
(into [component v] args)))
[prepare "test" fetch pie-chart {:colourful true}]
; ~ [pie-chart (get #state (keyword "test")) {:colourful true}]
This resembles HOFs and threading macros a little bit.
with reagent only, we could use cursor
(defn com-a [state]
(fn []
[:h1 #state]))
(defn fetch [db]
(let [state (reagent/cursor db :k)] ; assume {:k "dd"}
(fn []
[com-a state])))
with re-frame
(re-frame/reg-sub
:chart-data
(fn [db [_ query]]
(get-in db query)))
(defn com-a [state]
(fn []
[:h1 #state]))
(defn fetch [db]
(let [state (re-frame/subscribe [:chart-data [:k]])]
(fn []
[com-a state])))

how are swap! and the mmap function working here?

This is a snippet from the Reagent project. Looking at complete-all and clear-done, I understand the point is to swap out the modified map. I don't understand how it's being done. The definition of mmap calls for 3 parameters — and complete-all seems to be calling it with two, namely map and #(assoc-in % [1 :done] v). clear-done calls with remove and #(get-in % [1 :done]). I tried using the repl to experiment but couldn't get the requires to work out.
(ns todomvc.core
(:require [reagent.core :as r]))
(defonce todos (r/atom (sorted-map)))
(defonce counter (r/atom 0))
(defn add-todo [text]
(let [id (swap! counter inc)]
(swap! todos assoc id {:id id :title text :done false})))
(defn toggle [id] (swap! todos update-in [id :done] not))
(defn save [id title] (swap! todos assoc-in [id :title] title))
(defn delete [id] (swap! todos dissoc id))
(defn mmap [m f a] (->> m (f a) (into (empty m))))
(defn complete-all [v] (swap! todos mmap map #(assoc-in % [1 :done] v)))
(defn clear-done [] (swap! todos mmap remove #(get-in % [1 :done])))
The existing map is passed as the first argument to the function. When all else fails...

Using with-redefs inside a doseq

I have a Ring handler which uses several functions to build the response. If any of these functions throw an exception, it should be caught so a custom response body can be written before returning a 500.
I'm writing the unit test for the handler, and I want to ensure that an exception thrown by any of these functions will be handled as described above. My instinct was to use with-redefs inside a doseq:
(doseq [f [ns1/fn1 ns1/fn2 ns2/fn1]]
(with-redefs [f (fn [& args] (throw (RuntimeException. "fail!"))]
(let [resp (app (request :get "/foo")))))]
(is (= (:status resp) 500))
(is (= (:body resp) "Something went wrong")))))
Of course, given that with-redefs wants to change the root bindings of vars, it is treating f as a symbol. Is there any way to get it to rebind the var referred to by f? I suspect that I'm going to need a macro to accomplish this, but I'm hoping that someone can come up with a clever solution.
with-redefs is just sugar over repeated calls to alter-var-root, so you can just write the desugared form yourself, something like:
(doseq [v [#'ns1/fn1 #'ns1/fn2 #'ns2/fn1]]
(let [old #v]
(try
(alter-var-root v (constantly (fn [& args]
(throw (RuntimeException. "fail!")))))
(let [resp (app (request :get "/foo")))
(is (= (:status resp) 500))
(is (= (:body resp) "Something went wrong")))
(finally (alter-var-root v (constantly old))))))
Following on from amalloy's great answer, here's a utility function that I wrote to use in my tests:
(defn with-mocks
"Iterates through a list of functions to-mock, rebinding each to mock-fn, and calls
test-fn with the optional test-args.
Example:
(defn foobar [a b]
(try (+ (foo a) (bar b))
(catch Exception _ 1)))
(deftest test-foobar
(testing \"Exceptions are handled\"
(with-mocks
[#'foo #'bar]
(fn [& _] (throw (RuntimeException. \"\")))
(fn [a b] (is (= 1 (foobar a b)))) 1 2)))"
[to-mock mock-fn test-fn & test-args]
(doseq [f to-mock]
(let [real-fn #f]
(try
(alter-var-root f (constantly mock-fn))
(apply test-fn test-args)
(finally
(alter-var-root f (constantly real-fn)))))))

how to separate concerns in the below fn

The function below does 2 things -
Checks if the atom is nil or fetch-agin is true, and then fetches the data.
It processes the data by calling (add-date-strings).
What is a better pattern to separate out the above two concerns ?
(def retrieved-data (atom nil))
(defn fetch-it!
[fetch-again?]
(if (or fetch-again?
(nil? #retrieved-data))
(->> (exec-services)
(map #(add-date-strings (:time %)))
(reset! retrieved-data))
#retrieved-data))
One possible refactoring would be:
(def retrieved-data (atom nil))
(defn fetch []
(->> (exec-services)
(map #(add-date-strings (:time %)))))
(defn fetch-it!
([]
(fetch-it! false))
([force]
(if (or force (nil? #retrieved-data))
(reset! retrieved-data (fetch))
#retrieved-data)))
By the way, the pattern to seperate out concerns is called "functions" :)
To really separate the concerns I think it might be better to define a separate fetch and process function. So that in no way they are complected.
(def retrieved-data (atom nil))
(defn fetcher []
(->> (exec-services)
(map #(add-date-strings (:time %)))))
(defn fetch-again? [force]
(fn [data] (or force (nil? data))))
(defn fetch-it! [fetch-fn data fetch-again?]
(when (fetch-again? #data))
(reset! data (fetch-fn))))
;;Usage
(fetch-it! fetcher retrieved-data (fetch-again? true))
Notice that I also gave the data atom as an argument.

Let over lambda block-scanner in clojure

I have just start reading Let over lambda and I thought I would try and write a clojure version of the block-scanner in the closures chapter.
I have the following so far:
(defn block-scanner [trigger-string]
(let [curr (ref trigger-string) trig trigger-string]
(fn [data]
(doseq [c data]
(if (not (empty? #curr))
(dosync(ref-set curr
(if (= (first #curr) c)
(rest #curr)
trig)))))
(empty? #curr))))
(def sc (block-scanner "jihad"))
This works I think, but I would like know what I did right and what I could do better.
I would not use ref-set but alter because you don't reset the state to a completely new value, but update it to a new value which is obtained from the old one.
(defn block-scanner
[trigger-string]
(let [curr (ref trigger-string)
trig trigger-string]
(fn [data]
(doseq [c data]
(when (seq #curr)
(dosync
(alter curr
#(if (-> % first (= c))
(rest %)
trig)))))
(empty? #curr))))
Then it is not necessary to use refs since you don't have to coordinate changes. Here an atom is a better fit, since it can be changed without all the STM ceremony.
(defn block-scanner
[trigger-string]
(let [curr (atom trigger-string)
trig trigger-string]
(fn [data]
(doseq [c data]
(when (seq #curr)
(swap! curr
#(if (-> % first (= c))
(rest %)
trig))))
(empty? #curr))))
Next I would get rid of the imperative style.
it does more than it should: it traverses all data - even if we found a match already. We should stop early.
it is not thread-safe, since we access the atom multiple times - it might change in between. So we must touch the atom only once. (Although this is probably not interesting in this case, but it's good to make it a habit.)
it's ugly. We can do all the work functionally and just save the state, when we come to a result.
(defn block-scanner
[trigger-string]
(let [state (atom trigger-string)
advance (fn [trigger d]
(when trigger
(condp = d
(first trigger) (next trigger)
; This is maybe a bug in the book. The book code
; matches "foojihad", but not "jijihad".
(first trigger-string) (next trigger-string)
trigger-string)))
update (fn [trigger data]
(if-let [data (seq data)]
(when-let [trigger (advance trigger (first data))]
(recur trigger (rest data)))
trigger))]
(fn [data]
(nil? (swap! state update data)))))