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

Added forget nicks command, fuzzy time in replies

Browse Source
master
Abhinav Sarkar 9 years ago
parent a055a3d474
commit a3231878b0
3 changed files with 97 additions and 44 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 2
      hask-irc-core/Network/IRC/Bot.hs
  2. 40
      hask-irc-core/Network/IRC/Util.hs
  3. 99
      hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs

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

@ -115,7 +115,7 @@ messageProcessLoop = messageProcessLoop' 0
mLine <- readLine lineChan
case mLine of
Timeout ->
getCurrentTime >>= \t -> dispatchHandlers bot (Message t "" IdleMsg) >> return Idle
getCurrentTime >>= \t -> dispatchHandlers bot (Message t "" IdleMsg) >> return Idle
EOF -> infoM "Connection closed" >> return Disconnected
Line _ _ -> error "This should never happen"
Msg (message@Message { .. }) -> do

40
hask-irc-core/Network/IRC/Util.hs
Unescape View File

@ -2,11 +2,15 @@
module Network.IRC.Util where
import qualified Data.Text.Lazy as LzT
import qualified Data.Text.Format as TF
import ClassyPrelude
import Control.Arrow (Arrow)
import Control.Concurrent.Lifted (Chan)
import Control.Monad.Base (MonadBase)
import Data.Text (strip)
import Data.Time (diffUTCTime)
oneSec :: Int
oneSec = 1000000
@ -42,3 +46,39 @@ both f = first f . second f
atomicModIORef :: MonadBase IO f => IORef t -> (t -> t) -> f ()
atomicModIORef ref f = void . atomicModifyIORef' ref $ \v -> (f v, v)
-- | Display a time span as one time relative to another.
relativeTime :: UTCTime -> UTCTime -> Text
relativeTime t1 t2 =
maybe "unknown" (LzT.toStrict . format) $ find (\(s,_,_) -> abs period >= s) ranges
where
minute = 60; hour = minute * 60; day = hour * 24;
week = day * 7; month = day * 30; year = month * 12
format range =
(if period > 0 then "in " else "")
++ case range of
(0, _, _) -> "moments"
(_, str, 0) -> pack str
(_, str, base) -> TF.format (fromString str) $ TF.Only (abs $ round (period / base) :: Integer)
++ (if period < 0 then " ago" else "")
period = t1 `diffUTCTime` t2
ranges = [(year*2, "{} years", year)
,(year, "a year", 0)
,(month*2, "{} months", month)
,(month, "a month", 0)
,(week*2, "{} weeks", week)
,(week, "a week", 0)
,(day*2, "{} days", day)
,(day, "a day", 0)
,(hour*4, "{} hours", hour)
,(hour*3, "a few hours", 0)
,(hour*2, "{} hours", hour)
,(hour, "an hour", 0)
,(minute*31, "{} minutes", minute)
,(minute*30, "half an hour", 0)
,(minute*2, "{} minutes", minute)
,(minute, "a minute", 0)
,(0, "{} seconds", 1)
]

99
hask-irc-handlers/Network/IRC/Handlers/NickTracker.hs
Unescape View File

