From 0554b22308f99db5bdb65b1948c99db4702ce44b Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Tue, 31 May 2022 14:44:57 +0200 Subject: [PATCH 1/3] Adjust stats --- src/Data/Pool/Introspection.hs | 69 ++++++++++++++++++++++++---------- 1 file changed, 50 insertions(+), 19 deletions(-) diff --git a/src/Data/Pool/Introspection.hs b/src/Data/Pool/Introspection.hs index 5effc36..a058a55 100644 --- a/src/Data/Pool/Introspection.hs +++ b/src/Data/Pool/Introspection.hs @@ -8,7 +8,7 @@ module Data.Pool.Introspection -- * Resource management , Resource(..) - , AcquisitionMethod(..) + , Acquisition(..) , withResource , takeResource , putResource @@ -27,21 +27,18 @@ import Data.Pool.Internal data Resource a = Resource { resource :: a , stripeNumber :: !Int - , acquisitionTime :: !Double - , acquisitionMethod :: !AcquisitionMethod , availableResources :: !Int + , acquisition :: !Acquisition + , acquisitionTime :: !Double + , creationTime :: !(Maybe Double) } deriving (Eq, Show, Generic) --- | Method of acquiring a resource from the pool. -data AcquisitionMethod - = Created - -- ^ A new resource was created. - | Taken - -- ^ An existing resource was directly taken from the pool. - | WaitedThen !AcquisitionMethod - -- ^ The thread had to wait until a resource was released. The inner method - -- signifies whether the resource was returned to the pool via 'putResource' - -- ('Taken') or 'destroyResource' ('Created'). +-- | Describes how a resource was acquired from the pool. +data Acquisition + = Immediate + -- ^ A resource was taken from the pool immediately. + | Delayed + -- ^ The thread has to wait until a resource was released. deriving (Eq, Show, Generic) -- | 'Data.Pool.withResource' with introspection capabilities. @@ -65,20 +62,54 @@ takeResource pool = mask_ $ do waitForResource (stripeVar lp) q >>= \case Just a -> do t2 <- getMonotonicTime - pure (Resource a (stripeId lp) (t2 - t1) (WaitedThen Taken) 0, lp) + let res = Resource + { resource = a + , stripeNumber = stripeId lp + , availableResources = 0 + , acquisition = Delayed + , acquisitionTime = t1 - t2 + , creationTime = Nothing + } + pure (res, lp) Nothing -> do - a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) t2 <- getMonotonicTime - pure (Resource a (stripeId lp) (t2 - t1) (WaitedThen Created) 0, lp) + a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) + t3 <- getMonotonicTime + let res = Resource + { resource = a + , stripeNumber = stripeId lp + , availableResources = 0 + , acquisition = Delayed + , acquisitionTime = t2 - t1 + , creationTime = Just $! t3 - t2 + } + pure (res, lp) else case cache stripe of [] -> do let newAvailable = available stripe - 1 putMVar (stripeVar lp) $! stripe { available = newAvailable } - a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) t2 <- getMonotonicTime - pure (Resource a (stripeId lp) (t2 - t1) Created newAvailable, lp) + a <- createResource (poolConfig pool) `onException` restoreSize (stripeVar lp) + t3 <- getMonotonicTime + let res = Resource + { resource = a + , stripeNumber = stripeId lp + , availableResources = newAvailable + , acquisition = Immediate + , acquisitionTime = t2 - t1 + , creationTime = Just $! t3 - t2 + } + pure (res, lp) Entry a _ : as -> do let newAvailable = available stripe - 1 putMVar (stripeVar lp) $! stripe { available = newAvailable, cache = as } t2 <- getMonotonicTime - pure (Resource a (stripeId lp) (t2 - t1) Taken newAvailable, lp) + let res = Resource + { resource = a + , stripeNumber = stripeId lp + , availableResources = newAvailable + , acquisition = Immediate + , acquisitionTime = t2 - t1 + , creationTime = Nothing + } + pure (res, lp) From 5c95b531ebbaf77046b6efb6f9eb94afc067bc33 Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Tue, 31 May 2022 15:33:19 +0200 Subject: [PATCH 2/3] Fix a typo --- src/Data/Pool/Introspection.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Pool/Introspection.hs b/src/Data/Pool/Introspection.hs index a058a55..55c448e 100644 --- a/src/Data/Pool/Introspection.hs +++ b/src/Data/Pool/Introspection.hs @@ -67,7 +67,7 @@ takeResource pool = mask_ $ do , stripeNumber = stripeId lp , availableResources = 0 , acquisition = Delayed - , acquisitionTime = t1 - t2 + , acquisitionTime = t2 - t1 , creationTime = Nothing } pure (res, lp) From fb967dc4a1b80995cdd35f1e6b5020ce8953696f Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Wed, 1 Jun 2022 13:38:22 +0200 Subject: [PATCH 3/3] Fix a typo --- src/Data/Pool/Introspection.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Pool/Introspection.hs b/src/Data/Pool/Introspection.hs index 55c448e..2bab6aa 100644 --- a/src/Data/Pool/Introspection.hs +++ b/src/Data/Pool/Introspection.hs @@ -38,7 +38,7 @@ data Acquisition = Immediate -- ^ A resource was taken from the pool immediately. | Delayed - -- ^ The thread has to wait until a resource was released. + -- ^ The thread had to wait until a resource was released. deriving (Eq, Show, Generic) -- | 'Data.Pool.withResource' with introspection capabilities.