34 lines
1.0 KiB
Haskell
34 lines
1.0 KiB
Haskell
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Pipes.IRC.Server.EventHandler
|
|
( ircEventHandler )
|
|
where
|
|
|
|
import Control.Concurrent.Async
|
|
import Control.Concurrent.STM
|
|
import Control.Monad
|
|
import Data.Map as M
|
|
import Data.Maybe as DM
|
|
import Network.Socket as NS
|
|
import Pipes.Concurrent as PC
|
|
import Pipes.IRC.Server.Types
|
|
|
|
sendToMany :: a -> [Output a] -> IO ()
|
|
sendToMany msg outs = do
|
|
resL <- forM outs $ \o ->
|
|
async $ atomically $ PC.send o msg
|
|
mapM_ wait resL
|
|
|
|
ircEventHandler :: ServerState -> IrcEvent -> IO ()
|
|
ircEventHandler srv evt =
|
|
case evt of
|
|
Close connId -> do
|
|
outConns <- readTVarIO $ ircConnections srv
|
|
case M.lookup connId outConns of
|
|
Just IrcConnection{..} -> NS.close sock
|
|
_ -> return ()
|
|
Msg {..} -> do
|
|
outConns <- readTVarIO $ ircConnections srv
|
|
let os = fmap out $ DM.mapMaybe (`M.lookup` outConns) outDest
|
|
sendToMany outMsg os
|