{-# LANGUAGE MultiParamTypeClasses, TypeFamilies, FlexibleInstances, FlexibleContexts, UndecidableInstances #-}moduleControl.Concurrent.Priority.Room(Room,newRoom,inUse,Claim,claimedRoom,claimedThread,userData,UserData,RoomGroup(..),RoomConstraint(..),BaseRoomContext(..),RoomContext(..),MaxThreads(..),ClaimMode(..),DefaultRoomContext(..),UnconstrainedRoomContext(..),claim,approveClaims)whereimportControl.Concurrent.Priority.RoomCoreasRoomCoreimportControl.Concurrent.Priority.RoomConstraintimportControl.Concurrent.STMimportControl.MonadimportData.MapasMapimportData.ListasList-- | Require that all 'RoomConstraint's be satisfied when acquiring a 'Room'. This is the default.dataDefaultRoomContextu=Default-- | Don't check any 'RoomConstraint's when acquiring a 'Room'.dataUnconstrainedRoomContextu=UnconstrainedtypefamilyUserDatau::*typeinstanceUserData(Roomu)=utypeinstanceUserData[Roomu]=utypeinstanceUserData(DefaultRoomContextu)=utypeinstanceUserData(UnconstrainedRoomContextu)=utypeinstanceUserData(c,m)=UserDatacclassRoomGroupmwhereroomsOf::m->[Room(UserDatam)]instanceRoomGroup(Roomu)whereroomsOfm=[m]instanceRoomGroup[Roomu]whereroomsOf=idinstanceRoomGroup(DefaultRoomContextu)whereroomsOf=const[]instanceRoomGroup(UnconstrainedRoomContextu)whereroomsOf=const[]instance(UserDatac~UserDatam,RoomGroupc,RoomGroupm)=>RoomGroup(c,m)whereroomsOf(c,m)=roomsOfc++roomsOfm-- | Rules for calling 'claim_'. The two major contexts are 'DefaultRoomContext', which uses 'RoomConstraint's to-- determine which 'Room's are available, and 'UnconstrainedRoomContext', which does not place any constraints on any 'Room'.classBaseRoomContextcwheretypeBaseRoomContextDatac::*-- | Should approve a some claims before entering a critical section, as described by 'claim_'.approveClaimsEntering::c->[Claim(UserDatac)]->STM(BaseRoomContextDatac)-- | Should approve a some claims before exiting a critical section, as described by 'claim_'.approveClaimsExiting::c->[Claim(UserDatac)]->STM(BaseRoomContextDatac)-- | A waiting transaction, as described by 'claim_'.waitingAction::c->(BaseRoomContextDatac)->STM()instance(RoomConstraintu)=>BaseRoomContext(DefaultRoomContextu)wheretypeBaseRoomContextData(DefaultRoomContextu)=()approveClaimsEntering_cs=approveClaimscs>>return()approveClaimsExiting_cs=approveClaimscs>>return()waitingAction_()=return()instanceBaseRoomContext(UnconstrainedRoomContextu)wheretypeBaseRoomContextData(UnconstrainedRoomContextu)=()approveClaimsEntering_cs=mapM_approvecs>>return()approveClaimsExiting_cs=mapM_approvecs>>return()waitingAction__=return()instance(BaseRoomContextc,Basem~DefaultRoomContext(UserDatam))=>BaseRoomContext(c,m)wheretypeBaseRoomContextData(c,m)=BaseRoomContextDatacapproveClaimsEntering=approveClaimsEntering.fstapproveClaimsExiting=approveClaimsExiting.fstwaitingAction=waitingAction.fst-- | An indirect reference to a 'BaseRoomContext'.classRoomContextcwheretypeBasec::*baseContext::c->Basecinstance(RoomConstraintu)=>RoomContext(Roomu)wheretypeBase(Roomu)=DefaultRoomContextubaseContext=constDefaultinstance(RoomConstraintu)=>RoomContext[Roomu]wheretypeBase[Roomu]=DefaultRoomContextubaseContext=constDefaultinstance(BaseRoomContextc,Basem~DefaultRoomContext(UserDatam))=>RoomContext(c,m)wheretypeBase(c,m)=cbaseContext=fst-- | Temporarily 'Acquire', and then release, or 'Release', and then acquire, some 'Room's for the duration of a critical section.-- A simple example where a room might be used to prevent interleaving of 'stdout':---- > room <- newRoom (MaxThreads 1)-- > forkIO $ claim Acquire room $ putStrLn "Hello World!"-- > forkIO $ claim Acquire room $ putStrLn "Foo! Bar!"claim::(RoomGroupc,RoomContextc,BaseRoomContext(Basec),UserDatac~UserData(Basec))=>ClaimMode->c->IOa->IOaclaimclaim_modecactionIO=doletc'=baseContextcroom_context_data<-newTVarIO(error"claim: BaseRoomContextData not yet available (please report a bug against the priority package)")claim_(Map.fromList$Prelude.map(flip(,)claim_mode)$roomsOfc)(\cs->writeTVarroom_context_data=<<approveClaimsEnteringc'cs)(\cs->writeTVarroom_context_data=<<approveClaimsExitingc'cs)(waitingActionc'=<<readTVarroom_context_data)actionIO