moduleDevelopment.Shake.Locks(Lock,newLock,withLock,Var,newVar,readVar,modifyVar,modifyVar_,withVar,Barrier,newBarrier,signalBarrier,waitBarrier,Resource,newResource,acquireResource,releaseResource)whereimportControl.ConcurrentimportControl.Monad----------------------------------------------------------------------- LOCK-- | Like an MVar, but has no valuenewtypeLock=Lock(MVar())instanceShowLockwhereshow_="Lock"newLock::IOLocknewLock=fmapLock$newMVar()withLock::Lock->IOa->IOawithLock(Lockx)=withMVarx.const----------------------------------------------------------------------- VAR-- | Like an MVar, but must always be fullnewtypeVara=Var(MVara)instanceShow(Vara)whereshow_="Var"newVar::a->IO(Vara)newVar=fmapVar.newMVarreadVar::Vara->IOareadVar(Varx)=readMVarxmodifyVar::Vara->(a->IO(a,b))->IObmodifyVar(Varx)f=modifyMVarxfmodifyVar_::Vara->(a->IOa)->IO()modifyVar_(Varx)f=modifyMVar_xfwithVar::Vara->(a->IOb)->IObwithVar(Varx)f=withMVarxf----------------------------------------------------------------------- BARRIER-- | Starts out empty, then is filled exactly oncenewtypeBarriera=Barrier(MVara)instanceShow(Barriera)whereshow_="Barrier"newBarrier::IO(Barriera)newBarrier=fmapBarriernewEmptyMVarsignalBarrier::Barriera->a->IO()signalBarrier(Barrierx)=putMVarxwaitBarrier::Barriera->IOawaitBarrier(Barrierx)=readMVarx----------------------------------------------------------------------- RESOURCE-- | The type representing a finite resource, which multiple build actions should respect.-- Created with 'newResource' in the 'IO' monad before calling 'Development.Shake.shake',-- and used with 'Development.Shake.withResource' in the 'Development.Shake.Action' monad-- when defining rules.---- As an example, only one set of calls to the Excel API can occur at one time, therefore-- Excel is a finite resource of quantity 1. You can write:---- @-- do excel <- 'newResource' \"Excel\" 1-- 'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=2} $ do-- 'Development.Shake.want' [\"a.xls\",\"b.xls\"]-- \"*.xls\" 'Development.Shake.*>' \\out ->-- 'Development.Shake.withResource' excel 1 $-- 'Development.Shake.system'' \"excel\" [out,...]-- @---- Now the two calls to @excel@ will not happen in parallel. Using 'Resource'-- is better than 'MVar' as it will not block any other threads from executing. Be careful that the-- actions run within 'Development.Shake.withResource' do not themselves require further quantities of this resource, or-- you may get a \"thread blocked indefinitely in an MVar operation\" exception. Typically only-- system commands (such as 'Development.Shake.system'') will be run inside 'Development.Shake.withResource',-- not commands such as 'Development.Shake.need'.---- As another example, calls to compilers are usually CPU bound but calls to linkers are usually-- disk bound. Running 8 linkers will often cause an 8 CPU system to grid to a halt. We can limit-- ourselves to 4 linkers with:---- @-- do disk <- 'newResource' \"Disk\" 4-- 'Development.Shake.shake' 'Development.Shake.shakeOptions'{'Development.Shake.shakeThreads'=8} $ do-- 'Development.Shake.want' [show i 'Development.Shake.FilePath.<.>' \"exe\" | i <- [1..100]]-- \"*.exe\" 'Development.Shake.*>' \\out ->-- 'Development.Shake.withResource' disk 1 $-- 'Development.Shake.system'' \"ld\" [\"-o\",out,...]-- \"*.o\" 'Development.Shake.*>' \\out ->-- 'Development.Shake.system'' \"cl\" [\"-o\",out,...]-- @dataResource=ResourceStringInt(Var(Int,[(Int,IO())]))instanceShowResourcewhereshow(Resourcename__)="Resource "++name-- | Create a new finite resource, given a name (for error messages) and a quantity of the resource that exists.-- For an example see 'Resource'.newResource::String->Int->IOResourcenewResourcenamemx=dowhen(mx<0)$error$"You cannot create a resource named "++name++" with a negative quantity, you used "++showmxvar<-newVar(mx,[])return$Resourcenamemxvar-- | Try to acquire a resource. Returns Nothing to indicate you have acquired with no blocking, or Just act to-- say after act completes (which will block) then you will have the resource.acquireResource::Resource->Int->IO(Maybe(IO()))acquireResourcer@(Resourcenamemxvar)want|want<0=error$"You cannot acquire a negative quantity of "++showr++", requested "++showwant|want>mx=error$"You cannot acquire more than "++showmx++" of "++showr++", requested "++showwant|otherwise=modifyVarvar$\(available,waiting)->ifwant<=availablethenreturn((available-want,waiting),Nothing)elsedobar<-newBarrierreturn((available,waiting++[(want,signalBarrierbar())]),Just$waitBarrierbar)-- | You should only ever releaseResource that you obtained with acquireResource.releaseResource::Resource->Int->IO()releaseResource(Resourcenamemxvar)i=modifyVar_var$\(available,waiting)->f(available+i)waitingwherefi((wi,wa):ws)|wi<=i=wa>>f(i-wi)ws|otherwise=do(i,ws)<-fiws;return(i,(wi,wa):ws)fi[]=return(i,[])