creating Reaper.Internal

yesodweb · Apr 27, 2024 · 2a7399f · 2a7399f
1 parent 777bc65
commit 2a7399f
Show file tree

Hide file tree

Showing 5 changed files with 47 additions and 37 deletions.
diff --git a/auto-update/ChangeLog.md b/auto-update/ChangeLog.md
@@ -2,6 +2,8 @@
 
 ## 0.2.0
 
+* Creating Reaper.Internal to export Reaper constructor.
+* Hiding Reaper constructor.
 * Add `reaperModify` to the `Reaper` API, allowing workload modification outside
   of the main `reaperAction` loop.
   [#985](https://github.com/yesodweb/wai/pull/985)

diff --git a/auto-update/Control/Reaper.hs b/auto-update/Control/Reaper.hs
@@ -27,7 +27,12 @@ module Control.Reaper (
     reaperEmpty,
 
     -- * Type
-    Reaper (..),
+    Reaper,
+    reaperAdd,
+    reaperRead,
+    reaperModify,
+    reaperStop,
+    reaperKill,
 
     -- * Creation
     mkReaper,
@@ -39,6 +44,7 @@ module Control.Reaper (
 import Control.AutoUpdate.Util (atomicModifyIORef')
 import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)
 import Control.Exception (mask_)
+import Control.Reaper.Internal
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
 
 -- | Settings for creating a reaper. This type has two parameters:
@@ -103,33 +109,6 @@ defaultReaperSettings =
         , reaperEmpty = []
         }
 
--- | A data structure to hold reaper APIs.
-data Reaper workload item = Reaper
-    { reaperAdd :: item -> IO ()
-    -- ^ 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.
-    , reaperKill :: IO ()
-    -- ^ Killing the reaper thread immediately if exists.
-    }
-
 -- | State of reaper.
 data State workload
     = -- | No reaper thread
@@ -163,10 +142,10 @@ mkReaper settings@ReaperSettings{..} = do
     modifyRef stateRef modifier = atomicModifyIORef' stateRef $ \mx ->
         case mx of
             NoReaper ->
-              (NoReaper, reaperEmpty)
+                (NoReaper, reaperEmpty)
             Workload wl ->
-              let !wl' = modifier wl
-               in (Workload wl', 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/Control/Reaper/Internal.hs b/auto-update/Control/Reaper/Internal.hs
@@ -0,0 +1,28 @@
+module Control.Reaper.Internal (Reaper (..)) where
+
+-- | A data structure to hold reaper APIs.
+data Reaper workload item = Reaper
+    { reaperAdd :: item -> IO ()
+    -- ^ 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.
+    , reaperKill :: IO ()
+    -- ^ Killing the reaper thread immediately if exists.
+    }
diff --git a/auto-update/auto-update.cabal b/auto-update/auto-update.cabal
@@ -19,6 +19,7 @@ library
                        Control.Debounce
                        Control.Debounce.Internal
                        Control.Reaper
+                       Control.Reaper.Internal
   other-modules:       Control.AutoUpdate.Util
   build-depends:       base >= 4.12 && < 5
   default-language:    Haskell2010

diff --git a/warp/Network/Wai/Handler/Warp/FileInfoCache.hs b/warp/Network/Wai/Handler/Warp/FileInfoCache.hs
@@ -66,8 +66,8 @@ getInfoNaive = getInfo
 ----------------------------------------------------------------
 
 getAndRegisterInfo :: FileInfoCache -> FilePath -> IO FileInfo
-getAndRegisterInfo reaper@Reaper{..} path = do
-    cache <- reaperRead
+getAndRegisterInfo reaper path = do
+    cache <- reaperRead reaper
     case M.lookup path cache of
         Just Negative -> UnliftIO.throwIO (userError "FileInfoCache:getAndRegisterInfo")
         Just (Positive x) -> return x
@@ -76,14 +76,14 @@ getAndRegisterInfo reaper@Reaper{..} path = do
                 `UnliftIO.onException` negative reaper path
 
 positive :: FileInfoCache -> FilePath -> IO FileInfo
-positive Reaper{..} path = do
+positive reaper path = do
     info <- getInfo path
-    reaperAdd (path, Positive info)
+    reaperAdd reaper (path, Positive info)
     return info
 
 negative :: FileInfoCache -> FilePath -> IO FileInfo
-negative Reaper{..} path = do
-    reaperAdd (path, Negative)
+negative reaper path = do
+    reaperAdd reaper (path, Negative)
     UnliftIO.throwIO (userError "FileInfoCache:negative")
 
 ----------------------------------------------------------------