liminix/pkgs/devout/devout.fnl

(local sock (require :minisock))
(local { : view } (require :fennel))

(fn trace [expr]
  (doto expr (print :TRACE (view expr))))

(fn parse-uevent [s]
  (let [at (string.find s "@" 1 true)
        (nl nxt) (string.find s "\0" 1 true)]
    (doto
        (collect [k v (string.gmatch
                       (string.sub s (+ 1 nxt))
                       "(%g-)=(%g+)")]
          (k:lower) v)
      (tset :path (string.sub s (+ at 1) (- nl 1))))))

(fn event-matches? [e terms]
  (accumulate [match? true
               name value (pairs terms)]
    (and match? (= value (. e name)))))

(fn find-in-database [db terms]
  (accumulate [found []
               _ e (pairs db)]
    (if (event-matches? e terms)
        (doto found (table.insert e))
        found)))

(fn record-event [db subscribers str]
  (let [e (parse-uevent str)]
    (match e.action
      :add (tset db e.path e)
      :change (tset db e.path e)
      ;; should we do something for bind?
      :remove (tset db e.path nil)
      )
    (each [_ { : terms : callback } (pairs subscribers)]
      (if (event-matches? e terms) (callback e)))
    e))

(fn database []
  (let [db {}
        subscribers []]
    {
     :find (fn [_ terms] (find-in-database db terms))
     :add (fn [_ event-string] (record-event db subscribers event-string))
     :at-path (fn [_ path] (. db path))
     :subscribe (fn [_ id callback terms]
                  (tset subscribers id {: callback : terms }))
     :unsubscribe (fn [_ id] (tset subscribers id nil))
     }))

;; #define POLLIN          0x0001
;; #define POLLPRI         0x0002
;; #define POLLOUT         0x0004
;; #define POLLERR         0x0008
;; #define POLLHUP         0x0010
;; #define POLLNVAL        0x0020

(fn unix-socket [name]
  (let [addr (.. "\1\0"  name  "\0\0\0\0\0")
        (sock err) (sock.bind addr)]
    (assert sock err)))

(fn pollfds-for [fds]
  (table.concat (icollect [_ v (ipairs fds)] (string.pack "iHH" v 1 0))))

(fn unpack-pollfds [pollfds]
  (var i 1)
  (let [fds {}]
    (while (< i (# pollfds))
      (let [(fd _ revents i_) (string.unpack "iHH" pollfds i)]
        (if (> revents 0) (tset fds fd revents))
        (set i i_)))
    fds))

(fn parse-terms [str]
  (print :terms str)
  (collect [n (string.gmatch str "([^ ]+)")]
    (string.match n "(.-)=(.+)")))

(fn handle-client [db client]
  (match (trace (sock.read client))
    "" (do
         (db:unsubscribe client)
         false)
    s (do
        (db:subscribe
         client
         (fn [e]
           (sock.write client (view e)))
         (parse-terms s))
        true)
    (nil err) (do (print err) false)))

(fn event-loop []
  (let [fds {}]
    {
     :register #(tset fds $2 $3)
     :feed (fn [_ revents]
             (each [fd revent (pairs revents)]
               (when (not ((. fds fd) fd))
                 (tset fds fd nil)
                 (sock.close fd))))
     :fds #(icollect [fd _ (pairs fds)] fd)
    :_tbl #(do fds)                    ;exposed for tests
     }))

(fn run []
  (let [[sockname] arg
        s (unix-socket sockname)
        db (database)
        loop (event-loop)]
    (loop:register
     s
     #(match (sock.accept s)
        (client addr)
        (do
          (loop:register client (partial handle-client db))
          true)))
    (while true
      (let [pollfds (pollfds-for (loop:fds))
            (rpollfds numfds) (sock.poll pollfds 1000)]
        (when (> numfds 0)
          (loop:feed (unpack-pollfds rpollfds)))))))

{ : database : run : event-loop  }