From 64edaa2cc772f140f4bff6ae4c09807216152e37 Mon Sep 17 00:00:00 2001
From: James Sully <sullyj3@gmail.com>
Date: Thu, 1 Aug 2024 18:31:24 +1000
Subject: [PATCH] stop leaking processes

---
 src/Sand/Basic.lean      |  7 ++++---
 src/Sand/SandDaemon.lean | 14 +++++++-------
 2 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/Sand/Basic.lean b/src/Sand/Basic.lean
index 1e63ade..acb9acb 100644
--- a/src/Sand/Basic.lean
+++ b/src/Sand/Basic.lean
@@ -54,8 +54,8 @@ def timersForClient
 def nullStdioConfig : IO.Process.StdioConfig := ⟨.null, .null, .null⟩
 def SimpleChild : Type := IO.Process.Child nullStdioConfig
 
-def runCmdSimple (cmd : String) (args : Array String := #[]) : IO SimpleChild :=
-  IO.Process.spawn
+def runCmdSimple (cmd : String) (args : Array String := #[]) : IO Unit := do
+  let child ← IO.Process.spawn
     { cmd := cmd,
       args := args,
 
@@ -63,8 +63,9 @@ def runCmdSimple (cmd : String) (args : Array String := #[]) : IO SimpleChild :=
       stdout := .null,
       stderr := .null,
     }
+  _ ← (child.wait).asTask .dedicated
 
-def notify (message : String) : IO SimpleChild :=
+def notify (message : String) : IO Unit := do
   -- TODO wrap libnotify with FFI so we can do this properly
   runCmdSimple "notify-send" #[message]
 
diff --git a/src/Sand/SandDaemon.lean b/src/Sand/SandDaemon.lean
index 6063502..2fcc393 100644
--- a/src/Sand/SandDaemon.lean
+++ b/src/Sand/SandDaemon.lean
@@ -30,11 +30,11 @@ def usrshareSoundLocation : OptionT BaseIO FilePath := do
   guard (← path.pathExists)
   pure path
 
+-- TODO we should probably just load this once at startup, rather than
+-- every time we attempt to play sound
 def playTimerSound : IO Unit := do
   let soundPath? ← liftM (xdgSoundLocation <|> usrshareSoundLocation).run
   let some soundPath := soundPath? | do
-    -- TODO we should probably just print this once at startup, rather than
-    -- every time we attempt to play sound
     IO.eprintln "Warning: failed to locate notification sound. Audio will not work"
     return ()
 
@@ -60,8 +60,8 @@ abbrev CmdHandlerT (m : Type → Type) : Type → Type := ReaderT CmdHandlerEnv
 instance monadLiftReaderT [MonadLift m n] : MonadLift (ReaderT σ m) (ReaderT σ n) where
   monadLift action := λ r => liftM <| action.run r
 
-def ReaderT.asTask (action : ReaderT σ IO α) : ReaderT σ IO (Task (Except IO.Error α)) :=
-  controlAt IO λ runInBase ↦ (runInBase action).asTask
+def ReaderT.asTask (action : ReaderT σ IO α) (prio := Task.Priority.default) : ReaderT σ IO (Task (Except IO.Error α)) :=
+  controlAt IO λ runInBase ↦ (runInBase action).asTask prio
 
 def pauseTimer
   (timerId : TimerId)
@@ -130,7 +130,7 @@ def resumeTimer (timerId : TimerId)
     | .running _ => return .alreadyRunning
     | .paused remaining => do
       let newDueTime : Moment := clientConnectedTime + remaining
-      let countdownTask ← IO.asTask <| (countdown timerId newDueTime).run env
+      let countdownTask ← (countdown timerId newDueTime).run env |>.asTask .dedicated
       let newTimerstate := .running countdownTask
       let newTimer := {timer with due := newDueTime}
       let timers' : Timers := timers.insert timerId (newTimer, newTimerstate)
@@ -157,7 +157,7 @@ def addTimer (duration : Duration) : CmdHandlerT IO Unit := do
   let id : TimerId ←
     TimerId.mk <$> state.nextTimerId.atomically (getModify Nat.succ)
   let timer : Timer := {id, due}
-  let countdownTask ← (countdown id due).asTask
+  let countdownTask ← (countdown id due).asTask .dedicated
 
   state.timers.atomically <| modify (·.insert id (timer, .running countdownTask))
 
@@ -236,7 +236,7 @@ def SandDaemon.main (_args : List String) : IO α := do
 
   forever do
     let (client, _clientAddr) ← sock.accept
-    let _tsk ← IO.asTask <| do
+    let _tsk ← IO.asTask (prio := .dedicated) <| do
       let clientConnectedTime ← Moment.mk <$> IO.monoMsNow
       let env := {state, client, clientConnectedTime}
       handleClient.run env