From d67f8993c6838e79c407dd827cfb089afb896037 Mon Sep 17 00:00:00 2001
From: Brandon Chinn <brandonchinn178@gmail.com>
Date: Sun, 22 Nov 2020 16:32:33 -0800
Subject: [PATCH 1/2] Use unliftio over monad-control

---
 Data/Pool.hs        | 43 +++++--------------------------------------
 resource-pool.cabal |  2 +-
 2 files changed, 6 insertions(+), 39 deletions(-)

diff --git a/Data/Pool.hs b/Data/Pool.hs
index 6764e8b..bb18e52 100644
--- a/Data/Pool.hs
+++ b/Data/Pool.hs
@@ -1,9 +1,5 @@
 {-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ScopedTypeVariables, RankNTypes, DeriveDataTypeable #-}
 
-#if MIN_VERSION_monad_control(0,3,0)
-{-# LANGUAGE FlexibleContexts #-}
-#endif
-
 #if !MIN_VERSION_base(4,3,0)
 {-# LANGUAGE RankNTypes #-}
 #endif
@@ -54,24 +50,7 @@ import Data.Typeable (Typeable)
 import GHC.Conc.Sync (labelThread)
 import qualified Control.Exception as E
 import qualified Data.Vector as V
-
-#if MIN_VERSION_monad_control(0,3,0)
-import Control.Monad.Trans.Control (MonadBaseControl, control)
-import Control.Monad.Base (liftBase)
-#else
-import Control.Monad.IO.Control (MonadControlIO, controlIO)
-import Control.Monad.IO.Class (liftIO)
-#define control controlIO
-#define liftBase liftIO
-#endif
-
-#if MIN_VERSION_base(4,3,0)
-import Control.Exception (mask)
-#else
--- Don't do any async exception protection for older GHCs.
-mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
-mask f = f id
-#endif
+import UnliftIO (MonadUnliftIO, mask, withRunInIO)
 
 -- | A single resource pool entry.
 data Entry a = Entry {
@@ -247,15 +226,9 @@ purgeLocalPool destroy LocalPool{..} = do
 -- destroy a pooled resource, as doing so will almost certainly cause
 -- a subsequent user (who expects the resource to be valid) to throw
 -- an exception.
-withResource ::
-#if MIN_VERSION_monad_control(0,3,0)
-    (MonadBaseControl IO m)
-#else
-    (MonadControlIO m)
-#endif
-  => Pool a -> (a -> m b) -> m b
+withResource :: MonadUnliftIO m => Pool a -> (a -> m b) -> m b
 {-# SPECIALIZE withResource :: Pool a -> (a -> IO b) -> IO b #-}
-withResource pool act = control $ \runInIO -> mask $ \restore -> do
+withResource pool act = withRunInIO $ \runInIO -> mask $ \restore -> do
   (resource, local) <- takeResource pool
   ret <- restore (runInIO (act resource)) `onException`
             destroyResource pool local resource
@@ -295,14 +268,8 @@ takeResource pool@Pool{..} = do
 -- returns immediately with 'Nothing' (ie. the action function is /not/ called).
 -- Conversely, if a resource can be borrowed from the pool without blocking, the
 -- action is performed and it's result is returned, wrapped in a 'Just'.
-tryWithResource :: forall m a b.
-#if MIN_VERSION_monad_control(0,3,0)
-    (MonadBaseControl IO m)
-#else
-    (MonadControlIO m)
-#endif
-  => Pool a -> (a -> m b) -> m (Maybe b)
-tryWithResource pool act = control $ \runInIO -> mask $ \restore -> do
+tryWithResource :: forall m a b. MonadUnliftIO m => Pool a -> (a -> m b) -> m (Maybe b)
+tryWithResource pool act = withRunInIO $ \runInIO -> mask $ \restore -> do
   res <- tryTakeResource pool
   case res of
     Just (resource, local) -> do
diff --git a/resource-pool.cabal b/resource-pool.cabal
index 6a9bc09..5234e1d 100644
--- a/resource-pool.cabal
+++ b/resource-pool.cabal
@@ -32,11 +32,11 @@ library
   build-depends:
     base >= 4.4 && < 5,
     hashable,
-    monad-control >= 0.2.0.1,
     transformers,
     transformers-base >= 0.4,
     stm >= 2.3,
     time,
+    unliftio,
     vector >= 0.7
 
   if flag(developer)

From e430450f92828a4808ae61138b9e0c7864260581 Mon Sep 17 00:00:00 2001
From: Brandon Chinn <brandonchinn178@gmail.com>
Date: Sun, 22 Nov 2020 16:38:19 -0800
Subject: [PATCH 2/2] Remove unneeded liftBase

---
 Data/Pool.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/Data/Pool.hs b/Data/Pool.hs
index bb18e52..c92ad40 100644
--- a/Data/Pool.hs
+++ b/Data/Pool.hs
@@ -248,7 +248,7 @@ withResource pool act = withRunInIO $ \runInIO -> mask $ \restore -> do
 takeResource :: Pool a -> IO (a, LocalPool a)
 takeResource pool@Pool{..} = do
   local@LocalPool{..} <- getLocalPool pool
-  resource <- liftBase . join . atomically $ do
+  resource <- join . atomically $ do
     ents <- readTVar entries
     case ents of
       (Entry{..}:es) -> writeTVar entries es >> return (return entry)
@@ -288,7 +288,7 @@ tryWithResource pool act = withRunInIO $ \runInIO -> mask $ \restore -> do
 tryTakeResource :: Pool a -> IO (Maybe (a, LocalPool a))
 tryTakeResource pool@Pool{..} = do
   local@LocalPool{..} <- getLocalPool pool
-  resource <- liftBase . join . atomically $ do
+  resource <- join . atomically $ do
     ents <- readTVar entries
     case ents of
       (Entry{..}:es) -> writeTVar entries es >> return (return . Just $ entry)
@@ -310,7 +310,7 @@ tryTakeResource pool@Pool{..} = do
 -- Internal, just to not repeat code for 'takeResource' and 'tryTakeResource'
 getLocalPool :: Pool a -> IO (LocalPool a)
 getLocalPool Pool{..} = do
-  i <- liftBase $ ((`mod` numStripes) . hash) <$> myThreadId
+  i <- ((`mod` numStripes) . hash) <$> myThreadId
   return $ localPools V.! i
 #if __GLASGOW_HASKELL__ >= 700
 {-# INLINABLE getLocalPool #-}