{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE PackageImports #-}{-# LANGUAGE CPP #-}{-# LANGUAGE RankNTypes #-}{-# LANGUAGE FlexibleContexts #-}moduleData.Pool(-- * CreationPool,createPool,createPoolCheckAlive-- * Usage,withPool,withPool',withPoolAllocate-- * Diagnostics,PoolStats(..),poolStats)whereimportData.IORef(IORef,newIORef,atomicModifyIORef,readIORef)importControl.Exception(throwIO,Exception,bracket,finally)importqualifiedControl.ExceptionasEimportData.Typeable#if MIN_VERSION_monad_control(0, 3, 0)importqualifiedControl.Monad.Trans.ControlasI#elseimportqualifiedControl.Monad.IO.ControlasIimportqualifiedControl.Exception.ControlasI#endifimportControl.Monad.IO.ClassimportControl.MonaddataPoolDataa=PoolData{poolAvail::![a],poolCreated::!Int}dataPoola=Pool{poolMax::Int,poolData::IORef(PoolDataa),poolMake::IOa,poolFree::a->IO(),poolCheckAlive::a->IOBool}dataPoolStats=PoolStats{poolStatsMax::Int,poolStatsAvailable::Int,poolStatsCreated::Int}poolStats::Poola->IOPoolStatspoolStatsp=dod<-readIORef$poolDatapreturn$PoolStats(poolMaxp)(length$poolAvaild)(poolCreatedd)#if MIN_VERSION_monad_control(0, 3, 0)#define MBCIO I.MonadBaseControl IO#define LOO I.liftBaseOp#define CIO I.control#define TRY try'sequenceEither::I.MonadBaseControlIOm=>Eithere(I.StMma)->m(Eitherea)sequenceEither=either(return.Left)(liftMRight.I.restoreM){-# INLINE sequenceEither #-}-- |Generalized version of 'E.try'.try'::(I.MonadBaseControlIOm,Exceptione)=>ma->m(Eitherea)try'm=I.liftBaseWith(\runInIO->E.try(runInIOm))>>=sequenceEither#else#define MBCIO I.MonadControlIO#define LOO I.liftIOOp#define CIO I.controlIO#define TRY I.try#endif-- | Create a new pool without any resource alive checking.createPool::(MBCIOm,MonadIOm)=>IOa-- ^ new resource creator->(a->IO())-- ^ resource deallocator->Int-- ^ maximum number of resources to allow in pool->(Poola->mb)-- ^ inner function to run with the pool->mbcreatePoolmkfrmxf=createPoolCheckAlivemkfrmxf$const$returnTrue-- | Create a new pool, including a function to check if a resource is still-- alive. Stale resources will automatically be removed from the pool.createPoolCheckAlive::(MBCIOm,MonadIOm)=>IOa-- ^ new resource creator->(a->IO())-- ^ resource deallocator->Int-- ^ maximum number of resource to allow in pool->(Poola->mb)-- ^ inner function to run with the pool->(a->IOBool)-- ^ is the resource alive?->mbcreatePoolCheckAlivemkfrmxfca=dopd<-liftIO$newIORef$PoolData[]0finallyIO(f$Poolmxpdmkfrca)$doPoolDataress_<-readIORefpdmapM_frressfinallyIO::MBCIOm=>ma->IOb->mafinallyIOaio=CIO$\runInIO->finally(runInIOa)iodataPoolExhaustedException=PoolExhaustedExceptionderiving(Show,Typeable)instanceExceptionPoolExhaustedException-- | This function throws a 'PoolExhaustedException' when no resources are-- available. See 'withPoolAllocate' to avoid this.#if MIN_VERSION_monad_control(0, 3, 0)withPool'::(I.MonadBaseControlIOm,MonadIOm)#elsewithPool'::I.MonadControlIOm#endif=>Poola->(a->mb)->mbwithPool'pf=dox<-withPoolpfcasexofNothing->liftIO$throwIOPoolExhaustedExceptionJustx'->returnx'-- | Same as @withPool'@, but instead of throwing a 'PoolExhaustedException'-- when there the maximum number of resources are created and allocated, it-- allocates a new resource, passes it to the subprocess and then frees it.withPoolAllocate::(MonadIOm,MBCIOm)=>Poola->(a->mb)->mbwithPoolAllocatepf=dox<-withPoolpfcasexofJustx'->returnx'Nothing->LOO(bracket(poolMakep)(poolFreep))fmask::MBCIOm=>((foralla.ma->ma)->mb)->mb#if MIN_VERSION_base(4,3,0)#if MIN_VERSION_monad_control(0, 3, 0)mask=I.liftBaseOpE.mask.liftRestoreliftRestore::I.MonadBaseControlIOm=>((foralla.ma->ma)->b)->((foralla.IOa->IOa)->b)liftRestorefr=f$I.liftBaseOp_r#elsemask=I.mask#endif#elsemaskf=I.block$fI.unblock#endif-- | Attempt to run the given action with a resource from the given 'Pool'.-- Returns 'Nothing' if no resource was available.withPool::(MonadIOm,MBCIOm)=>Poola->(a->mb)->m(Maybeb)withPoolpf=mask$\unmask->doeres<-liftIO$atomicModifyIORef(poolDatap)$\pd->casepoolAvailpdofx:xs->(pd{poolAvail=xs},Rightx)[]->(pd,Left$poolCreatedpd)caseeresofLeftpc->ifpc>=poolMaxpthenreturnNothingelseLOO(bracket(poolMakep)(insertResource1))(liftMJust.unmask.f)Rightres->doisAlive<-TRY$unmask$liftIO$poolCheckAliveprescaseisAlive::EitherE.SomeExceptionBoolofRightTrue->finallyIO(liftMJust$unmask$fres)(insertResource0res)_->do-- decrement the poolCreated count and then start overliftIO$atomicModifyIORef(poolDatap)$\pd->(pd{poolCreated=poolCreatedpd-1},())unmask$withPoolpfwhereinsertResourceix=atomicModifyIORef(poolDatap)$\pd->(pd{poolAvail=x:poolAvailpd,poolCreated=i+poolCreatedpd},())