Movatterモバイル変換

{-# LANGUAGE Trustworthy #-}{-# LANGUAGE BangPatterns           , CPP           , ExistentialQuantification           , NoImplicitPrelude           , TypeSynonymInstances           , FlexibleInstances  #-}moduleGHC.Event.TimerManager(-- * TypesTimerManager-- * Creation,new,newWith,newDefaultBackend,emControl-- * Running,finished,loop,step,shutdown,cleanup,wakeManager-- * Registering interest in timeout events,TimeoutCallback,TimeoutKey,registerTimeout,updateTimeout,unregisterTimeout)where#include "EventConfig.h"-------------------------------------------------------------------------- ImportsimportControl.Exception(finally)importData.Foldable(sequence_)importData.IORef(IORef,atomicModifyIORef',mkWeakIORef,newIORef,readIORef,writeIORef)importGHC.BaseimportGHC.Clock(getMonotonicTimeNSec)importGHC.Conc.Signal(runHandlers)importGHC.Enum(maxBound)importGHC.Num(Num(..))importGHC.Real(quot,fromIntegral)importGHC.Show(Show(..))importGHC.Event.ControlimportGHC.Event.Internal(Backend,Event,evtRead,Timeout(..))importGHC.Event.Unique(Unique,UniqueSource,newSource,newUnique)importSystem.Posix.Types(Fd)importqualifiedGHC.Event.InternalasIimportqualifiedGHC.Event.PSQasQ#if defined(HAVE_POLL)importqualifiedGHC.Event.PollasPoll#else# error not implemented for this operating system#endif-------------------------------------------------------------------------- Types-- | A timeout registration cookie.newtypeTimeoutKey=TKUniquederivingEq-- ^ @since 4.7.0.0-- | Callback invoked on timeout events.typeTimeoutCallback=IO()dataState=Created|Running|Dying|Finishedderiving(Eq-- ^ @since 4.7.0.0,Show-- ^ @since 4.7.0.0)-- | A priority search queue, with timeouts as priorities.typeTimeoutQueue=Q.PSQTimeoutCallback-- | An edit to apply to a 'TimeoutQueue'.typeTimeoutEdit=TimeoutQueue->TimeoutQueue-- | The event manager state.dataTimerManager=TimerManager{emBackend::!Backend,emTimeouts::{-# UNPACK#-}!(IORefTimeoutQueue),emState::{-# UNPACK#-}!(IORefState),emUniqueSource::{-# UNPACK#-}!UniqueSource,emControl::{-# UNPACK#-}!Control}-------------------------------------------------------------------------- CreationhandleControlEvent::TimerManager->Fd->Event->IO()handleControlEventmgrfd_evt=domsg<-readControlMessage(emControlmgr)fdcasemsgofCMsgWakeup->return()CMsgDie->writeIORef(emStatemgr)FinishedCMsgSignalfps->runHandlersfpsnewDefaultBackend::IOBackend#if defined(HAVE_POLL)newDefaultBackend=Poll.new#elsenewDefaultBackend=errorWithoutStackTrace"no back end for this platform"#endif-- | Create a new event manager.new::IOTimerManagernew=newWith=<<newDefaultBackendnewWith::Backend->IOTimerManagernewWithbe=dotimeouts<-newIORefQ.emptyctrl<-newControlTruestate<-newIORefCreatedus<-newSource_<-mkWeakIORefstate$dost<-atomicModifyIORef'state$\s->(Finished,s)when(st/=Finished)$doI.deletebecloseControlctrlletmgr=TimerManager{emBackend=be,emTimeouts=timeouts,emState=state,emUniqueSource=us,emControl=ctrl}_<-I.modifyFdbe(controlReadFdctrl)memptyevtRead_<-I.modifyFdbe(wakeupReadFdctrl)memptyevtReadreturnmgr-- | Asynchronously shuts down the event manager, if running.shutdown::TimerManager->IO()shutdownmgr=dostate<-atomicModifyIORef'(emStatemgr)$\s->(Dying,s)when(state==Running)$sendDie(emControlmgr)finished::TimerManager->IOBoolfinishedmgr=(==Finished)`liftM`readIORef(emStatemgr)cleanup::TimerManager->IO()cleanupmgr=dowriteIORef(emStatemgr)FinishedI.delete(emBackendmgr)closeControl(emControlmgr)-------------------------------------------------------------------------- Event loop-- | Start handling events.  This function loops until told to stop,-- using 'shutdown'.---- /Note/: This loop can only be run once per 'TimerManager', as it-- closes all of its control resources when it finishes.loop::TimerManager->IO()loopmgr=dostate<-atomicModifyIORef'(emStatemgr)$\s->casesofCreated->(Running,s)_->(s,s)casestateofCreated->go`finally`cleanupmgrDying->cleanupmgr_->docleanupmgrerrorWithoutStackTrace$"GHC.Event.Manager.loop: state is already "++showstatewherego=dorunning<-stepmgrwhenrunninggostep::TimerManager->IOBoolstepmgr=dotimeout<-mkTimeout_<-I.poll(emBackendmgr)(Justtimeout)(handleControlEventmgr)state<-readIORef(emStatemgr)state`seq`return(state==Running)where-- | Call all expired timer callbacks and return the time to the-- next timeout.mkTimeout::IOTimeoutmkTimeout=donow<-getMonotonicTimeNSec(expired,timeout)<-atomicModifyIORef'(emTimeoutsmgr)$\tq->let(expired,tq')=Q.atMostnowtqtimeout=caseQ.minViewtq'ofNothing->ForeverJust(Q.E_t_,_)->-- This value will always be positive since the call-- to 'atMost' above removed any timeouts <= 'now'lett'=t-nowint'`seq`Timeoutt'in(tq',(expired,timeout))sequence_$mapQ.valueexpiredreturntimeout-- | Wake up the event manager.wakeManager::TimerManager->IO()wakeManagermgr=sendWakeup(emControlmgr)-------------------------------------------------------------------------- Registering interest in timeout eventsexpirationTime::Int->IOQ.PrioexpirationTimeus=donow<-getMonotonicTimeNSecletexpTime-- Currently we treat overflows by clamping to maxBound. If humanity-- still exists in 2500 CE we will ned to be a bit more careful here.-- See #15158.|(maxBound-now)`quot`1000<fromIntegralus=maxBound|otherwise=now+nswherens=1000*fromIntegralusreturnexpTime-- | Register a timeout in the given number of microseconds.  The-- returned 'TimeoutKey' can be used to later unregister or update the-- timeout.  The timeout is automatically unregistered after the given-- time has passed.registerTimeout::TimerManager->Int->TimeoutCallback->IOTimeoutKeyregisterTimeoutmgruscb=do!key<-newUnique(emUniqueSourcemgr)ifus<=0thencbelsedoexpTime<-expirationTimeus-- "unsafeInsertNew" is safe - the key must not exist in the PSQ. It-- doesn't because we just generated it from a unique supply.editTimeoutsmgr(Q.unsafeInsertNewkeyexpTimecb)return$TKkey-- | Unregister an active timeout.unregisterTimeout::TimerManager->TimeoutKey->IO()unregisterTimeoutmgr(TKkey)=doeditTimeoutsmgr(Q.deletekey)-- | Update an active timeout to fire in the given number of-- microseconds.updateTimeout::TimerManager->TimeoutKey->Int->IO()updateTimeoutmgr(TKkey)us=doexpTime<-expirationTimeuseditTimeoutsmgr(Q.adjust(constexpTime)key)editTimeouts::TimerManager->TimeoutEdit->IO()editTimeoutsmgrg=dowake<-atomicModifyIORef'(emTimeoutsmgr)fwhenwake(wakeManagermgr)wherefq=(q',wake)whereq'=gqwake=caseQ.minViewqofNothing->TrueJust(Q.E_t0_,_)->caseQ.minViewq'ofJust(Q.E_t1_,_)->-- don't wake the manager if the-- minimum element didn't change.t0/=t1_->True