Merge PR #985

yesodweb · Apr 27, 2024 · efa8e3b · efa8e3b
2 parents e6fdd9f + fc127e6
commit efa8e3b
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 2 deletions.
diff --git a/auto-update/ChangeLog.md b/auto-update/ChangeLog.md
@@ -1,5 +1,11 @@
 # ChangeLog for auto-update
 
+## 0.2.0
+
+* Add `reaperModify` to the `Reaper` API, allowing workload modification outside
+  of the main `reaperAction` loop.
+  [#985](https://github.com/yesodweb/wai/pull/985)
+
 ## 0.1.6
 
 * Add control of activation on leading vs. trailing edges for Control.Debounce

diff --git a/auto-update/Control/Reaper.hs b/auto-update/Control/Reaper.hs
@@ -109,6 +109,20 @@ data Reaper workload item = Reaper
     -- ^ Adding an item to the workload
     , reaperRead :: IO workload
     -- ^ Reading workload.
+    , reaperModify :: (workload -> workload) -> IO workload
+    -- ^ Modify the workload. The resulting workload is returned.
+    --
+    --   If there is no reaper thread, the modifier will not be applied and
+    --   'reaperEmpty' will be returned.
+    --
+    --   If the reaper is currently executing jobs, those jobs will not be in
+    --   the given workload and the workload might appear empty.
+    --
+    --   If all jobs are removed by the modifier, the reaper thread will not be
+    --   killed. The reaper thread will only terminate if 'reaperKill' is called
+    --   or the result of 'reaperAction' satisfies 'reaperNull'.
+    --
+    --  @since 0.2.0
     , reaperStop :: IO workload
     -- ^ Stopping the reaper thread if exists.
     --   The current workload is returned.
@@ -136,6 +150,7 @@ mkReaper settings@ReaperSettings{..} = do
         Reaper
             { reaperAdd = add settings stateRef tidRef
             , reaperRead = readRef stateRef
+            , reaperModify = modifyRef stateRef
             , reaperStop = stop stateRef
             , reaperKill = kill tidRef
             }
@@ -145,6 +160,13 @@ mkReaper settings@ReaperSettings{..} = do
         case mx of
             NoReaper -> return reaperEmpty
             Workload wl -> return wl
+    modifyRef stateRef modifier = atomicModifyIORef' stateRef $ \mx ->
+        case mx of
+            NoReaper ->
+              (NoReaper, reaperEmpty)
+            Workload wl ->
+              let !wl' = modifier wl
+               in (Workload wl', wl')
     stop stateRef = atomicModifyIORef' stateRef $ \mx ->
         case mx of
             NoReaper -> (NoReaper, reaperEmpty)

diff --git a/auto-update/auto-update.cabal b/auto-update/auto-update.cabal
@@ -1,5 +1,5 @@
 name:                auto-update
-version:             0.1.6
+version:             0.2.0
 synopsis:            Efficiently run periodic, on-demand actions
 description:         API docs and the README are available at <http://www.stackage.org/package/auto-update>.
 homepage:            https://github.com/yesodweb/wai

diff --git a/warp/warp.cabal b/warp/warp.cabal
@@ -39,7 +39,7 @@ Flag x509
 Library
   Build-Depends:     base                      >= 4.12       && < 5
                    , array
-                   , auto-update               >= 0.1.3    && < 0.2
+                   , auto-update               >= 0.2      && < 0.3
                    , bsb-http-chunked                         < 0.1
                    , bytestring                >= 0.9.1.4
                    , case-insensitive          >= 0.2