{- Leave a message with lambdabot, the faithful secretary

> 17:11 < davidhouse> @tell dmhouse foo
> 17:11 < hsbot> Consider it noted
> 17:11 < davidhouse> @tell dmhouse bar
> 17:11 < hsbot> Consider it noted
> 17:11 < dmhouse> hello!
> 17:11 < hsbot> dmhouse: You have 2 new messages. '/msg hsbot @messages' to read them.
> 17:11 < dmhouse> Notice how I'm speaking again, and hsbot isn't buzzing me more than that one time.
> 17:12 < dmhouse> It'll buzz me after a day's worth of not checking my messages.
> 17:12 < dmhouse> If I want to check them in the intermittent period, I can either send a /msg, or:
> 17:12 < dmhouse> @messages?
> 17:12 < hsbot> You have 2 messages
> 17:12 < dmhouse> Let's check them, shall we?
>
> [In a /msg to hsbot]
> 17:12 <hsbot> davidhouse said less than a minute ago: foo
> 17:12 <hsbot> davidhouse said less than a minute ago: bar
>
> [Back in the channel
> 17:12 < dmhouse> You needn't use a /msg, however. If you're not going to annoy the channel by printing 20 of
>                  your messages, feel free to just type '@messages' in the channel.
> 17:12 < davidhouse> @tell dmhouse foobar
> 17:12 < hsbot> Consider it noted
> 17:12 < davidhouse> @ask dmhouse barfoo
> 17:12 < hsbot> Consider it noted
> 17:12 < davidhouse> You can see there @ask. It's just a synonym for @tell, but it prints "foo asked X ago M",
>                     which is more natural. E.g. '@ask dons whether he's applied my latest patch yet?'
> 17:13 < dmhouse> For the admins, a useful little debugging tool is @print-notices.
> 17:13 < hsbot> dmhouse: You have 2 new messages. '/msg hsbot @messages' to read them.
> 17:14 < dmhouse> Notice that hsbot pinged me there, even though it's less than a day since I last checked my
>                  messages, because there have been some new ones posted.
> 17:14 < dmhouse> @print-notices
> 17:14 < hsbot> {"dmhouse":=(Just Thu Jun  8 17:13:46 BST 2006,[Note {noteSender = "davidhouse", noteContents =
>                "foobar", noteTime = Thu Jun  8 17:12:50 BST 2006, noteType = Tell},Note {noteSender =
                 "davidhouse", noteContents = "barfoo", noteTime = Thu Jun  8 17:12:55 BST 2006, noteType = Ask}])}
> 17:15 < dmhouse> There you can see the two notes. The internal state is a map from recipient nicks to a pair of
>                  (when we last buzzed them about having messages, a list of the notes they've got stacked up).
> 17:16 < dmhouse> Finally, if you don't want to bother checking your messages, then the following command will
>                  likely be useful.
> 17:16 < dmhouse> @clear-messages
> 17:16 < hsbot> Messages cleared.
> 17:16 < dmhouse> That's all, folks!
> 17:17 < dmhouse> Any comments, queries or complaints to dmhouse@gmail.com. The source should be fairly readable, so
>                  hack away!
-}

module Lambdabot.Plugin.Social.Tell (tellPlugin) where

import Lambdabot.Compat.AltTime
import Lambdabot.Compat.FreenodeNick
import Lambdabot.Plugin
import Lambdabot.Util

import Control.Monad
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Text.Printf (printf)

-- | Was it @tell or @ask that was the original command?
data NoteType    = Tell | Ask deriving (Int -> NoteType -> String -> String
[NoteType] -> String -> String
NoteType -> String
(Int -> NoteType -> String -> String)
-> (NoteType -> String)
-> ([NoteType] -> String -> String)
-> Show NoteType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NoteType -> String -> String
showsPrec :: Int -> NoteType -> String -> String
$cshow :: NoteType -> String
show :: NoteType -> String
$cshowList :: [NoteType] -> String -> String
showList :: [NoteType] -> String -> String
Show, NoteType -> NoteType -> Bool
(NoteType -> NoteType -> Bool)
-> (NoteType -> NoteType -> Bool) -> Eq NoteType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoteType -> NoteType -> Bool
== :: NoteType -> NoteType -> Bool
$c/= :: NoteType -> NoteType -> Bool
/= :: NoteType -> NoteType -> Bool
Eq, ReadPrec [NoteType]
ReadPrec NoteType
Int -> ReadS NoteType
ReadS [NoteType]
(Int -> ReadS NoteType)
-> ReadS [NoteType]
-> ReadPrec NoteType
-> ReadPrec [NoteType]
-> Read NoteType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NoteType
readsPrec :: Int -> ReadS NoteType
$creadList :: ReadS [NoteType]
readList :: ReadS [NoteType]
$creadPrec :: ReadPrec NoteType
readPrec :: ReadPrec NoteType
$creadListPrec :: ReadPrec [NoteType]
readListPrec :: ReadPrec [NoteType]
Read)
-- | The Note datatype. Fields self-explanatory.
data Note        = Note { Note -> FreenodeNick
noteSender   :: FreenodeNick,
                          Note -> String
noteContents :: String,
                          Note -> ClockTime
noteTime     :: ClockTime,
                          Note -> NoteType
noteType     :: NoteType }
                   deriving (Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
/= :: Note -> Note -> Bool
Eq, Int -> Note -> String -> String
[Note] -> String -> String
Note -> String
(Int -> Note -> String -> String)
-> (Note -> String) -> ([Note] -> String -> String) -> Show Note
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Note -> String -> String
showsPrec :: Int -> Note -> String -> String
$cshow :: Note -> String
show :: Note -> String
$cshowList :: [Note] -> String -> String
showList :: [Note] -> String -> String
Show, ReadPrec [Note]
ReadPrec Note
Int -> ReadS Note
ReadS [Note]
(Int -> ReadS Note)
-> ReadS [Note] -> ReadPrec Note -> ReadPrec [Note] -> Read Note
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Note
readsPrec :: Int -> ReadS Note
$creadList :: ReadS [Note]
readList :: ReadS [Note]
$creadPrec :: ReadPrec Note
readPrec :: ReadPrec Note
$creadListPrec :: ReadPrec [Note]
readListPrec :: ReadPrec [Note]
Read)
-- | The state. A map of (times we last told this nick they've got messages, the
--   messages themselves, the auto-reply)
type NoticeEntry = (Maybe ClockTime, [Note], Maybe String)
type NoticeBoard = M.Map FreenodeNick NoticeEntry

type Tell = ModuleT NoticeBoard LB

tellPlugin :: Module NoticeBoard
tellPlugin :: Module (Map FreenodeNick NoticeEntry)
tellPlugin = Module (Map FreenodeNick NoticeEntry)
forall st. Module st
newModule
    { moduleCmds :: ModuleT (Map FreenodeNick NoticeEntry) LB [Command Tell]
moduleCmds = [Command Tell]
-> ModuleT (Map FreenodeNick NoticeEntry) LB [Command Tell]
forall a. a -> ModuleT (Map FreenodeNick NoticeEntry) LB a
forall (m :: * -> *) a. Monad m => a -> m a
return
        [ (String -> Command Identity
command String
"tell")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"tell <nick> <message>. When <nick> shows activity, tell them <message>."
            , process :: String -> Cmd Tell ()
process = NoteType -> [String] -> Cmd Tell ()
doTell NoteType
Tell ([String] -> Cmd Tell ())
-> (String -> [String]) -> String -> Cmd Tell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
            }
        , (String -> Command Identity
command String
"ask")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"ask <nick> <message>. When <nick> shows activity, ask them <message>."
            , process :: String -> Cmd Tell ()
process = NoteType -> [String] -> Cmd Tell ()
doTell NoteType
Ask ([String] -> Cmd Tell ())
-> (String -> [String]) -> String -> Cmd Tell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
            }
        , (String -> Command Identity
command String
"messages")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"messages. Check your messages, responding in private."
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Bool -> Cmd Tell ()
doMessages Bool
False)
            }
        , (String -> Command Identity
command String
"messages-loud")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"messages. Check your messages, responding in public."
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Bool -> Cmd Tell ()
doMessages Bool
True)
            }
        , (String -> Command Identity
command String
"messages?")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"messages?. Tells you whether you have any messages"
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Cmd Tell () -> String -> Cmd Tell ())
-> Cmd Tell () -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ do
                Nick
