(chapter-start 'nydp/hooks "event management - execute a piece of code when something happens")

(let hooks {}
  ;; return the list of hook-names
  (def hook-names ()
    (hash-keys hooks))

  ;; return the list of hooks for 'hook-name
  (def hooks-for (hook-name)
    hooks.,hook-name)

  ;; add a function 'f to execute when 'hook-name is fired
  (def add-hook (hook-name f)
    (hash-cons hooks hook-name f))

  ;; remove all hooks for 'hook-name
  (def clear-hooks (hook-name)
    (= hooks.,hook-name nil))

  ;; temporarily remove all hooks for 'hook-name, restoring them after running 'f
  (def without-hooks (hook-name f)
    (let previous-hooks (hooks-for hook-name)
      (ensure (= hooks.,hook-name previous-hooks)
              (clear-hooks hook-name)
              (f))))

  ;; only works if you have a reference to the original function
  (def remove-hook (hook-name f)
    (= hooks.,hook-name
       (collect (curry !eq? f)
               hooks.,hook-name)))

  ;; apply all functions attached to 'hook-name to given 'args
  (def run-hooks (hook-name . args)
    (each hook (hooks-for hook-name)
          (apply hook args))))

;; install a hook for a particular kind of event
;;
;; example
;; (on transaction (account amount) (update account total (+ account.total amount)))
;;
;; same as (add-hook 'transaction (fn (account amount) (update account total (+ account.total amount))))
;;
;; if 'body is a symbol and 'args is nil, for example
;;
;; (on transaction () notify)
;;
;; 'notify must be a predefined function accepting any arguments to the 'transaction event ; the example is equivalent to
;;
;; (add-hook 'transaction (fn args (apply notify args)))
;;
;; or more simply
;;
;; (add-hook 'transaction (fn (account amount) (notify account amount)))
;;
(mac on (event args . body)
  (let hookfn (if (isa 'symbol (car body))
                  (car body)
                  `(fn ,args ,@body))
    (w/uniq dox-item
      `(let ,dox-item (or (car:dox-lookup ',event)
                          (dox-add-doc ',event 'hook))
         (add-hook ',event ,hookfn)
         (hash-cons ,dox-item 'hooks
            { src      ',hookfn
              args     ',args
              chapter  (chapter-current)
              file     this-script
              plugin   this-plugin })))))

(let super warnings/new
  (def warnings/new (kind . info)
    ; enhance original warnings/new to run the 'warnings/new hook
    (chapter nydp/warnings)
    (apply super kind info)
    (run-hooks 'warnings/new (cons kind info))))

(on warnings/new w (apply p w))