scrive / pool

A high-performance striped resource pooling implementation for Haskell
Other
18 stars 11 forks source link

Peek available pool resources without taking the resource? #29

Open avanov opened 1 year ago

avanov commented 1 year ago

Subj, the original repository had a pull request that had it implemented for many years, and there are codebases that rely on that branch to feed stats periodically into statsd and alike. Though the current API assumes that the stats are only peekable on the acquired resources, which doesn't always fit existing use-cases where resources themselves shouldn't be tied to and affected by the stats middleware.

avanov commented 1 year ago

This shows how fragile the current reliance on Data.Pool.Internal may be for end users, if the API isn't provided by the library. I marked Data.Pool.Internal as Unstable below:

data Stats = Stats
    {   currentUsage  :: !Int
        -- ^ Current number of resources being used.
    ,   available     :: !Int
        -- ^ Total resources available for consumption.
    } deriving Show

stats :: Pool -> IO Stats
stats (Pool pool) = currentlyAvailablePerStripe >>= collect where
    -- attributes extraction and counting
    collect xs = pure $ Stats inUse avail where
        inUse = maxResources - avail
        avail = sum xs

    currentlyAvailablePerStripe = traverse id peekAvailable
    peekAvailable               = (fmap stripeAvailability) <$> allStripes    -- array of IO Int
    stripeAvailability ms       = maybe quotaPerStripe Unstable.available ms  -- if the stripe ref is uninitialised, count the default availability
    allStripes                  = peekStripe <$> Unstable.localPools pool     -- array of IO Maybe
    peekStripe                  = tryReadMVar . Unstable.stripeVar

    -- data from the pool
    quotaPerStripe              = maxResources `quotCeil` numStripes
    numStripes                  = length $ Unstable.localPools pool  -- can be 'sizeofSmallArray' but requires 'primitive' as dependency
    maxResources                = Unstable.poolMaxResources . Unstable.poolConfig $ pool
    quotCeil x y                = let (z, r) = x `quotRem` y in if r == 0 then z else z + 1  -- copied from 'Data.Pool.Internal'