sender <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                Maybe [Note]
ms <- Nick -> Cmd Tell (Maybe [Note])
getMessages Nick
sender
                case Maybe [Note]
ms of
                    Just [Note]
_      -> Nick -> (String -> Cmd Tell ()) -> Cmd Tell ()
doRemind Nick
sender String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
                    Maybe [Note]
Nothing     -> String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Sorry, no messages today."
            }
        , (String -> Command Identity
command String
"clear-messages")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"clear-messages. Clears your messages."
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Cmd Tell () -> String -> Cmd Tell ())
-> Cmd Tell () -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ do
                Nick
sender <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                Nick -> Cmd Tell ()
clearMessages Nick
sender
                String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Messages cleared."
            }
        , (String -> Command Identity
command String
"auto-reply")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"auto-reply. Lets lambdabot auto-reply if someone sends you a message"
            , process :: String -> Cmd Tell ()
process = String -> Cmd Tell ()
doAutoReply
            }
        , (String -> Command Identity
command String
"auto-reply?")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"auto-reply?. Tells you your auto-reply status"
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Cmd Tell () -> String -> Cmd Tell ())
-> Cmd Tell () -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ do
                Nick
sender <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                Maybe String
a <- Nick -> Cmd Tell (Maybe String)
getAutoReply Nick
sender
                case Maybe String
