{-# LANGUAGE ScopedTypeVariables #-}-- | A bit like 'Fence', but not thread safe and optimised for avoiding taking the fencemoduleGeneral.Thread(withThreadsBoth ,withThreadSlave ,allocateThread ,Thread ,newThreadFinally ,stopThreads )whereimportGeneral.Cleanup importData.HashableimportControl.Concurrent.ExtraimportControl.ExceptionimportGeneral.Extra importControl.Monad.ExtradataThread =Thread ThreadId(Barrier())instanceEqThread whereThread a _== Thread b _=a ==b instanceHashableThread wherehashWithSalt salt (Thread a _)=hashWithSaltsalt a -- | The inner thread is unmasked even if you started masked.newThreadFinally::IOa ->(Thread ->EitherSomeExceptiona ->IO())->IOThread newThreadFinally act cleanup =dobar <-newBarriert <-mask_$forkIOWithUnmask$\unmask ->flipfinally(signalBarrierbar ())$dores <-try$unmask act me <-myThreadIdcleanup (Thread me bar )res return$Thread t bar stopThreads::[Thread ]->IO()stopThreads threads =do-- if a thread is in a masked action, killing it may take some time, so kill them in parallelbars <-sequence[doforkIO$killThreadt ;returnbar |Thread t bar <-threads ]mapM_waitBarrierbars -- Run both actions. If either throws an exception, both threads-- are killed and an exception reraised.-- Not called much, so simplicity over performance (2 threads).withThreadsBoth::IOa ->IOb ->IO(a ,b )withThreadsBoth act1 act2 =dobar1 <-newBarrierbar2 <-newBarrierparent <-myThreadIdignore <-newVarFalsemask$\unmask ->dot1 <-forkIOWithUnmask$\unmask ->dores1 ::EitherSomeExceptiona <-try$unmask act1 unlessM(readVarignore )$whenLeft res1 $throwToparent signalBarrierbar1 res1 t2 <-forkIOWithUnmask$\unmask ->dores2 ::EitherSomeExceptionb <-try$unmask act2 unlessM(readVarignore )$whenLeft res2 $throwToparent signalBarrierbar2 res2 res ::EitherSomeException(a ,b )<-try$unmask $doRightv1 <-waitBarrierbar1 Rightv2 <-waitBarrierbar2 return(v1 ,v2 )writeVarignore TruekillThreadt1 forkIO$killThreadt2 waitBarrierbar1 waitBarrierbar2 eitherthrowIOreturnres -- | Run an action in a separate thread.-- After the first action terminates, the thread will be killed.-- If the action raises an exception it will be rethrown on the parent thread.withThreadSlave::IO()->IOa ->IOa withThreadSlave slave act =withCleanup $\cleanup ->doallocateThread cleanup slave act -- | Run the given action in a separate thread.-- On cleanup, the thread will be killed before continuing.-- If the action raises an exception it will be rethrown on the parent thread.allocateThread::Cleanup ->IO()->IO()allocateThread cleanup act =dobar <-newBarrierparent <-myThreadIdignore <-newVarFalsevoid$allocate cleanup (mask_$forkIOWithUnmask$\unmask ->dores ::EitherSomeException()<-try$unmask act unlessM(readVarignore )$whenLeft res $throwToparent signalBarrierbar ())(\t ->dowriteVarignore True;killThreadt ;waitBarrierbar )