-- | This is a simple utility module to implement a publish-subscribe pattern.-- Note that this only allows communication in a single direction: pusing data-- from the server to connected clients (browsers).---- Usage:---- * Create a new 'PubSub' handle using 'newPubSub'---- * Subscribe your clients using the 'subscribe' call---- * Push new updates from the server using the 'publish' call--{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}moduleNetwork.WebSockets.Util.PubSub(PubSub,newPubSub,publish,subscribe)whereimportControl.Applicative((<$>))importControl.Exception(IOException,handle)importControl.Monad(foldM,forever)importControl.Monad.Trans(liftIO)importData.IntMap(IntMap)importData.List(foldl')importqualifiedControl.Concurrent.MVarasMVimportqualifiedData.IntMapasIMimportNetwork.WebSocketsdataPubSub_p=PubSub_{pubSubNextId::Int,pubSubSinks::IntMap(Sinkp)}addClient::Sinkp->PubSub_p->(PubSub_p,Int)addClientsink(PubSub_nidsinks)=(PubSub_(nid+1)(IM.insertnidsinksinks),nid)removeClient::Int->PubSub_p->PubSub_premoveClientrefps=ps{pubSubSinks=IM.deleteref(pubSubSinksps)}-- | A handle which keeps track of subscribed clientsnewtypePubSubp=PubSub(MV.MVar(PubSub_p))-- | Create a new 'PubSub' handle, with no clients initally connectednewPubSub::IO(PubSubp)newPubSub=PubSub<$>MV.newMVarPubSub_{pubSubNextId=0,pubSubSinks=IM.empty}-- | Broadcast a message to all connected clientspublish::PubSubp->Messagep->IO()publish(PubSubmvar)msg=MV.modifyMVar_mvar$\pubSub->do-- Take care to detect and remove broken clientsbroken<-foldMpublish'[](IM.toList$pubSubSinkspubSub)return$foldl'(\pb->removeClientbp)pubSubbrokenwhere-- Publish the message to a single client, add it to the broken list if an-- IOException occurspublish'broken(i,s)=handle(\(_::IOException)->return(i:broken))$dosendSinksmsgreturnbroken-- | Blocks foreversubscribe::Protocolp=>PubSubp->WebSocketsp()subscribe(PubSubmvar)=dosink<-getSinkref<-liftIO$MV.modifyMVarmvar$return.addClientsinkcatchWsErrorloop$const$liftIO$MV.modifyMVar_mvar$return.removeClientrefwhereloop=forever$do_<-receiveDataMessagereturn()