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

Some refactoring

master
Abhinav Sarkar 2014-05-23 04:56:26 +05:30
parent 0d8e7ae973
commit 7a93179468
2 changed files with 31 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Network/IRC/Handlers.hs
View File

@ -58,7 +58,8 @@ pingPong state IdleMsg { .. } | even (convert msgTime :: Int) = do
if addUTCTime limit lastComm < msgTime if addUTCTime limit lastComm < msgTime
then return . Just . PingCmd . pack . formatTime defaultTimeLocale "%s" $ msgTime then return . Just . PingCmd . pack . formatTime defaultTimeLocale "%s" $ msgTime
else return Nothing else return Nothing
pingPong _ _ = return Nothing
pingPong _ _ = return Nothing
greeter :: MonadMsgHandler m => Message -> m (Maybe Command) greeter :: MonadMsgHandler m => Message -> m (Maybe Command)
greeter ChannelMsg { .. } = greeter ChannelMsg { .. } =

62
Network/IRC/Handlers/NickTracker.hs
View File

@ -35,9 +35,6 @@ getByCanonicalNick canonicalNick = do
NickTracking { .. } <- ask NickTracking { .. } <- ask
return . IS.toList $ nickTracking @= canonicalNick return . IS.toList $ nickTracking @= canonicalNick
--getLastSeenOn :: CanonicalNick -> Query NickTracking LastSeenOn
--getLastSeenOn = liftM (minimumEx . map lastSeenOn) . getByCanonicalNick
saveNickTrack :: NickTrack -> Update NickTracking () saveNickTrack :: NickTrack -> Update NickTracking ()
saveNickTrack nt = do saveNickTrack nt = do
NickTracking { .. } <- get NickTracking { .. } <- get
@ -48,18 +45,18 @@ $(makeAcidic ''NickTracking ['getByNick, 'getByCanonicalNick, 'saveNickTrack])
nickTrackerMsg :: MonadMsgHandler m => IORef (AcidState NickTracking) -> Message -> m (Maybe Command) nickTrackerMsg :: MonadMsgHandler m => IORef (AcidState NickTracking) -> Message -> m (Maybe Command)
nickTrackerMsg state = go nickTrackerMsg state = go
where where
go ChannelMsg { .. } = updateNickTrack user msg msgTime >> handleCommands msg go ChannelMsg { .. } = updateNickTrack user msg msgTime >> handleCommands msg
go ActionMsg { .. } = updateNickTrack user msg msgTime >> return Nothing go ActionMsg { .. } = updateNickTrack user msg msgTime >> return Nothing
go JoinMsg { .. } = updateNickTrack user "" msgTime >> return Nothing go JoinMsg { .. } = updateNickTrack user "" msgTime >> return Nothing
go PartMsg { .. } = updateNickTrack user msg msgTime >> return Nothing go PartMsg { .. } = updateNickTrack user msg msgTime >> return Nothing
go QuitMsg { .. } = updateNickTrack user msg msgTime >> return Nothing go QuitMsg { .. } = updateNickTrack user msg msgTime >> return Nothing
go NickMsg { .. } = handleNickChange user newNick msgTime >> return Nothing go NickMsg { .. } = handleNickChange user newNick msgTime >> return Nothing
go _ = return Nothing go _ = return Nothing
updateNickTrack user message msgTime = liftIO $ do updateNickTrack user message msgTime = liftIO $ do
acid <- readIORef state acid <- readIORef state
let nck = userNick user let nck = userNick user
mnt <- query acid . GetByNick $ Nick nck mnt <- query acid . GetByNick $ Nick nck
(message', lastMessageOn', cn) <- case (message, mnt) of (message', lastMessageOn', cn) <- case (message, mnt) of
("", Just (NickTrack { .. })) -> return (lastMessage, lastMessageOn, canonicalNick) ("", Just (NickTrack { .. })) -> return (lastMessage, lastMessageOn, canonicalNick)
(_, Just (NickTrack { .. })) -> return (message, msgTime, canonicalNick) (_, Just (NickTrack { .. })) -> return (message, msgTime, canonicalNick)
@ -71,11 +68,11 @@ nickTrackerMsg state = go
NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message' NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message'
handleNickChange user newNick msgTime = liftIO $ do handleNickChange user newNick msgTime = liftIO $ do
acid <- readIORef state acid <- readIORef state
let prevNick = userNick user let prevNick = userNick user
mpnt <- query acid . GetByNick $ Nick prevNick mpnt <- query acid . GetByNick $ Nick prevNick
mnt <- query acid . GetByNick $ Nick newNick mnt <- query acid . GetByNick $ Nick newNick
mInfo <- case (mpnt, mnt) of mInfo <- case (mpnt, mnt) of
(Nothing, _) -> do (Nothing, _) -> do
cn <- map (CanonicalNick . pack . U.toString) U.nextRandom cn <- map (CanonicalNick . pack . U.toString) U.nextRandom
return $ Just ("", cn, msgTime) return $ Just ("", cn, msgTime)
@ -87,38 +84,37 @@ nickTrackerMsg state = go
commands = [ ("!nick", handleNickCommand) commands = [ ("!nick", handleNickCommand)
, ("!seen", handleSeenCommand) ] , ("!seen", handleSeenCommand) ]
handleCommands message = case find ((`isPrefixOf` message) . fst) commands of handleCommands message = case find ((`isPrefixOf` message) . fst) commands of
Nothing -> return Nothing Nothing -> return Nothing
Just (_, handler) -> handler state message Just (_, handler) -> handler state message
withCanonicalNick :: MonadMsgHandler m => IORef (AcidState NickTracking) withNickTracks :: MonadMsgHandler m
-> Text => IORef (AcidState NickTracking) -> Text -> (Text -> [NickTrack] -> IO Text)
-> (AcidState NickTracking -> Text -> CanonicalNick -> IO Text) -> m (Maybe Command)
-> m (Maybe Command) withNickTracks state msg f = liftIO $ do
withCanonicalNick state msg f = liftIO $ do
acid <- readIORef state acid <- readIORef state
let nck = clean . unwords . drop 1 . words $ msg let nick = clean . unwords . drop 1 . words $ msg
mcn <- liftM (map canonicalNick) . query acid . GetByNick $ Nick nck mcn <- liftM (map canonicalNick) . query acid . GetByNick $ Nick nick
resp <- case mcn of resp <- case mcn of
Nothing -> return $ "Unknown nick: " ++ nck Nothing -> return $ "Unknown nick: " ++ nick
Just cn -> liftIO $ f acid nck cn Just cn -> liftIO $ query acid (GetByCanonicalNick cn) >>= f nick
return . Just . ChannelMsgReply $ resp return . Just . ChannelMsgReply $ resp
handleNickCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command) handleNickCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command)
handleNickCommand state msg = withCanonicalNick state msg $ \acid nck canonicalNick -> do handleNickCommand state msg = withNickTracks state msg $ \nck nickTracks -> do
nicks <- liftM (map ((\(Nick n) -> n) . nick)) . query acid . GetByCanonicalNick $ canonicalNick let nicks = map ((\(Nick n) -> n) . nick) nickTracks
if length nicks == 1 if length nicks == 1
then return $ nck ++ " has only one nick" then return $ nck ++ " has only one nick"
else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks) else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks)
handleSeenCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command) handleSeenCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command)
handleSeenCommand state msg = withCanonicalNick state msg $ \acid nick canonicalNick -> do handleSeenCommand state msg = withNickTracks state msg $ \nick nickTracks -> do
nts <- query acid . GetByCanonicalNick $ canonicalNick
let NickTrack { lastSeenOn = LastSeenOn lastSeenOn' let NickTrack { lastSeenOn = LastSeenOn lastSeenOn'
, nick = Nick lastSeenAs } = maximumByEx (comparing lastSeenOn) nts , nick = Nick lastSeenAs } = maximumByEx (comparing lastSeenOn) nickTracks
let NickTrack { lastMessageOn = lastMessageOn' let NickTrack { lastMessageOn = lastMessageOn'
, lastMessage = lastMessage' , lastMessage = lastMessage'
, nick = Nick lastMessageAs } = maximumByEx (comparing lastMessageOn) nts , nick = Nick lastMessageAs } = maximumByEx (comparing lastMessageOn) nickTracks
return $ nick ++ " was last seen on " ++ fmtTime lastSeenOn' ++ return $ nick ++ " was last seen on " ++ fmtTime lastSeenOn' ++
(if nick /= lastSeenAs then " as " ++ lastSeenAs else "") ++ (if nick /= lastSeenAs then " as " ++ lastSeenAs else "") ++
@ -144,4 +140,4 @@ mkMsgHandler BotConfig { .. } _ "nicktracker" = do
helpMsgs = mapFromList [ helpMsgs = mapFromList [
("!nick", "Shows the user's other nicks. !nick <user nick>"), ("!nick", "Shows the user's other nicks. !nick <user nick>"),
("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen <user nick>") ] ("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen <user nick>") ]
mkMsgHandler _ _ _ = return Nothing mkMsgHandler _ _ _ = return Nothing