a of
                    Just String
s      -> String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd Tell ()) -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ String
"Your auto-reply is \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"."
                    Maybe String
Nothing     -> String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"You do not have an auto-reply message set."
            }
        , (String -> Command Identity
command String
"clear-auto-reply")
            { help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"clear-auto-reply. Clears your auto-reply message."
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Cmd Tell () -> String -> Cmd Tell ())
-> Cmd Tell () -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ do
                Nick
sender <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
                Nick -> Cmd Tell ()
clearAutoReply Nick
sender
                String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Auto-reply message cleared."
            }
        , (String -> Command Identity
command String
"print-notices")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"print-notices. Print the current map of notes."
            , process :: String -> Cmd Tell ()
process = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const ((String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd Tell ())
-> (Map FreenodeNick NoticeEntry -> String)
-> Map FreenodeNick NoticeEntry
-> Cmd Tell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FreenodeNick NoticeEntry -> String
forall a. Show a => a -> String
show) (Map FreenodeNick NoticeEntry -> Cmd Tell ())
-> Cmd Tell (Map FreenodeNick NoticeEntry) -> Cmd Tell ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd Tell (Map FreenodeNick NoticeEntry)
Cmd Tell (LBState (Cmd Tell))
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS)
            }
        , (String -> Command Identity
command String
"purge-notices")
            { privileged :: Bool
privileged = Bool
True
            , help :: Cmd Tell ()
help = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd Tell ()) -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$
                String
"purge-notices [<nick> [<nick> [<nick> ...]]]]. "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Clear all notes for specified nicks, or all notices if you don't "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"specify a nick."
            , process :: String -> Cmd Tell ()
process = \String
args -> do
                [Nick]
users <- (String -> Cmd Tell Nick) -> [String] -> Cmd Tell [Nick]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> Cmd Tell Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick (String -> [String]
words String
args)
                if [Nick] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Nick]
users
                    then LBState (Cmd Tell) -> Cmd Tell ()
forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS Map FreenodeNick NoticeEntry
LBState (Cmd Tell)
forall k a. Map k a
M.empty
                    else (Nick -> Cmd Tell ()) -> [Nick] -> Cmd Tell ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Nick -> Cmd Tell ()
clearMessages [Nick]
users
                String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Messages purged."
            }
        ]
    , moduleDefState :: LB (Map FreenodeNick NoticeEntry)
moduleDefState  = Map FreenodeNick NoticeEntry -> LB (Map FreenodeNick NoticeEntry)
forall a. a -> LB a
forall (m :: * -> *) a. Monad m => a -> m a
return Map FreenodeNick NoticeEntry
forall k a. Map k a
M.empty
    , moduleSerialize :: Maybe (Serial (Map FreenodeNick NoticeEntry))
moduleSerialize = Serial (Map FreenodeNick NoticeEntry)
-> Maybe (Serial (Map FreenodeNick NoticeEntry))
forall a. a -> Maybe a
Just Serial (Map FreenodeNick NoticeEntry)
forall k v.
(Ord k, Show k, Show v, Read k, Read v) =>
Serial (Map k v)
mapSerial
    -- Hook onto contextual. Grab nicks of incoming messages, and tell them
    -- if they have any messages, if it's less than a day since we last did so.
    , contextual :: String -> Cmd Tell ()
