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

Added tell command handler

Browse Source
This commit is contained in:
Abhinav Sarkar 2014-06-01 06:48:24 +05:30
parent 068b967e8e
commit 651244834e
14 changed files with 256 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -143,8 +143,8 @@ messageProcessLoop = messageProcessLoop' 0
forM_ (mapValues msgHandlers) $ \msgHandler -> void . fork $
handle (\(e :: SomeException) ->
errorM $ "Exception while processing message: " ++ show e) $ do
mCmd <- handleMessage msgHandler botConfig message
whenJust mCmd (sendCommand commandChan)
cmds <- handleMessage msgHandler botConfig message
forM_ cmds (sendCommand commandChan)
eventProcessLoop :: Channel SomeEvent -> Chan Line -> Chan Command -> Bot -> IO ()
eventProcessLoop (eventChan, latch) lineChan commandChan bot@Bot {.. } = do

6
hask-irc-core/Network/IRC/Types.hs
View File

@ -172,7 +172,7 @@ class (MonadIO m, Applicative m, MonadReader BotConfig m, MonadBase IO m) => Mon
instance MonadMsgHandler MsgHandlerT where
msgHandler = id
handleMessage :: MsgHandler -> BotConfig -> Message -> IO (Maybe Command)
handleMessage :: MsgHandler -> BotConfig -> Message -> IO [Command]
handleMessage MsgHandler { .. } botConfig =
flip runReaderT botConfig . _runMsgHandler . onMessage
@ -189,7 +189,7 @@ getHelp MsgHandler { .. } botConfig =
flip runReaderT botConfig . _runMsgHandler $ onHelp
data MsgHandler = MsgHandler {
onMessage :: !(forall m . MonadMsgHandler m => Message -> m (Maybe Command)),
onMessage :: !(forall m . MonadMsgHandler m => Message -> m [Command]),
onStop :: !(forall m . MonadMsgHandler m => m ()),
onEvent :: !(forall m . MonadMsgHandler m => SomeEvent -> m EventResponse),
onHelp :: !(forall m . MonadMsgHandler m => m (Map Text Text))
@ -197,7 +197,7 @@ data MsgHandler = MsgHandler {
newMsgHandler :: MsgHandler
newMsgHandler = MsgHandler {
onMessage = const $ return Nothing,
onMessage = const $ return [],
onStop = return (),
onEvent = const $ return RespNothing,
onHelp = return mempty

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

@ -57,10 +57,9 @@ relativeTime t1 t2 =
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 "")
++ (if period <= 0 then " ago" else "")
period = t1 `diffUTCTime` t2

2
hask-irc-handlers/Network/IRC/Handlers.hs
View File

@ -8,6 +8,7 @@ import qualified Network.IRC.Handlers.Greet as Greet
import qualified Network.IRC.Handlers.MessageLogger as Logger
import qualified Network.IRC.Handlers.NickTracker as NickTracker
import qualified Network.IRC.Handlers.SongSearch as SongSearch
import qualified Network.IRC.Handlers.Tell as Tell
import ClassyPrelude
import Control.Concurrent.Lifted (Chan)
@ -32,4 +33,5 @@ mkMsgHandler botConfig eventChan name =
, Logger.mkMsgHandler
, NickTracker.mkMsgHandler
, SongSearch.mkMsgHandler
, Tell.mkMsgHandler
]

6
hask-irc-handlers/Network/IRC/Handlers/Auth.hs
View File

@ -43,11 +43,11 @@ issueToken acid user = do
-- handler
authMessage :: MonadMsgHandler m => IORef (AcidState Auth) -> Message -> m (Maybe Command)
authMessage :: MonadMsgHandler m => IORef (AcidState Auth) -> Message -> m [Command]
authMessage state Message { msgDetails = PrivMsg { .. }, .. }
| "token" `isPrefixOf` msg = map (Just . PrivMsgReply user) . io $
| "token" `isPrefixOf` msg = map (singleton . PrivMsgReply user) . io $
readIORef state >>= flip issueToken (userNick user)
authMessage _ _ = return Nothing
authMessage _ _ = return []
stopAuth :: MonadMsgHandler m => IORef (AcidState Auth) -> m ()
stopAuth state = io $ do

20
hask-irc-handlers/Network/IRC/Handlers/Core.hs
View File

@ -20,13 +20,13 @@ mkMsgHandler _ _ "help" =
helpMsg = "Get help. !help or !help <command>"
mkMsgHandler _ _ _ = return Nothing
pingPong :: MonadMsgHandler m => IORef UTCTime -> Message -> m (Maybe Command)
pingPong :: MonadMsgHandler m => IORef UTCTime -> Message -> m [Command]
pingPong state Message { msgDetails = PingMsg { .. }, .. } = do
io $ atomicWriteIORef state msgTime
return . Just $ PongCmd msg
return [PongCmd msg]
pingPong state Message { msgDetails = PongMsg { .. }, .. } = do
io $ atomicWriteIORef state msgTime
return Nothing
return []
pingPong state Message { msgDetails = IdleMsg { .. }, .. }
| even (convert msgTime :: Int) = do
BotConfig { .. } <- ask
@ -34,21 +34,21 @@ pingPong state Message { msgDetails = IdleMsg { .. }, .. }
io $ do
lastComm <- readIORef state
if addUTCTime limit lastComm < msgTime
then return . Just . PingCmd . pack . formatTime defaultTimeLocale "%s" $ msgTime
else return Nothing
then return [PingCmd . pack . formatTime defaultTimeLocale "%s" $ msgTime]
else return []
pingPong _ _ = return Nothing
pingPong _ _ = return []
help :: MonadMsgHandler m => Message -> m (Maybe Command)
help :: MonadMsgHandler m => Message -> m [Command]
help Message { msgDetails = ChannelMsg { .. }, .. }
| "!help" == clean msg = do
BotConfig { .. } <- ask
let commands = concatMap mapKeys . mapValues $ msgHandlerInfo
return . Just . ChannelMsgReply $ "I know these commands: " ++ unwords commands
return [ChannelMsgReply $ "I know these commands: " ++ unwords commands]
| "!help" `isPrefixOf` msg = do
BotConfig { .. } <- ask
let command = cons '!'. dropWhile (== '!') . clean . unwords . drop 1 . words $ msg
let mHelp = find ((== command) . fst) . concatMap mapToList . mapValues $ msgHandlerInfo
return . Just . ChannelMsgReply $ maybe ("No such command found: " ++ command) snd mHelp
return [ChannelMsgReply $ maybe ("No such command found: " ++ command) snd mHelp]
help _ = return Nothing
help _ = return []

14
hask-irc-handlers/Network/IRC/Handlers/Greet.hs
View File

@ -12,22 +12,22 @@ mkMsgHandler _ _ "greeter" = return . Just $ newMsgHandler { onMessage = greete
mkMsgHandler _ _ "welcomer" = return . Just $ newMsgHandler { onMessage = welcomer }
mkMsgHandler _ _ _ = return Nothing
greeter :: MonadMsgHandler m => Message -> m (Maybe Command)
greeter :: MonadMsgHandler m => Message -> m [Command]
greeter Message { msgDetails = ChannelMsg { .. }, .. } =
return . map (ChannelMsgReply . (++ nickToText (userNick user)) . (++ " "))
return . maybeToList . map (ChannelMsgReply . (++ nickToText (userNick user)) . (++ " "))
. find (== clean msg) $ greetings
where
greetings = [ "hi", "hello", "hey", "sup", "bye"
, "good morning", "good evening", "good night" ]
greeter _ = return Nothing
greeter _ = return []
welcomer :: MonadMsgHandler m => Message -> m (Maybe Command)
welcomer :: MonadMsgHandler m => Message -> m [Command]
welcomer Message { msgDetails = JoinMsg { .. }, .. } = do
BotConfig { .. } <- ask
if userNick user /= botNick
then return . Just . ChannelMsgReply $ "welcome back " ++ nickToText (userNick user)
else return Nothing
then return [ChannelMsgReply $ "welcome back " ++ nickToText (userNick user)]
else return []
welcomer _ = return Nothing
welcomer _ = return []

8
hask-irc-handlers/Network/IRC/Handlers/MessageLogger.hs
View File

@ -50,7 +50,7 @@ initMessageLogger botConfig state = do
exitMessageLogger :: MonadMsgHandler m => IORef LoggerState -> m ()
exitMessageLogger state = io $ readIORef state >>= flip whenJust (hClose . fst)
withLogFile :: MonadMsgHandler m => (Handle -> IO ()) -> IORef LoggerState -> m (Maybe Command)
withLogFile :: MonadMsgHandler m => (Handle -> IO ()) -> IORef LoggerState -> m [Command]
withLogFile action state = do
botConfig <- ask
io $ do
@ -70,9 +70,9 @@ withLogFile action state = do
action logFileHandle'
atomicWriteIORef state $ Just (logFileHandle', curDay)
return Nothing
return []
messageLogger :: MonadMsgHandler m => Message -> IORef LoggerState -> m (Maybe Command)
messageLogger :: MonadMsgHandler m => Message -> IORef LoggerState -> m [Command]
messageLogger Message { .. } = case msgDetails of
ChannelMsg { .. } -> log "<{}> {}" [nick user, msg]
ActionMsg { .. } -> log "<{}> {} {}" [nick user, nick user, msg]
@ -82,7 +82,7 @@ messageLogger Message { .. } = case msgDetails of
QuitMsg { .. } -> log "** {} QUIT :{}" [nick user, msg]
NickMsg { .. } -> log "** {} CHANGED NICK TO {}" [nick user, nickToText newNick]
NamesMsg { .. } -> log "** USERS {}" [unwords . map nickToText $ nicks]
_ -> const $ return Nothing
_ -> const $ return []
where
nick = nickToText . userNick

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

@ -55,24 +55,24 @@ data NickTrackingState = NickTrackingState { acid :: AcidState NickTr
, onlineNicks :: HashSet Nick
, lastRefreshOn :: UTCTime }
nickTrackerMsg :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m (Maybe Command)
nickTrackerMsg :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m [Command]
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
QuitMsg { .. } -> updateNickTrack state user msg msgTime >> remove user >> return Nothing
ActionMsg { .. } -> updateNickTrack state user msg msgTime >> return []
JoinMsg { .. } -> updateNickTrack state user "" msgTime >> add user >> return []
PartMsg { .. } -> updateNickTrack state user msg msgTime >> remove user >> return []
QuitMsg { .. } -> updateNickTrack state user msg msgTime >> remove user >> return []
NickMsg { .. } ->
handleNickChange state user newNick msgTime >> swap (user, User newNick "") >> return Nothing
handleNickChange state user newNick msgTime >> swap (user, User newNick "") >> return []
NamesMsg { .. } -> do
forM_ nicks $ \n -> updateNickTrack state (User n "") "" msgTime
refresh nicks >> updateRefreshTime >> return Nothing
refresh nicks >> updateRefreshTime >> return []
IdleMsg { .. } -> do
NickTrackingState { .. } <- readIORef state
if addUTCTime refreshInterval lastRefreshOn < msgTime
then updateRefreshTime >> return (Just NamesCmd)
else return Nothing
_ -> return Nothing
then updateRefreshTime >> return [NamesCmd]
else return []
_ -> return []
where
updateRefreshTime = atomicModIORef state $ \ s -> s { lastRefreshOn = msgTime }
@ -89,7 +89,7 @@ nickTrackerMsg state message@Message { .. } = case msgDetails of
, ("!forgetnicks", handleForgetNicksCommand)]
handleCommands = case find ((`isPrefixOf` msg msgDetails) . fst) commands of
Nothing -> return Nothing
Nothing -> return []
Just (_, handler) -> handler state message
updateNickTrack :: MonadMsgHandler m => IORef NickTrackingState -> User -> Text -> UTCTime -> m ()
@ -127,26 +127,26 @@ newCanonicalNick = map (CanonicalNick . pack . U.toString) U.nextRandom
withNickTracks :: MonadMsgHandler m
=> (Text -> [NickTrack] -> HashSet Nick -> IO Text) -> IORef NickTrackingState -> Message
-> m (Maybe Command)
-> m [Command]
withNickTracks f state message = io $ do
NickTrackingState { .. } <- readIORef state
let nick = clean . unwords . drop 1 . words . msg . msgDetails $ message
if nick == ""
then return Nothing
then return []
else do
mcn <- liftM (map canonicalNick) . getByNick acid . Nick $ nick
map (Just . ChannelMsgReply) $ case mcn of
map (singleton . 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 :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m [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 -> Message -> m (Maybe Command)
handleSeenCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m [Command]
handleSeenCommand = withNickTracks $ \nck nickTracks onlineNicks -> do
let NickTrack { lastSeenOn = LastSeenOn lastSeenOn'
, nick = Nick lastSeenAs } = maximumByEx (comparing lastSeenOn) nickTracks
@ -164,7 +164,7 @@ handleSeenCommand = withNickTracks $ \nck nickTracks onlineNicks -> do
(if nck /= lastMessageAs then " as " ++ lastMessageAs else "") ++
" said: " ++ lastMessage')
handleForgetNicksCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m (Maybe Command)
handleForgetNicksCommand :: MonadMsgHandler m => IORef NickTrackingState -> Message -> m [Command]
handleForgetNicksCommand state Message { msgDetails = ~ChannelMsg { .. }, .. } = do
NickTrackingState { .. } <- readIORef state
let nick = userNick user
@ -172,7 +172,14 @@ handleForgetNicksCommand state Message { msgDetails = ~ChannelMsg { .. }, .. } =
Just nt <- getByNick acid nick
cn <- newCanonicalNick
saveNickTrack acid $ nt { canonicalNick = cn }
return . Just . ChannelMsgReply $ "Forgot all alternate nicks of " ++ nickToText nick
return [ChannelMsgReply $ "Forgot all alternate nicks of " ++ nickToText nick]
nickTrackerEvent :: MonadMsgHandler m => IORef NickTrackingState -> SomeEvent -> m EventResponse
nickTrackerEvent state event = case fromEvent event of
Just (NickTrackRequest nick reply, _) -> io $ do
NickTrackingState { .. } <- readIORef state
getByNick acid nick >>= putMVar reply >> return RespNothing
_ -> return RespNothing
stopNickTracker :: MonadMsgHandler m => IORef NickTrackingState -> m ()
stopNickTracker state = io $ do
@ -188,11 +195,12 @@ mkMsgHandler BotConfig { .. } _ "nicktracker" = do
acid <- openLocalState emptyNickTracking
newIORef (NickTrackingState acid refreshInterval mempty now)
return . Just $ newMsgHandler { onMessage = nickTrackerMsg state
, onEvent = nickTrackerEvent state
, onStop = stopNickTracker state
, onHelp = return helpMsgs }
where
helpMsgs = mapFromList [
("!nicks", "Shows alternate nicks of the user. !nicks <user nick>"),
("!nicks", "Shows alternate nicks of the user. !nicks <nick>"),
("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen <user nick>"),
("!forgetnicks", "Forgets all your alternate nicks. !forgetnicks") ]
mkMsgHandler _ _ _ = return Nothing

21
hask-irc-handlers/Network/IRC/Handlers/NickTracker/Types.hs
View File

@ -3,9 +3,10 @@
module Network.IRC.Handlers.NickTracker.Types where
import ClassyPrelude
import Data.Data (Data)
import Data.IxSet (IxSet, Indexable (..), ixSet, ixFun)
import Data.SafeCopy (base, deriveSafeCopy)
import Control.Concurrent.Lifted (Chan, writeChan)
import Data.Data (Data)
import Data.IxSet (IxSet, Indexable (..), ixSet, ixFun)
import Data.SafeCopy (base, deriveSafeCopy)
import Network.IRC.Types
@ -35,3 +36,17 @@ $(deriveSafeCopy 0 'base ''NickTracking)
emptyNickTracking :: NickTracking
emptyNickTracking = NickTracking empty
data NickTrackRequest = NickTrackRequest Nick (MVar (Maybe NickTrack)) deriving (Typeable)
instance Event NickTrackRequest
instance Show NickTrackRequest where
show (NickTrackRequest nick _) = "NickTrackRequest[" ++ unpack (nickToText nick) ++ "]"
getCanonicalNick :: Chan SomeEvent -> Nick -> IO (Maybe CanonicalNick)
getCanonicalNick eventChan nick = do
reply <- newEmptyMVar
request <- toEvent $ NickTrackRequest nick reply
writeChan eventChan request
map (map canonicalNick) $ takeMVar reply

8
hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs
View File

@ -37,14 +37,14 @@ instance FromJSON Song where
parseJSON a | a == emptyArray = return NoSong
parseJSON _ = mempty
songSearch :: MonadMsgHandler m => Message -> m (Maybe Command)
songSearch :: MonadMsgHandler m => Message -> m [Command]
songSearch Message { msgDetails = ChannelMsg { .. }, .. }
| "!m " `isPrefixOf` msg = do
BotConfig { .. } <- ask
liftIO $ do
let query = strip . drop 3 $ msg
mApiKey <- CF.lookup config "songsearch.tinysong_apikey"
map (Just . ChannelMsgReply) $ case mApiKey of
map (singleton . ChannelMsgReply) $ case mApiKey of
Nothing -> do
errorM "tinysong api key not found in config"
return $ "Error while searching for " ++ query
@ -58,5 +58,5 @@ songSearch Message { msgDetails = ChannelMsg { .. }, .. }
Right song -> case song of
Song { .. } -> "Listen to " ++ artist ++ " - " ++ name ++ " at " ++ url
NoSong -> "No song found for: " ++ query
| otherwise = return Nothing
songSearch _ = return Nothing
| otherwise = return []
songSearch _ = return []

129
hask-irc-handlers/Network/IRC/Handlers/Tell.hs Normal file
View File

@ -0,0 +1,129 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Network.IRC.Handlers.Tell (mkMsgHandler) where
import qualified Data.IxSet as IS
import ClassyPrelude hiding (swap)
import Control.Concurrent.Lifted (Chan)
import Control.Monad.Reader (ask)
import Control.Monad.State (get, put)
import Data.Acid (AcidState, Query, Update, makeAcidic, query, update,
openLocalState, createArchive)
import Data.Acid.Local (createCheckpointAndClose)
import Data.IxSet ((@=))
import Data.Text (split, strip)
import Network.IRC.Handlers.NickTracker.Types
import Network.IRC.Handlers.Tell.Types
import Network.IRC.Types
import Network.IRC.Util
getUndeliveredTellsQ :: CanonicalNick -> Query Tells [Tell]
getUndeliveredTellsQ nick = do
Tells { .. } <- ask
return . sortBy (comparing tellCreatedOn) . IS.toList $ tells @= nick @= NewTell
saveTellQ :: Tell -> Update Tells ()
saveTellQ tell@Tell { .. } = do
Tells { .. } <- get
if tellId == -1
then put $ Tells (nextTellId + 1) (IS.updateIx nextTellId tell{ tellId = nextTellId } tells)
else put $ Tells nextTellId (IS.updateIx tellId tell tells)
$(makeAcidic ''Tells ['getUndeliveredTellsQ, 'saveTellQ])
getUndeliveredTells :: AcidState Tells -> CanonicalNick -> IO [Tell]
getUndeliveredTells acid = query acid . GetUndeliveredTellsQ
saveTell :: AcidState Tells -> Tell -> IO ()
saveTell acid = update acid . SaveTellQ
newtype TellState = TellState { acid :: AcidState Tells }
tellMsg :: MonadMsgHandler m => Chan SomeEvent -> IORef TellState -> Message -> m [Command]
tellMsg eventChan state Message { msgDetails = ChannelMsg { .. }, .. }
| command == "!tell"
, args <- drop 1 . words $ msg
, length args >= 2 = io $ do
TellState { .. } <- readIORef state
reps <- if "<" `isPrefixOf` headEx args
then do
let (nicks, message) =
(parseNicks *** (strip . drop 1)) . break (== '>') . drop 1 . unwords $ args
if null message
then return []
else do
res <- forM nicks $ \nick -> handleTell acid nick message
let (fails, passes) = partitionEithers res
let reps = (if null fails then [] else ["Unknown nicks: " ++ intercalate ", " fails]) ++
(if null passes then [] else
["Message noted and will be passed on to " ++ intercalate ", " passes])
return reps
else do
let nick = Nick . headEx $ args
let message = strip . unwords . drop 1 $ args
if null message
then return []
else do
res <- handleTell acid nick message
let rep = case res of
Left _ -> "Unknown nick: " ++ nickToText nick
Right _ -> "Message noted and will be passed on to " ++ nickToText nick
return [rep]
tells <- getTellsToDeliver
return . map textToReply $ (reps ++ tells)
| otherwise = io $ map (map textToReply) getTellsToDeliver
where
command = clean . fromMaybe "" $ headMay . words $ msg
parseNicks = ordNub . map Nick . filter (not . null) . split (\x -> x == ' ' || x == ',')
textToReply t = ChannelMsgReply $ nickToText (userNick user) ++ ": " ++ t
tellToMsg Tell { .. } =
relativeTime tellCreatedOn msgTime ++ " " ++ nickToText tellFromNick ++ " said: " ++ tellContent
newTell canonicalNick = Tell (-1) (userNick user) canonicalNick Nothing NewTell msgTime Nothing
getTellsToDeliver = io $ do
TellState { .. } <- readIORef state
mcn <- getCanonicalNick eventChan $ userNick user
case mcn of
Nothing -> return []
Just canonicalNick -> do
tells <- getUndeliveredTells acid canonicalNick
forM tells $ \tell -> do
saveTell acid tell{ tellStatus = DeliveredTell, tellDeliveredOn = Just msgTime }
return . tellToMsg $ tell
handleTell acid nick message = do
mcn <- getCanonicalNick eventChan nick
case mcn of
Nothing -> return . Left . nickToText $ nick
Just canonicalNick ->
saveTell acid (newTell canonicalNick message) >> (return . Right . nickToText $ nick)
tellMsg _ _ _ = return []
stopTell :: MonadMsgHandler m => IORef TellState -> m ()
stopTell state = io $ do
TellState { .. } <- readIORef state
createArchive acid
createCheckpointAndClose acid
mkMsgHandler :: BotConfig -> Chan SomeEvent -> MsgHandlerName -> IO (Maybe MsgHandler)
mkMsgHandler BotConfig { .. } eventChan "tells" = do
acid <- openLocalState emptyTells
state <- newIORef (TellState acid)
return . Just $ newMsgHandler { onMessage = tellMsg eventChan state
, onStop = stopTell state
, onHelp = return helpMsgs }
where
helpMsgs = mapFromList [
("!tell", "Publically passes a message to a user or a bunch of users. " ++
"!tell <nick> <message> or !tell <<nick1> <nick2> ...> <message>") ]
mkMsgHandler _ _ _ = return Nothing

43
hask-irc-handlers/Network/IRC/Handlers/Tell/Types.hs Normal file
View File

@ -0,0 +1,43 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Handlers.Tell.Types where
import ClassyPrelude
import Data.Data (Data)
import Data.IxSet (IxSet, Indexable (..), ixSet, ixFun)
import Data.SafeCopy (base, deriveSafeCopy)
import Network.IRC.Handlers.NickTracker.Types
import Network.IRC.Types
newtype TellId = TellId Int deriving (Eq, Ord, Show, Data, Typeable, Num)
data TellStatus = NewTell | DeliveredTell deriving (Eq, Ord, Show, Data, Typeable)
data Tell = Tell {
tellId :: !TellId,
tellFromNick :: !Nick,
tellToNick :: !CanonicalNick,
tellTopic :: !(Maybe Text),
tellStatus :: !TellStatus,
tellCreatedOn :: !UTCTime,
tellDeliveredOn :: !(Maybe UTCTime),
tellContent :: !Text
} deriving (Eq, Ord, Show, Data, Typeable)
instance Indexable Tell where
empty = ixSet [ ixFun $ (: []) . tellId
, ixFun $ (: []) . tellToNick
, ixFun $ (: []) . tellStatus ]
data Tells = Tells { nextTellId :: TellId, tells :: IxSet Tell }
deriving (Eq, Ord, Show, Data, Typeable)
$(deriveSafeCopy 0 'base ''TellId)
$(deriveSafeCopy 0 'base ''TellStatus)
$(deriveSafeCopy 0 'base ''Tell)
$(deriveSafeCopy 0 'base ''Tells)
emptyTells :: Tells
emptyTells = Tells (TellId 1) empty

4
hask-irc-handlers/hask-irc-handlers.cabal
View File

@ -83,7 +83,9 @@ library
Network.IRC.Handlers.MessageLogger,
Network.IRC.Handlers.NickTracker,
Network.IRC.Handlers.NickTracker.Types,
Network.IRC.Handlers.SongSearch
Network.IRC.Handlers.SongSearch,
Network.IRC.Handlers.Tell,
Network.IRC.Handlers.Tell.Types
default-language: Haskell2010