{-# LANGUAGE RecordWildCards, ViewPatterns #-}moduleDevelopment.Shake.Internal.Resource(Resource ,newResourceIO ,newThrottleIO ,withResource )whereimportData.FunctionimportSystem.IO.UnsafeimportControl.Concurrent.ExtraimportGeneral.Fence importControl.Exception.ExtraimportData.Tuple.ExtraimportData.IORefimportControl.Monad.ExtraimportGeneral.Bilist importGeneral.Pool importDevelopment.Shake.Internal.Core.Action importDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Monad importDevelopment.Shake.Internal.Core.Pool importControl.Monad.IO.ClassimportSystem.Time.Extra{-# NOINLINEresourceId#-}resourceId::IOIntresourceId =unsafePerformIO$doref <-newIORef0return$atomicModifyIORef'ref $\i ->letj =i +1in(j ,j )-- | Run an action which uses part of a finite resource. For more details see 'Resource'.-- You cannot depend on a rule (e.g. 'need') while a resource is held.withResource::Resource ->Int->Action a ->Action a withResource r i act =doGlobal {..}<-Action getRO liftIO$globalDiagnostic $return$showr ++" waiting to acquire "++showi fence <-liftIO$acquireResourcer globalPool i whenJustfence $\fence ->do(offset ,())<-actionFenceRequeueBy Rightfence Action $modifyRW $addDiscount offset liftIO$globalDiagnostic $return$showr ++" running with "++showi Action $fromAction(blockApply ("Within withResource using "++showr )act )`finallyRAW `doliftIO$releaseResourcer globalPool i liftIO$globalDiagnostic $return$showr ++" released "++showi -- | A type representing an external resource which the build system should respect. There-- are two ways to create 'Resource's in Shake:---- * 'Development.Shake.newResource' creates a finite resource, stopping too many actions running-- simultaneously.---- * 'Development.Shake.newThrottle' creates a throttled resource, stopping too many actions running-- over a short time period.---- These resources are used with 'Development.Shake.withResource' when defining rules. Typically only-- system commands (such as 'Development.Shake.cmd') should be run inside 'Development.Shake.withResource',-- not commands such as 'Development.Shake.need'.---- Be careful that the actions run within 'Development.Shake.withResource' do not themselves require further-- resources, or you may get a \"thread blocked indefinitely in an MVar operation\" exception.-- If an action requires multiple resources, use 'Development.Shake.withResources' to avoid deadlock.dataResource =Resource {resourceOrd ::Int-- ^ Key used for Eq/Ord operations. To make withResources work, we require newResourceIO < newThrottleIO,resourceShow ::String-- ^ String used for Show,acquireResource ::Pool ->Int->IO(Maybe(Fence IO()))-- ^ Acquire the resource and call the function.,releaseResource ::Pool ->Int->IO()-- ^ You should only ever releaseResource that you obtained with acquireResource.}instanceShowResource whereshow =resourceShowinstanceEqResource where(== )=(==)`on`resourceOrdinstanceOrdResource wherecompare =compare`on`resourceOrd----------------------------------------------------------------------- FINITE RESOURCESdataFinite =Finite {finiteAvailable ::!Int-- ^ number of currently available resources,finiteWaiting ::Bilist (Int,Fence IO())-- ^ queue of people with how much they want and the action when it is allocated to them}-- | A version of 'Development.Shake.newResource' that runs in IO, and can be called before calling 'Development.Shake.shake'.-- Most people should use 'Development.Shake.newResource' instead.newResourceIO::String->Int->IOResource newResourceIO name mx =dowhen(mx <0)$errorIO$"You cannot create a resource named "++name ++" with a negative quantity, you used "++showmx key <-resourceId var <-newVar$Finite mx memptyreturn$Resource (negatekey )shw (acquire var )(release var )whereshw ="Resource "++name acquire::VarFinite ->Pool ->Int->IO(Maybe(Fence IO()))acquire var _want |want <0=errorIO$"You cannot acquire a negative quantity of "++shw ++", requested "++showwant |want >mx =errorIO$"You cannot acquire more than "++showmx ++" of "++shw ++", requested "++showwant |otherwise=modifyVarvar $\x @Finite {..}->ifwant <=finiteAvailable thenreturn(x {finiteAvailable=finiteAvailable -want },Nothing)elsedofence <-newFence return(x {finiteWaiting=finiteWaiting `snoc `(want ,fence )},Justfence )release::VarFinite ->Pool ->Int->IO()release var _i =join$modifyVarvar $\x ->return$f x {finiteAvailable=finiteAvailablex +i }wheref (Finite i (uncons ->Just((wi ,wa ),ws )))|wi <=i =second(signalFence wa ()>>)$f $Finite (i -wi )ws |otherwise=first(add (wi ,wa ))$f $Finite i ws f(Finite i _)=(Finite i mempty,return())add a s =s {finiteWaiting=a `cons `finiteWaitings }----------------------------------------------------------------------- THROTTLE RESOURCES-- call a function after a certain delaywaiter::Seconds->IO()->IO()waiter period act =void$forkIO$dosleepperiod act dataThrottle -- | Some number of resources are available=ThrottleAvailable !Int-- | Some users are blocked (non-empty), plus an action to call once we go back to Available|ThrottleWaiting (IO())(Bilist (Int,Fence IO()))-- | A version of 'Development.Shake.newThrottle' that runs in IO, and can be called before calling 'Development.Shake.shake'.-- Most people should use 'Development.Shake.newThrottle' instead.newThrottleIO::String->Int->Double->IOResource newThrottleIO name count period =dowhen(count <0)$errorIO$"You cannot create a throttle named "++name ++" with a negative quantity, you used "++showcount key <-resourceId var <-newVar$ThrottleAvailable count return$Resource key shw (acquire var )(release var )whereshw ="Throttle "++name acquire::VarThrottle ->Pool ->Int->IO(Maybe(Fence IO()))acquire var pool want |want <0=errorIO$"You cannot acquire a negative quantity of "++shw ++", requested "++showwant |want >count =errorIO$"You cannot acquire more than "++showcount ++" of "++shw ++", requested "++showwant |otherwise=modifyVarvar $\x ->casex ofThrottleAvailable i |i >=want ->return(ThrottleAvailable $i -want ,Nothing)|otherwise->dostop <-keepAlivePool pool fence <-newFence return(ThrottleWaiting stop $(want -i ,fence )`cons `mempty,Justfence )ThrottleWaiting stop xs ->dofence <-newFence return(ThrottleWaiting stop $xs `snoc `(want ,fence ),Justfence )release::VarThrottle ->Pool ->Int->IO()release var _n =waiter period $join$modifyVarvar $\x ->return$casex ofThrottleAvailable i ->(ThrottleAvailable $i +n ,return())ThrottleWaiting stop xs ->f stop n xs wheref stop i (uncons ->Just((wi ,wa ),ws ))|i >=wi =second(signalFence wa ()>>)$f stop (i -wi )ws |otherwise=(ThrottleWaiting stop $(wi -i ,wa )`cons `ws ,return())fstop i _=(ThrottleAvailable i ,stop )