module Lambdabot.Plugin.Tell (theModule) where
import Lambdabot.Compat.FreenodeNick
import Lambdabot.Plugin
import Lambdabot.Compat.AltTime
import Control.Arrow (first)
import Control.Monad
import qualified Data.Map as M
import Text.Printf (printf)
data NoteType = Tell | Ask deriving (Show, Eq, Read)
data Note = Note { noteSender :: FreenodeNick,
noteContents :: String,
noteTime :: ClockTime,
noteType :: NoteType }
deriving (Eq, Show, Read)
type NoticeBoard = M.Map FreenodeNick (Maybe ClockTime, [Note])
type Tell = ModuleT NoticeBoard LB
theModule :: Module NoticeBoard
theModule = newModule
{ moduleCmds = return
[ (command "tell")
{ help = say "tell <nick> <message>. When <nick> shows activity, tell them <message>."
, process = doTell Tell . words
}
, (command "ask")
{ help = say "ask <nick> <message>. When <nick> shows activity, ask them <message>."
, process = doTell Ask . words
}
, (command "messages")
{ help = say "messages. Check your messages, responding in private."
, process = const (doMessages False)
}
, (command "messages-loud")
{ help = say "messages. Check your messages, responding in public."
, process = const (doMessages True)
}
, (command "messages?")
{ help = say "messages?. Tells you whether you have any messages"
, process = const $ do
sender <- getSender
ms <- getMessages sender
case ms of
Just _ -> doRemind sender
Nothing -> say "Sorry, no messages today."
}
, (command "clear-messages")
{ help = say "clear-messages. Clears your messages."
, process = const $ do
sender <- getSender
clearMessages sender
say "Messages cleared."
}
, (command "print-notices")
{ privileged = True
, help = say "print-notices. Print the current map of notes."
, process = const ((say . show) =<< readMS)
}
, (command "purge-notices")
{ privileged = True
, help = say $
"purge-notices [<nick> [<nick> [<nick> ...]]]]. "
++ "Clear all notes for specified nicks, or all notices if you don't "
++ "specify a nick."
, process = \args -> do
users <- mapM readNick (words args)
if null users
then writeMS M.empty
else mapM_ clearMessages users
say "Messages purged."
}
]
, moduleDefState = return M.empty
, moduleSerialize = Just mapSerial
, contextual = const $ do
sender <- getSender
remp <- needToRemind sender
if remp
then doRemind sender
else return ()
}
showNote :: ClockTime -> Note -> Cmd Tell String
showNote time note = do
sender <- showNick (getFreenodeNick (noteSender note))
let diff = time `diffClockTimes` noteTime note
ago = case timeDiffPretty diff of
[] -> "less than a minute"
pr -> pr
action = case noteType note of Tell -> "said"; Ask -> "asked"
return $ printf "%s %s %s ago: %s" sender action ago (noteContents note)
needToRemind :: Nick -> Cmd Tell Bool
needToRemind n = do
st <- readMS
now <- io getClockTime
return $ case M.lookup (FreenodeNick n) st of
Just (Just lastTime, _) ->
let diff = now `diffClockTimes` lastTime
in diff > TimeDiff 86400
Just (Nothing, _) -> True
Nothing -> True
writeDown :: Nick -> Nick -> String -> NoteType -> Cmd Tell ()
writeDown to from what ntype = do
time <- io getClockTime
let note = Note { noteSender = FreenodeNick from,
noteContents = what,
noteTime = time,
noteType = ntype }
modifyMS (M.insertWith (\_ (_, ns) -> (Nothing, ns ++ [note]))
(FreenodeNick to) (Nothing, [note]))
getMessages :: Nick -> Cmd Tell (Maybe [Note])
getMessages sender = fmap (fmap snd . M.lookup (FreenodeNick sender)) readMS
clearMessages :: Nick -> Cmd Tell ()
clearMessages sender = modifyMS (M.delete (FreenodeNick sender))
doMessages :: Bool -> Cmd Tell ()
doMessages loud = do
sender <- getSender
msgs <- getMessages sender
clearMessages sender
let tellNote = if loud
then say
else lb . ircPrivmsg sender
case msgs of
Nothing -> say "You don't have any messages"
Just mesgs -> do
time <- io getClockTime
mapM_ (showNote time >=> tellNote) mesgs
verb :: NoteType -> String
verb Ask = "ask"
verb Tell= "tell"
doTell :: NoteType -> [String] -> Cmd Tell ()
doTell ntype [] = say ("Who should I " ++ verb ntype ++ "?")
doTell ntype (who:args) = do
recipient <- readNick who
sender <- getSender
me <- getLambdabotName
let rest = unwords args
(record, res) | sender == recipient = (False, "You can " ++ verb ntype ++ " yourself!")
| recipient == me = (False, "Nice try ;)")
| null args = (False, "What should I " ++ verb ntype ++ " " ++ who ++ "?")
| otherwise = (True, "Consider it noted.")
when record (writeDown recipient sender rest ntype)
say res
doRemind :: Nick -> Cmd Tell ()
doRemind sender = do
ms <- getMessages sender
now <- io getClockTime
modifyMS (M.update (Just . first (const $ Just now)) (FreenodeNick sender))
case ms of
Just msgs -> do
me <- showNick =<< getLambdabotName
let (messages, pronoun)
| length msgs > 1 = ("messages", "them")
| otherwise = ("message", "it")
msg = printf "You have %d new %s. '/msg %s @messages' to read %s."
(length msgs) messages me pronoun
lb (ircPrivmsg sender msg)
Nothing -> return ()