(defmodule nemoptera_mgr
(behaviour gen_server)
(export all))
(defun start_link ()
(gen_server:start_link #(local nemoptera_mgr) 'nemoptera_mgr 'none '()))
(defun start-repo (org-name slug fossil-path)
(gen_server:call 'nemoptera_mgr
(tuple 'start (nemoptera_registry:norm-org org-name)
(nemoptera_text:to-str slug)
(nemoptera_text:to-str fossil-path))
30000))
(defun stop-repo (org-name slug)
(gen_server:call 'nemoptera_mgr
(tuple 'stop (nemoptera_registry:norm-org org-name)
(nemoptera_text:to-str slug))
30000))
(defun init (_)
(process_flag 'trap_exit 'true)
(erlang:send_after 200 (self) 'start-all)
`#(ok #M()))
(defun handle_call (message _from state)
(case message
(`#(start ,org ,slug ,path)
(case (maps:find (tuple org slug) state)
(`#(ok ,(tuple pid _old _))
(if (and (is_pid pid) (is_process_alive pid))
`#(reply ok ,state)
(start-and-reply org slug path state)))
(_ (start-and-reply org slug path state))))
(`#(stop ,org ,slug)
(let ((key (tuple org slug)))
(case (maps:find key state)
(`#(ok ,(tuple pid _path _))
(if (is_pid pid) (catch (gen_server:stop pid 'normal 3000)) 'ok)
(nemoptera_registry:delete org slug)
`#(reply ok ,(maps:remove key state)))
(_ `#(reply ok ,state)))))
(_ `#(reply unknown ,state))))
(defun handle_info (message state)
(case message
('start-all (start-all state))
(`#(EXIT ,pid ,_reason)
(case (find-pid pid state)
('none `#(noreply ,state))
(key
(let (((tuple org slug) key)
((tuple _pid path _tries) (maps:get key state)))
(logger:warning "repository ~s stopped" (list (nemoptera_site:repo-path org slug)))
(erlang:send_after 1000 (self) (tuple 'restart org slug path))
`#(noreply ,(maps:put key (tuple 'undefined path 1) state))))))
(`#(restart ,org ,slug ,path)
(case (start-child org slug path)
(`#(ok ,pid) `#(noreply ,(maps:put (tuple org slug) (tuple pid path 0) state)))
(_ `#(noreply ,state))))
(_ `#(noreply ,state))))
(defun start-all (state)
(case (catch
(nemoptera_db:q
"SELECT COALESCE(o.name,''), r.name, r.fossil_path
FROM repositories r LEFT JOIN organizations o ON o.id=r.organization_id;" '()))
(rows (when (is_list rows))
`#(noreply ,(lists:foldl #'start-row/2 state rows)))
(_ `#(noreply ,state))))
(defun start-row (row state)
(case row
(`(,org ,slug ,path)
(let ((org-name (nemoptera_registry:norm-org org)))
(case (start-child org-name (nemoptera_text:to-str slug) (nemoptera_text:to-str path))
(`#(ok ,pid)
(maps:put (tuple org-name (nemoptera_text:to-str slug)) (tuple pid (nemoptera_text:to-str path) 0) state))
(_ state))))
(_ state)))
(defun start-and-reply (org slug path state)
(case (start-child org slug path)
(`#(ok ,pid)
`#(reply ok ,(maps:put (tuple org slug) (tuple pid path 0) state)))
(`#(error ,reason) `#(reply #(error ,reason) ,state))))
(defun start-child (org slug path)
(case (catch (nemoptera_server:start_link org slug path))
(`#(ok ,pid) `#(ok ,pid))
(`#(error ,reason) `#(error ,reason))
(`#(EXIT ,reason) `#(error ,reason))
(other `#(error ,other))))
(defun find-pid (wanted state)
(let ((found (lists:filter
(lambda (entry)
(let* (((tuple _key value) entry)
((tuple pid _path _tries) value))
(=:= pid wanted)))
(maps:to_list state))))
(case found
('() 'none)
(`(,(tuple key _) . ,_) key))))
(defun handle_cast (_message state) `#(noreply ,state))
(defun terminate (_reason state)
(lists:foreach
(lambda (entry)
(let* (((tuple key value) entry)
((tuple org slug) key)
((tuple pid _path _tries) value))
(if (is_pid pid) (catch (gen_server:stop pid 'normal 2000)) 'ok)
(nemoptera_registry:delete org slug)))
(maps:to_list state))
'ok)
(defun code_change (_old state _extra) `#(ok ,state))