@ -23,34 +23,37 @@ import Network.IRC.Handlers.NickTracker.Types
import Network.IRC.Types hiding (Nick)
import Network.IRC.Util
getByNick :: Nick -> Query NickTracking (Maybe NickTrack)
getByNick nick = do
getByNickQ :: Nick -> Query NickTracking (Maybe NickTrack)
getByNickQ nick = do
NickTracking { .. } <- ask
return . getOne $ nickTracking @= nick
getByCanonicalNick :: CanonicalNick -> Query NickTracking [NickTrack]
getByCanonicalNick canonicalNick = do
getByCanonicalNickQ :: CanonicalNick -> Query NickTracking [NickTrack]
getByCanonicalNickQ canonicalNick = do
NickTracking { .. } <- ask
return . IS.toList $ nickTracking @= canonicalNick
saveNickTrack :: NickTrack -> Update NickTracking ()
saveNickTrack nt = do
saveNickTrackQ :: NickTrack -> Update NickTracking ()
saveNickTrackQ nt = do
NickTracking { .. } <- get
put . NickTracking $ IS.updateIx (nick nt) nt nickTracking
$(makeAcidic ''NickTracking ['getByNick, 'getByCanonicalNick, 'saveNickTrack])
$(makeAcidic ''NickTracking ['getByNickQ, 'getByCanonicalNickQ, 'saveNickTrackQ])
getByNick :: AcidState NickTracking -> Text -> IO (Maybe NickTrack)
getByNick acid = query acid . GetByNickQ . Nick
saveNickTrack :: AcidState NickTracking -> NickTrack -> IO ()
saveNickTrack acid = update acid . SaveNickTrackQ
data NickTrackingState = NickTrackingState { acid :: AcidState NickTracking
, refreshInterval :: NominalDiffTime
, onlineNicks :: HashSet Nick
, lastRefreshOn :: UTCTime }
modifyOnlineNicks :: (HashSet Nick -> HashSet Nick) -> NickTrackingState -> NickTrackingState
modifyOnlineNicks f state = state { onlineNicks = f . onlineNicks $ state }
nickTrackerMsg :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m (Maybe Command)
nickTrackerMsg state Message { .. } = case msgDetails of
ChannelMsg { .. } -> updateNickTrack state user msg msgTime >> handleCommands msg
nickTrackerMsg state message@Message { .. } = case msgDetails of
ChannelMsg { .. } -> updateNickTrack state user msg msgTime >> handleCommands
ActionMsg { .. } -> updateNickTrack state user msg msgTime >> return Nothing
JoinMsg { .. } -> updateNickTrack state user "" msgTime >> add user >> return Nothing
PartMsg { .. } -> updateNickTrack state user msg msgTime >> remove user >> return Nothing
@ -69,39 +72,40 @@ nickTrackerMsg state Message { .. } = case msgDetails of
where
updateRefreshTime = atomicModIORef state $ \ s -> s { lastRefreshOn = msgTime }
add = atomicModIORef state . modifyOnlineNicks . flip ((. (Nick . userNick)) . flip insertSet)
remove = atomicModIORef state . modifyOnlineNicks . flip ((. (Nick . userNick)) . flip deleteSet)
swap users = atomicModIORef state . modifyOnlineNicks $
modifyOnlineNicks f = atomicModIORef state $ \s -> s { onlineNicks = f . onlineNicks $ s }
add = modifyOnlineNicks . flip ((. (Nick . userNick)) . flip insertSet)
remove = modifyOnlineNicks . flip ((. (Nick . userNick)) . flip deleteSet)
swap users = modifyOnlineNicks $
let (oNick, nNick) = both (Nick . userNick) users
in deleteSet oNick . insertSet nNick
refresh = atomicModIORef state . modifyOnlineNicks . const . setFromList . map Nick
refresh = modifyOnlineNicks . const . setFromList . map Nick
commands = [ ("!nick", handleNickCommand)
, ("!seen", handleSeenCommand) ]
commands = [ ("!nick", handleNickCommand)
, ("!seen", handleSeenCommand)
, ("!forgetnicks", handleForgetNicksCommand)]
handleCommands msg = case find ((`isPrefixOf` msg) . fst) commands of
handleCommands = case find ((`isPrefixOf` msg msgDetails) . fst) commands of
Nothing -> return Nothing
Just (_, handler) -> handler state msg
Just (_, handler) -> handler state message
updateNickTrack :: MonadMsgHandler m => IORef NickTrackingState -> User -> Text -> UTCTime -> m ()
updateNickTrack state user message msgTime = io $ do
NickTrackingState { .. } <- readIORef state
let nck = userNick user
mnt <- query acid . GetByNick $ Nick nck
mnt <- getByNick acid nck
(message', lastMessageOn', cn) <- case (message, mnt) of
("", Just (NickTrack { .. })) -> return (lastMessage, lastMessageOn, canonicalNick)
(_, Just (NickTrack { .. })) -> return (message, msgTime, canonicalNick)
_ -> newCanonicalNick >>= \cn -> return (message, msgTime, cn)
update acid . SaveNickTrack $
NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message'
saveNickTrack acid $ NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message'
handleNickChange :: MonadMsgHandler m => IORef NickTrackingState -> User -> Text -> UTCTime -> m ()
handleNickChange state user newNick msgTime = io $ do
NickTrackingState { .. } <- readIORef state
let prevNick = userNick user
mpnt <- query acid . GetByNick $ Nick prevNick
mnt <- query acid . GetByNick $ Nick newNick
mpnt <- getByNick acid prevNick
mnt <- getByNick acid newNick
mInfo <- case (mpnt, mnt) of
(Nothing, _) -> newCanonicalNick >>= \cn -> return $ Just ("", cn, msgTime)
(Just pnt, Nothing) ->
@ -112,49 +116,59 @@ handleNickChange state user newNick msgTime = io $ do
_ -> return Nothing
whenJust mInfo $ \(message, cn, lastMessageOn') ->
update acid . SaveNickTrack $
NickTrack (Nick newNick) cn (LastSeenOn msgTime) lastMessageOn' message
saveNickTrack acid $ NickTrack (Nick newNick) cn (LastSeenOn msgTime) lastMessageOn' message
newCanonicalNick :: IO CanonicalNick
newCanonicalNick = map (CanonicalNick . pack . U.toString) U.nextRandom
withNickTracks :: MonadMsgHandler m
=> (Text -> [NickTrack] -> HashSet Nick -> IO Text) -> IORef NickTrackingState -> Text
=> (Text -> [NickTrack] -> HashSet Nick -> IO Text) -> IORef NickTrackingState -> Message
-> m (Maybe Command)
withNickTracks f state msg = io $ do
withNickTracks f state message = io $ do
NickTrackingState { .. } <- readIORef state
let nick = clean . unwords . drop 1 . words $ msg
mcn <- liftM (map canonicalNick) . query acid . GetByNick $ Nick nick
map (Just . ChannelMsgReply) $ case mcn of
Nothing -> return $ "Unknown nick: " ++ nick
Just cn -> io $ query acid (GetByCanonicalNick cn) >>= \nts -> f nick nts onlineNicks
handleNickCommand :: MonadMsgHandler m => IORef NickTrackingState -> Text -> m (Maybe Command)
let nick = clean . unwords . drop 1 . words . msg . msgDetails $ message
if nick == ""
then return Nothing
else do
mcn <- liftM (map canonicalNick) . getByNick acid $ nick
map (Just . ChannelMsgReply) $ case mcn of
Nothing -> return $ "Unknown nick: " ++ nick
Just cn -> io $ query acid (GetByCanonicalNickQ cn) >>= \nts -> f nick nts onlineNicks
handleNickCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m (Maybe Command)
handleNickCommand = withNickTracks $ \nck nickTracks _ -> do
let nicks = map ((\(Nick n) -> n) . nick) nickTracks
if length nicks == 1
then return $ nck ++ " has only one nick"
else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks)
handleSeenCommand :: MonadMsgHandler m => IORef NickTrackingState -> Text -> m (Maybe Command)
handleSeenCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m (Maybe Command)
handleSeenCommand = withNickTracks $ \nck nickTracks onlineNicks -> do
let NickTrack { lastSeenOn = LastSeenOn lastSeenOn'
, nick = Nick lastSeenAs } = maximumByEx (comparing lastSeenOn) nickTracks
let NickTrack { lastMessageOn = lastMessageOn'
, lastMessage = lastMessage'
, nick = Nick lastMessageAs } = maximumByEx (comparing lastMessageOn) nickTracks
now <- io getCurrentTime
return $
(if any (`member` onlineNicks) . map nick $ nickTracks
then nck ++ " is online now"
else nck ++ " was last seen on " ++ fmtTime lastSeenOn') ++
else nck ++ " was last seen " ++ relativeTime lastSeenOn' now) ++
(if nck /= lastSeenAs then " as " ++ lastSeenAs else "") ++
(if clean lastMessage' == "" then "" else
" and at " ++ fmtTime lastMessageOn' ++ " " ++ nck ++
" and " ++ relativeTime lastMessageOn' now ++ " " ++ nck ++
(if nck /= lastMessageAs then " as " ++ lastMessageAs else "") ++
" said: " ++ lastMessage')
where
fmtTime = pack . formatTime defaultTimeLocale "%F %T"
handleForgetNicksCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m (Maybe Command)
handleForgetNicksCommand state Message { msgDetails = ~ChannelMsg { .. }, .. } = do
NickTrackingState { .. } <- readIORef state
let nick = userNick user
io $ do
Just nt <- getByNick acid nick
cn <- newCanonicalNick
saveNickTrack acid $ nt { canonicalNick = cn }
return . Just . ChannelMsgReply $ "Forgot all alternate nicks of " ++ nick
stopNickTracker :: MonadMsgHandler m => IORef NickTrackingState -> m ()
stopNickTracker state = io $ do
@ -169,7 +183,6 @@ mkMsgHandler BotConfig { .. } _ "nicktracker" = do
refreshInterval <- map convert (CF.lookupDefault 60 config "nicktracker.refresh_interval" :: IO Int)
acid <- openLocalState emptyNickTracking
newIORef (NickTrackingState acid refreshInterval mempty now)
return . Just $ newMsgHandler { onMessage = nickTrackerMsg state
, onStop = stopNickTracker state
, onHelp = return helpMsgs }

Write Preview
Loading…
Cancel
Save