abhin4v
/
hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Reformatting and hlinting.

master
Abhinav Sarkar 2015-06-29 21:14:14 +05:30
parent ab26dd9f6a
commit 044285bfb8
2 changed files with 30 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hask-irc-core/Network/IRC/Bot.hs
View File

@ -61,7 +61,7 @@ sendCommandLoop commandChan bot@Bot { .. } = do
forM_ exs $ \(ex :: SomeException) -> forM_ exs $ \(ex :: SomeException) ->
errorM ("Error while formatting command: " ++ show cmd ++ "\nError: " ++ show ex) errorM ("Error while formatting command: " ++ show cmd ++ "\nError: " ++ show ex)
forM_ lines_ $ \line -> do forM_ lines_ $ \line ->
handle (\(e :: SomeException) -> do handle (\(e :: SomeException) -> do
errorM ("Error while writing to connection: " ++ show e) errorM ("Error while writing to connection: " ++ show e)
closeMessageChannel commandChan) $ do closeMessageChannel commandChan) $ do

60
hask-irc-core/Network/IRC/Client.hs
View File

@ -64,11 +64,11 @@ connect botConfig@BotConfig { .. } = do
handlerHelp <- getHelp handler botConfig handlerHelp <- getHelp handler botConfig
return $ insertMap handlerName handlerHelp handlerInfo return $ insertMap handlerName handlerHelp handlerInfo
let botConfig' = botConfig { msgHandlerInfo = msgHandlerInfo'} let botConfig' = botConfig { msgHandlerInfo = msgHandlerInfo' }
let msgHandlerChannels = map snd msgHandlersChans let msgHandlerChannels = map snd msgHandlersChans
let msgHandlers = map fst msgHandlersChans let msgHandlers = map fst msgHandlersChans
return ConnectionResource { bot = (Bot botConfig' socket msgHandlers) return ConnectionResource { bot = Bot botConfig' socket msgHandlers
, botStatus = mvBotStatus , botStatus = mvBotStatus
, inChannel = inChannel , inChannel = inChannel
, mainMsgChannel = mainMsgChannel , mainMsgChannel = mainMsgChannel
@ -81,13 +81,12 @@ connect botConfig@BotConfig { .. } = do
threadDelay (5 * oneSec) threadDelay (5 * oneSec)
connectToWithRetry) connectToWithRetry)
mkMsgHandler name messageBus = mkMsgHandler name messageBus = case lookup name msgHandlerMakers of
case lookup name msgHandlerMakers of Nothing -> return Nothing
Nothing -> return Nothing Just maker -> do
Just maker -> do messageChannel <- newMessageChannel messageBus
messageChannel <- newMessageChannel messageBus handler <- msgHandlerMaker maker botConfig messageChannel
handler <- msgHandlerMaker maker botConfig messageChannel return $ Just (handler, messageChannel)
return $ Just (handler, messageChannel)
loadMsgHandlers messageBus = loadMsgHandlers messageBus =
flip (`foldM` mempty) (mapKeys msgHandlerInfo) $ \hMap msgHandlerName -> do flip (`foldM` mempty) (mapKeys msgHandlerInfo) $ \hMap msgHandlerName -> do
@ -116,26 +115,26 @@ runBotIntenal :: BotConfig -> IO ()
runBotIntenal botConfig' = withSocketsDo $ do runBotIntenal botConfig' = withSocketsDo $ do
status <- run status <- run
case status of case status of
Disconnected -> debugM "Restarting .." >> runBotIntenal botConfigWithCore Disconnected -> debugM "Restarting .." >> runBotIntenal botConfigWithCoreHandlers
Errored -> debugM "Restarting .." >> runBotIntenal botConfigWithCore Errored -> debugM "Restarting .." >> runBotIntenal botConfigWithCoreHandlers
NickNotAvailable -> debugM "Trying new nick" >> runBotIntenal botConfigWithNewNick NickNotAvailable -> debugM "Trying new nick" >> runBotIntenal botConfigWithNewNick
NickAvailable -> debugM "Trying original nick" >> runBotIntenal botConfigWithOrigNick NickAvailable -> debugM "Trying original nick" >> runBotIntenal botConfigWithOrigNick
Interrupted -> return () Interrupted -> return ()
_ -> error "Unsupported status" _ -> error "Unsupported status"
where where
botConfigWithCore = botConfig' { botConfigWithCoreHandlers = botConfig' {
msgHandlerInfo = msgHandlerInfo =
foldl' (flip (`insertMap` mempty)) mempty foldl' (flip (`insertMap` mempty)) mempty
(hashNub $ mapKeys (msgHandlerInfo botConfig') ++ mapKeys coreMsgHandlerMakers) (hashNub $ mapKeys (msgHandlerInfo botConfig') ++ mapKeys coreMsgHandlerMakers)
, msgHandlerMakers = coreMsgHandlerMakers <> msgHandlerMakers botConfig' , msgHandlerMakers = coreMsgHandlerMakers <> msgHandlerMakers botConfig'
} }
botConfigWithNewNick = botConfigWithCore { botConfigWithNewNick = botConfigWithCoreHandlers {
botNick = Nick $ nickToText (botNick botConfigWithCore) ++ "_" botNick = Nick $ nickToText (botNick botConfigWithCoreHandlers) ++ "_"
} }
botConfigWithOrigNick = botConfigWithCore { botConfigWithOrigNick = botConfigWithCoreHandlers {
botNick = botOrigNick botConfigWithCore botNick = botOrigNick botConfigWithCoreHandlers
} }
handleErrors :: SomeException -> IO BotStatus handleErrors :: SomeException -> IO BotStatus
@ -157,29 +156,28 @@ runBotIntenal botConfig' = withSocketsDo $ do
forM_ resps $ sendMessage msgChannel forM_ resps $ sendMessage msgChannel
runHandler botConfig (msgHandlerName, (handler, msgChannel)) runHandler botConfig (msgHandlerName, (handler, msgChannel))
run = bracket (connect botConfigWithCore) disconnect $ run = bracket (connect botConfigWithCoreHandlers) disconnect $ \ConnectionResource { .. } ->
\ConnectionResource { .. } -> handle handleErrors $ do
handle handleErrors $ do let Bot { .. } = bot
let Bot { .. } = bot debugM $ "Running with config:\n" ++ show botConfig
debugM $ "Running with config:\n" ++ show botConfig
sendMessage mainMsgChannel =<< newMessage NickCmd sendMessage mainMsgChannel =<< newMessage NickCmd
sendMessage mainMsgChannel =<< newMessage UserCmd sendMessage mainMsgChannel =<< newMessage UserCmd
fork $ sendCommandLoop mainMsgChannel bot fork $ sendCommandLoop mainMsgChannel bot
`catch` (\(e :: SomeException) -> errorM $ "Error in sendCommandLoop: " ++ show e) `catch` (\(e :: SomeException) -> errorM $ "Error in sendCommandLoop: " ++ show e)
fork $ readMessageLoop botStatus inChannel bot oneSec fork $ readMessageLoop botStatus inChannel bot oneSec
`catch` (\(e :: SomeException) -> errorM $ "Error in readMessageLoop: " ++ show e) `catch` (\(e :: SomeException) -> errorM $ "Error in readMessageLoop: " ++ show e)
forM_ (mapToList . asMap $ mergeMaps msgHandlers handlerMsgChannels) $ forM_ (mapToList . asMap $ mergeMaps msgHandlers handlerMsgChannels) $
void . fork . runHandler botConfig void . fork . runHandler botConfig
runIRC bot Connected $ messageProcessLoop inChannel mainMsgChannel runIRC bot Connected $ messageProcessLoop inChannel mainMsgChannel
-- | Creates and runs an IRC bot for given the config. This IO action runs forever. -- | Creates and runs an IRC bot for given the config. This IO action runs forever.
runBot :: BotConfig -- ^ The bot config used to create the bot. runBot :: BotConfig -- ^ The bot config used to create the bot.
-> IO () -> IO ()
runBot botConfig = do runBot botConfig = do
-- setup signal handling -- setup signal handling
mainThreadId <- myThreadId mainThreadId <- myThreadId
let interruptMainThread = throwTo mainThreadId UserInterrupt let interruptMainThread = throwTo mainThreadId UserInterrupt
installHandler sigINT (Catch interruptMainThread) Nothing installHandler sigINT (Catch interruptMainThread) Nothing
installHandler sigTERM (Catch interruptMainThread) Nothing installHandler sigTERM (Catch interruptMainThread) Nothing