contextual = Cmd Tell () -> String -> Cmd Tell ()
forall a b. a -> b -> a
const (Cmd Tell () -> String -> Cmd Tell ())
-> Cmd Tell () -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ do
        Nick
sender <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
        Bool
remp <- Nick -> Cmd Tell Bool
needToRemind Nick
sender
        if Bool
remp
            then Nick -> (String -> Cmd Tell ()) -> Cmd Tell ()
doRemind Nick
sender (LB () -> Cmd Tell ()
forall a. LB a -> Cmd Tell a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd Tell ())
-> (String -> LB ()) -> String -> Cmd Tell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> String -> LB ()
ircPrivmsg Nick
sender)
            else () -> Cmd Tell ()
forall a. a -> Cmd Tell a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }

-- | Take a note and the current time, then display it
showNote :: ClockTime -> Note -> Cmd Tell String
showNote :: ClockTime -> Note -> Cmd Tell String
showNote ClockTime
time Note
note = do
    String
sender <- Nick -> Cmd Tell String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (FreenodeNick -> Nick
getFreenodeNick (Note -> FreenodeNick
noteSender Note
note))
    let diff :: TimeDiff
diff    = ClockTime
time ClockTime -> ClockTime -> TimeDiff
`diffClockTimes` Note -> ClockTime
noteTime Note
note
        ago :: String
ago     = case TimeDiff -> String
timeDiffPretty TimeDiff
diff of
                    [] -> String
"less than a minute"
                    String
pr -> String
pr
        action :: String
action  = case Note -> NoteType
noteType Note
note of NoteType
Tell -> String
"said"; NoteType
Ask -> String
"asked"
    String -> Cmd Tell String
forall a. a -> Cmd Tell a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd Tell String) -> String -> Cmd Tell String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s %s %s ago: %s" String
sender String
action String
ago (Note -> String
noteContents Note
note)

-- | Is it less than a day since we last reminded this nick they've got messages?
needToRemind :: Nick -> Cmd Tell Bool
needToRemind :: Nick -> Cmd Tell Bool
needToRemind Nick
n = do
  Map FreenodeNick NoticeEntry
st  <- Cmd Tell (Map FreenodeNick NoticeEntry)
Cmd Tell (LBState (Cmd Tell))
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
  ClockTime
now <- IO ClockTime -> Cmd Tell ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
  Bool -> Cmd Tell Bool
forall a. a -> Cmd Tell a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cmd Tell Bool) -> Bool -> Cmd Tell Bool
forall a b. (a -> b) -> a -> b
$ case FreenodeNick -> Map FreenodeNick NoticeEntry -> Maybe NoticeEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> FreenodeNick
FreenodeNick Nick
n) Map FreenodeNick NoticeEntry
st of
             Just (Just ClockTime
lastTime, [Note]
_, Maybe String
_) ->
               let diff :: TimeDiff
diff = ClockTime
now ClockTime -> ClockTime -> TimeDiff
`diffClockTimes` ClockTime
lastTime
               in TimeDiff
diff TimeDiff -> TimeDiff -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime -> TimeDiff
TimeDiff NominalDiffTime
86400
             Just (Maybe ClockTime
Nothing,       [Note]
_, Maybe String
_) -> Bool
True
             Maybe NoticeEntry
Nothing                    -> Bool
True

-- | Add a note to the NoticeBoard
writeDown :: Nick -> Nick -> String -> NoteType -> Cmd Tell ()
writeDown :: Nick -> Nick -> String -> NoteType -> Cmd Tell ()
writeDown Nick
to Nick
from String
what NoteType
ntype = do
  ClockTime
time <- IO ClockTime -> Cmd Tell ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
  let note :: Note
note = Note { noteSender :: FreenodeNick
noteSender   = Nick -> FreenodeNick
FreenodeNick Nick
from,
                    noteContents :: String
noteContents = String
what,
                    noteTime :: ClockTime
noteTime     = ClockTime
time,
                    noteType :: NoteType
noteType     = NoteType
ntype }
  Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
