Merge brandon's branch

.gitignore

@@ -1 +1,5 @@
-.idea/
+.idea/
+hls.exe
+.local
+dist-newstyle
+cabal.project.local

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
@@ -57,24 +53,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 {
@@ -281,15 +260,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
@@ -309,7 +282,7 @@ withResource pool act = control $ \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
     modifyTVar_ takeVar (+ 1)
     ents <- readTVar entries
     case ents of
@@ -332,14 +305,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
@@ -358,7 +325,7 @@ tryWithResource pool act = control $ \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)
@@ -380,7 +347,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 #-}
@@ -425,11 +392,11 @@ destroyAllResources Pool{..} = V.forM_ localPools $ purgeLocalPool destroy
 -- | @stats pool reset@ returns statistics on each 'LocalPool' as well as a summary across the entire Pool.
 -- When @reset@ is true, the stats are reset.
 stats :: Pool a -> Bool -> IO Stats
-stats Pool{..} reset = do 
+stats Pool{..} reset = do
   let stripeStats LocalPool{..} = atomically $ do
                                     s <- liftM5 PoolStats (readTVar highwaterVar) (readTVar inUse) (readTVar takeVar) (readTVar createVar) (readTVar createFailureVar)
                                     when reset $ do
-                                                 mapM_ (\v -> writeTVar v 0) [takeVar, createVar, createFailureVar] 
+                                                 mapM_ (\v -> writeTVar v 0) [takeVar, createVar, createFailureVar]
                                                  writeTVar highwaterVar $! currentUsage s
                                     return s
 

default.nix

@@ -0,0 +1,51 @@
+{}:
+
+let
+    commonEnvs = builtins.fetchGit {
+        url = "https://github.com/avanov/nix-common.git";
+        ref = "master";
+        rev = "9d81a5757aa0dfb7ca68edccd081bdf591c6df9e";
+    };
+    ghcEnv  = import "${commonEnvs}/ghc-env.nix" {};
+    pkgs    = ghcEnv.pkgs;
+
+    macOsDeps = with pkgs; lib.optionals stdenv.isDarwin [
+        darwin.apple_sdk.frameworks.CoreServices
+        darwin.apple_sdk.frameworks.ApplicationServices
+    ];
+
+    devEnv  = pkgs.mkShell {
+        # Sets the build inputs, i.e. what will be available in our
+        # local environment.
+        nativeBuildInputs = with pkgs; [
+            cabal-install
+            cabal2nix
+            cachix
+
+            cacert
+            glibcLocales
+
+            gnumake
+            gitAndTools.pre-commit
+            haskell-language-server
+            ghc
+
+            zlib
+        ] ++ macOsDeps;
+        shellHook = ''
+            export PROJECT_PLATFORM="${builtins.currentSystem}"
+            export LANG=en_GB.UTF-8
+
+            # https://cabal.readthedocs.io/en/3.4/installing-packages.html#environment-variables
+            export CABAL_DIR=$PWD/.local/${builtins.currentSystem}/cabal
+
+            # symbolic link to Language Server to satisfy VSCode Haskell plugins
+            ln -s -f `which haskell-language-server` $PWD/hls.exe
+        '';
+    };
+
+in
+
+{
+    inherit devEnv;
+}

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)
@@ -48,8 +48,4 @@ library
 
 source-repository head
   type:     git
-  location: http://github.com/bos/pool
-
-source-repository head
-  type:     mercurial
-  location: http://bitbucket.org/bos/pool
+  location: http://github.com/avanov/pool

shell.nix

@@ -0,0 +1,4 @@
+let
+    environment = import ./default.nix {};
+in
+    environment.devEnv