to ((NoticeEntry -> NoticeEntry) -> Cmd Tell ())
-> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
_, [Note]
ns, Maybe String
a) -> (Maybe ClockTime
forall a. Maybe a
Nothing, [Note]
ns [Note] -> [Note] -> [Note]
forall a. [a] -> [a] -> [a]
++ [Note
note], Maybe String
a)

-- | Return a user's notes, or Nothing if they don't have any
getMessages :: Nick -> Cmd Tell (Maybe [Note])
getMessages :: Nick -> Cmd Tell (Maybe [Note])
getMessages Nick
sender = do
  Map FreenodeNick NoticeEntry
st  <- Cmd Tell (Map FreenodeNick NoticeEntry)
Cmd Tell (LBState (Cmd Tell))
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
  Maybe [Note] -> Cmd Tell (Maybe [Note])
forall a. a -> Cmd Tell a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Note] -> Cmd Tell (Maybe [Note]))
-> Maybe [Note] -> Cmd Tell (Maybe [Note])
forall a b. (a -> b) -> a -> b
$ case FreenodeNick -> Map FreenodeNick NoticeEntry -> Maybe NoticeEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> FreenodeNick
FreenodeNick Nick
sender) Map FreenodeNick NoticeEntry
st of
             Maybe NoticeEntry
Nothing ->         Maybe [Note]
forall a. Maybe a
Nothing
             Just (Maybe ClockTime
_, [], Maybe String
_) -> Maybe [Note]
forall a. Maybe a
Nothing
             Just (Maybe ClockTime
_, [Note]
ns, Maybe String
_) -> [Note] -> Maybe [Note]
forall a. a -> Maybe a
Just [Note]
ns

-- | Set a user's messages.
setMessages :: Nick -> [Note] -> Cmd Tell ()
setMessages :: Nick -> [Note] -> Cmd Tell ()
setMessages Nick
sender [Note]
msgs = Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
sender ((NoticeEntry -> NoticeEntry) -> Cmd Tell ())
-> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
t, [Note]
_, Maybe String
a) -> (Maybe ClockTime
t, [Note]
msgs, Maybe String
a)

-- | Clear a user's messages.
clearMessages :: Nick -> Cmd Tell ()
clearMessages :: Nick -> Cmd Tell ()
clearMessages Nick
sender = Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
sender ((NoticeEntry -> NoticeEntry) -> Cmd Tell ())
-> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
_, [Note]
_, Maybe String
a) -> (Maybe ClockTime
forall a. Maybe a
Nothing, [], Maybe String
a)

-- | Sets a user's auto-reply message
setAutoReply :: Nick -> String -> Cmd Tell ()
setAutoReply :: Nick -> String -> Cmd Tell ()
setAutoReply Nick
sender String
msg = Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
sender ((NoticeEntry -> NoticeEntry) -> Cmd Tell ())
-> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
t, [Note]
ns, Maybe String
_) -> (Maybe ClockTime
t, [Note]
ns, String -> Maybe String
forall a. a -> Maybe a
Just String
msg)

-- | Gets a user's auto-reply message
getAutoReply :: Nick -> Cmd Tell (Maybe String)
getAutoReply :: Nick -> Cmd Tell (Maybe String)
getAutoReply Nick
sender = (Map FreenodeNick NoticeEntry -> Maybe String)
-> Cmd Tell (Map FreenodeNick NoticeEntry)
-> Cmd Tell (Maybe String)
forall a b. (a -> b) -> Cmd Tell a -> Cmd Tell b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (Maybe String) -> Maybe String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe String) -> Maybe String)
-> (Map FreenodeNick NoticeEntry -> Maybe (Maybe String))
-> Map FreenodeNick NoticeEntry
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NoticeEntry -> Maybe String)
-> Maybe NoticeEntry -> Maybe (Maybe String)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe ClockTime
_,[Note]
_,Maybe String
a) -> Maybe String
a) (Maybe NoticeEntry -> Maybe (Maybe String))
-> (Map FreenodeNick NoticeEntry -> Maybe NoticeEntry)
-> Map FreenodeNick NoticeEntry
-> Maybe (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreenodeNick -> Map FreenodeNick NoticeEntry -> Maybe NoticeEntry
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> FreenodeNick
FreenodeNick Nick
sender)) Cmd Tell (Map FreenodeNick NoticeEntry)
Cmd Tell (LBState (Cmd Tell))
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS

-- | Clears the auto-reply message
clearAutoReply :: Nick -> Cmd Tell ()
clearAutoReply :: Nick -> Cmd Tell ()
clearAutoReply Nick
sender = Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
sender ((NoticeEntry -> NoticeEntry) -> Cmd Tell ())
-> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
t, [Note]
ns, Maybe String
_) -> (Maybe ClockTime
t, [Note]
ns, Maybe String
forall a. Maybe a
Nothing)

-- | Modifies an entry, taking care of missing entries and cleaning up empty entries.
-- (We consider an entry empty even if it still has a timestamp.)
modEntry :: Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry :: Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
sender NoticeEntry -> NoticeEntry
f = (LBState (Cmd Tell) -> LBState (Cmd Tell)) -> Cmd Tell ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS ((LBState (Cmd Tell) -> LBState (Cmd Tell)) -> Cmd Tell ())
-> (LBState (Cmd Tell) -> LBState (Cmd Tell)) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ (Maybe NoticeEntry -> Maybe NoticeEntry)
-> FreenodeNick
-> Map FreenodeNick NoticeEntry
-> Map FreenodeNick NoticeEntry
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter (NoticeEntry -> Maybe NoticeEntry
forall {a} {a} {a}. (a, [a], Maybe a) -> Maybe (a, [a], Maybe a)
cleanup (NoticeEntry -> Maybe NoticeEntry)
-> (Maybe NoticeEntry -> NoticeEntry)
-> Maybe NoticeEntry
-> Maybe NoticeEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoticeEntry -> NoticeEntry
f (NoticeEntry -> NoticeEntry)
-> (Maybe NoticeEntry -> NoticeEntry)
-> Maybe NoticeEntry
-> NoticeEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoticeEntry -> Maybe NoticeEntry -> NoticeEntry
forall a. a -> Maybe a -> a
fromMaybe NoticeEntry
forall {a} {a} {a}. (Maybe a, [a], Maybe a)
empty) (Nick -> FreenodeNick
FreenodeNick Nick
sender)
  where empty :: (Maybe a, [a], Maybe a)
empty = (Maybe a
forall a. Maybe a
Nothing, [], Maybe a
forall a. Maybe a
Nothing)
        cleanup :: (a, [a], Maybe a) -> Maybe (a, [a], Maybe a)
cleanup (a
_, [], Maybe a
Nothing) = Maybe (a, [a], Maybe a)
forall a. Maybe a
Nothing
        cleanup (a, [a], Maybe a)
e = (a, [a], Maybe a) -> Maybe (a, [a], Maybe a)
forall a. a -> Maybe a
Just (a, [a], Maybe a)
e

-- * Handlers
--

-- | Give a user their messages
doMessages :: Bool -> Cmd Tell ()
doMessages :: Bool -> Cmd Tell ()
doMessages Bool
loud = do
    Nick
sender <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    Maybe [Note]
msgs <- Nick -> Cmd Tell (Maybe [Note])
getMessages Nick
sender

    let tellNote :: String -> Cmd Tell ()
tellNote = if Bool
loud
            then String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
            else LB () -> Cmd Tell ()
forall a. LB a -> Cmd Tell a
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd Tell ())
-> (String -> LB ()) -> String -> Cmd Tell ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> String -> LB ()
ircPrivmsg Nick
sender

    let loop :: [Note] -> Cmd Tell ()
loop [] = Nick -> Cmd Tell ()
clearMessages Nick
sender
        loop (Note
msg : [Note]
msgs) = do
            ClockTime
time <- IO ClockTime -> Cmd Tell ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
            -- Note that 'showNote' may block and thus run into a timeout.
            -- Hence we update the list of pending messages after each message.
            ClockTime -> Note -> Cmd Tell String
showNote ClockTime
time Note
msg Cmd Tell String -> (String -> Cmd Tell ()) -> Cmd Tell ()
forall a b. Cmd Tell a -> (a -> Cmd Tell b) -> Cmd Tell b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Cmd Tell ()
tellNote
            Nick -> [Note] -> Cmd Tell ()
setMessages Nick
sender [Note]
msgs
            [Note] -> Cmd Tell ()
loop [Note]
msgs

    case Maybe [Note]
msgs of
        Maybe [Note]
Nothing -> String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"You don't have any messages"
        Just [Note]
msgs -> [Note] -> Cmd Tell ()
loop [Note]
msgs

verb :: NoteType -> String
verb :: NoteType -> String
verb NoteType
Ask = String
"ask"
verb NoteType
Tell= String
"tell"

-- | Execute a @tell or @ask command.
doTell :: NoteType -> [String] -> Cmd Tell ()
doTell :: NoteType -> [String] -> Cmd Tell ()
doTell NoteType
ntype []         = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"Who should I " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoteType -> String
verb NoteType
ntype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?")
doTell NoteType
ntype (String
who':[String]
args) = do
    let who :: String
who     = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropFromEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
who'
    Nick
recipient   <- String -> Cmd Tell Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
who
    Nick
sender      <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    Nick
me          <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
    let rest :: String
rest = [String] -> String
unwords [String]
args
        (Bool
record, String
res)
            | Nick
sender    Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
recipient   = (Bool
False, String
"You can " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoteType -> String
verb NoteType
ntype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" yourself!")
            | Nick
recipient Nick -> Nick -> Bool
forall a. Eq a => a -> a -> Bool
== Nick
me          = (Bool
False, String
"Nice try ;)")
            | [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args                = (Bool
False, String
"What should I " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NoteType -> String
verb NoteType
ntype String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
who String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?")
            | Bool
otherwise                = (Bool
True,  String
"Consider it noted.")
    Bool -> Cmd Tell () -> Cmd Tell ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
record (Cmd Tell () -> Cmd Tell ()) -> Cmd Tell () -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ do
        Maybe String
autoReply <- Nick -> Cmd Tell (Maybe String)
getAutoReply Nick
recipient
        case Maybe String
autoReply of
            Maybe String
Nothing -> () -> Cmd Tell ()
forall a. a -> Cmd Tell a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just String
s -> String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd Tell ()) -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ String
who String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" lets you know: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
        Nick -> Nick -> String -> NoteType -> Cmd Tell ()
writeDown Nick
recipient Nick
sender String
rest NoteType
ntype
    String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
res

-- | Execute a @auto-reply
doAutoReply :: String -> Cmd Tell ()
doAutoReply :: String -> Cmd Tell ()
doAutoReply String
"" = String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"No auto-reply message given. Did you mean @clear-auto-reply?"
doAutoReply String
msg = do
    Nick
sender      <- Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
    Nick -> String -> Cmd Tell ()
setAutoReply Nick
sender String
msg
    String -> Cmd Tell ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Auto-Reply messages noted. You can check the status with auto-reply? and clear it with clear-auto-reply."

-- | Remind a user that they have messages.
doRemind :: Nick -> (String -> Cmd Tell ()) -> Cmd Tell ()
doRemind :: Nick -> (String -> Cmd Tell ()) -> Cmd Tell ()
doRemind Nick
sender String -> Cmd Tell ()
remind = do
    Maybe [Note]
ms  <- Nick -> Cmd Tell (Maybe [Note])
getMessages Nick
sender
    ClockTime
now <- IO ClockTime -> Cmd Tell ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
    Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry Nick
sender ((NoticeEntry -> NoticeEntry) -> Cmd Tell ())
-> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
_,[Note]
ns,Maybe String
a) -> (ClockTime -> Maybe ClockTime
forall a. a -> Maybe a
Just ClockTime
now, [Note]
ns, Maybe String
a)
    case Maybe [Note]
ms of
        Just [Note]
msgs -> do
            String
me <- Nick -> Cmd Tell String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (Nick -> Cmd Tell String) -> Cmd Tell Nick -> Cmd Tell String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd Tell Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
            let n :: Int
n = [Note] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Note]
msgs
                (String
messages, String
pronoun)
                    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1     = (String
"messages", String
"them")
                    | Bool
otherwise = (String
"message", String
"it")
            String -> Cmd Tell ()
remind (String -> Cmd Tell ()) -> String -> Cmd Tell ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"You have %d new %s. '/msg %s @messages' to read %s."
                        Int
n String
messages String
me String
pronoun
        Maybe [Note]
Nothing -> () -> Cmd Tell ()
forall a. a -> Cmd Tell a
forall (m :: * -> *) a. Monad m => a -> m a
return ()