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)
data NoteType = Tell | Ask deriving (Int -> NoteType -> ShowS
[NoteType] -> ShowS
NoteType -> String
(Int -> NoteType -> ShowS)
-> (NoteType -> String) -> ([NoteType] -> ShowS) -> Show NoteType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoteType] -> ShowS
$cshowList :: [NoteType] -> ShowS
show :: NoteType -> String
$cshow :: NoteType -> String
showsPrec :: Int -> NoteType -> ShowS
$cshowsPrec :: Int -> NoteType -> ShowS
Show, NoteType -> NoteType -> Bool
(NoteType -> NoteType -> Bool)
-> (NoteType -> NoteType -> Bool) -> Eq NoteType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoteType -> NoteType -> Bool
$c/= :: NoteType -> NoteType -> Bool
== :: NoteType -> NoteType -> Bool
$c== :: 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
readListPrec :: ReadPrec [NoteType]
$creadListPrec :: ReadPrec [NoteType]
readPrec :: ReadPrec NoteType
$creadPrec :: ReadPrec NoteType
readList :: ReadS [NoteType]
$creadList :: ReadS [NoteType]
readsPrec :: Int -> ReadS NoteType
$creadsPrec :: Int -> ReadS NoteType
Read)
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
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
(Int -> Note -> ShowS)
-> (Note -> String) -> ([Note] -> ShowS) -> Show Note
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
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
readListPrec :: ReadPrec [Note]
$creadListPrec :: ReadPrec [Note]
readPrec :: ReadPrec Note
$creadPrec :: ReadPrec Note
readList :: ReadS [Note]
$creadList :: ReadS [Note]
readsPrec :: Int -> ReadS Note
$creadsPrec :: Int -> ReadS Note
Read)
type NoticeEntry = (Maybe ClockTime, [Note], Maybe String)
type NoticeBoard = M.Map FreenodeNick NoticeEntry
type Tell = ModuleT NoticeBoard LB
tellPlugin :: Module NoticeBoard
tellPlugin :: Module NoticeBoard
tellPlugin = Module NoticeBoard
forall st. Module st
newModule
{ moduleCmds :: ModuleT NoticeBoard LB [Command (ModuleT NoticeBoard LB)]
moduleCmds = [Command (ModuleT NoticeBoard LB)]
-> ModuleT NoticeBoard LB [Command (ModuleT NoticeBoard LB)]
forall (m :: * -> *) a. Monad m => a -> m a
return
[ (String -> Command Identity
command String
"tell")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"tell <nick> <message>. When <nick> shows activity, tell them <message>."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = NoteType -> [String] -> Cmd (ModuleT NoticeBoard LB) ()
doTell NoteType
Tell ([String] -> Cmd (ModuleT NoticeBoard LB) ())
-> (String -> [String])
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
}
, (String -> Command Identity
command String
"ask")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"ask <nick> <message>. When <nick> shows activity, ask them <message>."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = NoteType -> [String] -> Cmd (ModuleT NoticeBoard LB) ()
doTell NoteType
Ask ([String] -> Cmd (ModuleT NoticeBoard LB) ())
-> (String -> [String])
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
}
, (String -> Command Identity
command String
"messages")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"messages. Check your messages, responding in private."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Bool -> Cmd (ModuleT NoticeBoard LB) ()
doMessages Bool
False)
}
, (String -> Command Identity
command String
"messages-loud")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"messages. Check your messages, responding in public."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Bool -> Cmd (ModuleT NoticeBoard LB) ()
doMessages Bool
True)
}
, (String -> Command Identity
command String
"messages?")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"messages?. Tells you whether you have any messages"
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ do
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Maybe [Note]
ms <- Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note])
getMessages Nick
sender
case Maybe [Note]
ms of
Just [Note]
_ -> Nick
-> (String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
doRemind Nick
sender String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
Maybe [Note]
Nothing -> String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Sorry, no messages today."
}
, (String -> Command Identity
command String
"clear-messages")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"clear-messages. Clears your messages."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ do
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Nick -> Cmd (ModuleT NoticeBoard LB) ()
clearMessages Nick
sender
String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Messages cleared."
}
, (String -> Command Identity
command String
"auto-reply")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"auto-reply. Lets lambdabot auto-reply if someone sends you a message"
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = String -> Cmd (ModuleT NoticeBoard LB) ()
doAutoReply
}
, (String -> Command Identity
command String
"auto-reply?")
{ help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"auto-reply?. Tells you your auto-reply status"
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ do
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Maybe String
a <- Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe String)
getAutoReply Nick
sender
case Maybe String
a of
Just String
s -> String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT NoticeBoard LB) ())
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ String
"Your auto-reply is \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\"."
Maybe String
Nothing -> String -> Cmd (ModuleT NoticeBoard LB) ()
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 (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"clear-auto-reply. Clears your auto-reply message."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ do
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Nick -> Cmd (ModuleT NoticeBoard LB) ()
clearAutoReply Nick
sender
String -> Cmd (ModuleT NoticeBoard LB) ()
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 (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"print-notices. Print the current map of notes."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const ((String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT NoticeBoard LB) ())
-> (NoticeBoard -> String)
-> NoticeBoard
-> Cmd (ModuleT NoticeBoard LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoticeBoard -> String
forall a. Show a => a -> String
show) (NoticeBoard -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) NoticeBoard
-> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT NoticeBoard LB) NoticeBoard
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS)
}
, (String -> Command Identity
command String
"purge-notices")
{ privileged :: Bool
privileged = Bool
True
, help :: Cmd (ModuleT NoticeBoard LB) ()
help = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT NoticeBoard LB) ())
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$
String
"purge-notices [<nick> [<nick> [<nick> ...]]]]. "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Clear all notes for specified nicks, or all notices if you don't "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"specify a nick."
, process :: String -> Cmd (ModuleT NoticeBoard LB) ()
process = \String
args -> do
[Nick]
users <- (String -> Cmd (ModuleT NoticeBoard LB) Nick)
-> [String] -> Cmd (ModuleT NoticeBoard LB) [Nick]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick (String -> [String]
words String
args)
if [Nick] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Nick]
users
then LBState (Cmd (ModuleT NoticeBoard LB))
-> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). MonadLBState m => LBState m -> m ()
writeMS LBState (Cmd (ModuleT NoticeBoard LB))
forall k a. Map k a
M.empty
else (Nick -> Cmd (ModuleT NoticeBoard LB) ())
-> [Nick] -> Cmd (ModuleT NoticeBoard LB) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Nick -> Cmd (ModuleT NoticeBoard LB) ()
clearMessages [Nick]
users
String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"Messages purged."
}
]
, moduleDefState :: LB NoticeBoard
moduleDefState = NoticeBoard -> LB NoticeBoard
forall (m :: * -> *) a. Monad m => a -> m a
return NoticeBoard
forall k a. Map k a
M.empty
, moduleSerialize :: Maybe (Serial NoticeBoard)
moduleSerialize = Serial NoticeBoard -> Maybe (Serial NoticeBoard)
forall a. a -> Maybe a
Just Serial NoticeBoard
forall k v.
(Ord k, Show k, Show v, Read k, Read v) =>
Serial (Map k v)
mapSerial
, contextual :: String -> Cmd (ModuleT NoticeBoard LB) ()
contextual = Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. a -> b -> a
const (Cmd (ModuleT NoticeBoard LB) ()
-> String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
-> String
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ do
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Bool
remp <- Nick -> Cmd (ModuleT NoticeBoard LB) Bool
needToRemind Nick
sender
if Bool
remp
then Nick
-> (String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
doRemind Nick
sender (LB () -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT NoticeBoard LB) ())
-> (String -> LB ()) -> String -> Cmd (ModuleT NoticeBoard LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> String -> LB ()
ircPrivmsg Nick
sender)
else () -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
}
showNote :: ClockTime -> Note -> Cmd Tell String
showNote :: ClockTime -> Note -> Cmd (ModuleT NoticeBoard LB) String
showNote ClockTime
time Note
note = do
String
sender <- Nick -> Cmd (ModuleT NoticeBoard LB) 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 (ModuleT NoticeBoard LB) String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Cmd (ModuleT NoticeBoard LB) String)
-> String -> Cmd (ModuleT NoticeBoard LB) String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s %s %s ago: %s" String
sender String
action String
ago (Note -> String
noteContents Note
note)
needToRemind :: Nick -> Cmd Tell Bool
needToRemind :: Nick -> Cmd (ModuleT NoticeBoard LB) Bool
needToRemind Nick
n = do
NoticeBoard
st <- Cmd (ModuleT NoticeBoard LB) NoticeBoard
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
ClockTime
now <- IO ClockTime -> Cmd (ModuleT NoticeBoard LB) ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
Bool -> Cmd (ModuleT NoticeBoard LB) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Cmd (ModuleT NoticeBoard LB) Bool)
-> Bool -> Cmd (ModuleT NoticeBoard LB) Bool
forall a b. (a -> b) -> a -> b
$ case FreenodeNick
-> NoticeBoard -> Maybe (Maybe ClockTime, [Note], Maybe String)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> FreenodeNick
FreenodeNick Nick
n) NoticeBoard
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 (Maybe ClockTime, [Note], Maybe String)
Nothing -> Bool
True
writeDown :: Nick -> Nick -> String -> NoteType -> Cmd Tell ()
writeDown :: Nick
-> Nick -> String -> NoteType -> Cmd (ModuleT NoticeBoard LB) ()
writeDown Nick
to Nick
from String
what NoteType
ntype = do
ClockTime
time <- IO ClockTime -> Cmd (ModuleT NoticeBoard LB) ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
let note :: Note
note = Note :: FreenodeNick -> String -> ClockTime -> NoteType -> 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
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
to (((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ())
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
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)
getMessages :: Nick -> Cmd Tell (Maybe [Note])
getMessages :: Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note])
getMessages Nick
sender = do
NoticeBoard
st <- Cmd (ModuleT NoticeBoard LB) NoticeBoard
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
Maybe [Note] -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note])
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Note] -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note]))
-> Maybe [Note] -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note])
forall a b. (a -> b) -> a -> b
$ case FreenodeNick
-> NoticeBoard -> Maybe (Maybe ClockTime, [Note], Maybe String)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> FreenodeNick
FreenodeNick Nick
sender) NoticeBoard
st of
Maybe (Maybe ClockTime, [Note], Maybe String)
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
setMessages :: Nick -> [Note] -> Cmd Tell ()
setMessages :: Nick -> [Note] -> Cmd (ModuleT NoticeBoard LB) ()
setMessages Nick
sender [Note]
msgs = Nick
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
sender (((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ())
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
t, [Note]
_, Maybe String
a) -> (Maybe ClockTime
t, [Note]
msgs, Maybe String
a)
clearMessages :: Nick -> Cmd Tell ()
clearMessages :: Nick -> Cmd (ModuleT NoticeBoard LB) ()
clearMessages Nick
sender = Nick
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
sender (((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ())
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ \(Maybe ClockTime
_, [Note]
_, Maybe String
a) -> (Maybe ClockTime
forall a. Maybe a
Nothing, [], Maybe String
a)
setAutoReply :: Nick -> String -> Cmd Tell ()
setAutoReply :: Nick -> String -> Cmd (ModuleT NoticeBoard LB) ()
setAutoReply Nick
sender String
msg = Nick
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
sender (((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ())
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
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)
getAutoReply :: Nick -> Cmd Tell (Maybe String)
getAutoReply :: Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe String)
getAutoReply Nick
sender = (NoticeBoard -> Maybe String)
-> Cmd (ModuleT NoticeBoard LB) NoticeBoard
-> Cmd (ModuleT NoticeBoard LB) (Maybe String)
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)
-> (NoticeBoard -> Maybe (Maybe String))
-> NoticeBoard
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe ClockTime, [Note], Maybe String) -> Maybe String)
-> Maybe (Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe ClockTime
_,[Note]
_,Maybe String
a) -> Maybe String
a) (Maybe (Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe String))
-> (NoticeBoard -> Maybe (Maybe ClockTime, [Note], Maybe String))
-> NoticeBoard
-> Maybe (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreenodeNick
-> NoticeBoard -> Maybe (Maybe ClockTime, [Note], Maybe String)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Nick -> FreenodeNick
FreenodeNick Nick
sender)) Cmd (ModuleT NoticeBoard LB) NoticeBoard
forall (m :: * -> *). MonadLBState m => m (LBState m)
readMS
clearAutoReply :: Nick -> Cmd Tell ()
clearAutoReply :: Nick -> Cmd (ModuleT NoticeBoard LB) ()
clearAutoReply Nick
sender = Nick
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
sender (((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ())
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
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)
modEntry :: Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()
modEntry :: Nick
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
sender (Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String)
f = (LBState (Cmd (ModuleT NoticeBoard LB))
-> LBState (Cmd (ModuleT NoticeBoard LB)))
-> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *).
MonadLBState m =>
(LBState m -> LBState m) -> m ()
modifyMS ((LBState (Cmd (ModuleT NoticeBoard LB))
-> LBState (Cmd (ModuleT NoticeBoard LB)))
-> Cmd (ModuleT NoticeBoard LB) ())
-> (LBState (Cmd (ModuleT NoticeBoard LB))
-> LBState (Cmd (ModuleT NoticeBoard LB)))
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ (Maybe (Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe ClockTime, [Note], Maybe String))
-> FreenodeNick -> NoticeBoard -> NoticeBoard
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
M.alter ((Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe ClockTime, [Note], Maybe String)
forall a a a. (a, [a], Maybe a) -> Maybe (a, [a], Maybe a)
cleanup ((Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe ClockTime, [Note], Maybe String))
-> (Maybe (Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Maybe (Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe ClockTime, [Note], Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String)
f ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> (Maybe (Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Maybe (Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ClockTime, [Note], Maybe String)
-> Maybe (Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String)
forall a. a -> Maybe a -> a
fromMaybe (Maybe ClockTime, [Note], Maybe String)
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
doMessages :: Bool -> Cmd Tell ()
doMessages :: Bool -> Cmd (ModuleT NoticeBoard LB) ()
doMessages Bool
loud = do
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Maybe [Note]
msgs <- Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note])
getMessages Nick
sender
let tellNote :: String -> Cmd (ModuleT NoticeBoard LB) ()
tellNote = if Bool
loud
then String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say
else LB () -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a. MonadLB m => LB a -> m a
lb (LB () -> Cmd (ModuleT NoticeBoard LB) ())
-> (String -> LB ()) -> String -> Cmd (ModuleT NoticeBoard LB) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nick -> String -> LB ()
ircPrivmsg Nick
sender
let loop :: [Note] -> Cmd (ModuleT NoticeBoard LB) ()
loop [] = Nick -> Cmd (ModuleT NoticeBoard LB) ()
clearMessages Nick
sender
loop (Note
msg : [Note]
msgs) = do
ClockTime
time <- IO ClockTime -> Cmd (ModuleT NoticeBoard LB) ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
ClockTime -> Note -> Cmd (ModuleT NoticeBoard LB) String
showNote ClockTime
time Note
msg Cmd (ModuleT NoticeBoard LB) String
-> (String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Cmd (ModuleT NoticeBoard LB) ()
tellNote
Nick -> [Note] -> Cmd (ModuleT NoticeBoard LB) ()
setMessages Nick
sender [Note]
msgs
[Note] -> Cmd (ModuleT NoticeBoard LB) ()
loop [Note]
msgs
case Maybe [Note]
msgs of
Maybe [Note]
Nothing -> String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
"You don't have any messages"
Just [Note]
msgs -> [Note] -> Cmd (ModuleT NoticeBoard LB) ()
loop [Note]
msgs
verb :: NoteType -> String
verb :: NoteType -> String
verb NoteType
Ask = String
"ask"
verb NoteType
Tell= String
"tell"
doTell :: NoteType -> [String] -> Cmd Tell ()
doTell :: NoteType -> [String] -> Cmd (ModuleT NoticeBoard LB) ()
doTell NoteType
ntype [] = String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String
"Who should I " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NoteType -> String
verb NoteType
ntype String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?")
doTell NoteType
ntype (String
who':[String]
args) = do
let who :: String
who = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropFromEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
who'
Nick
recipient <- String -> Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => String -> Cmd m Nick
readNick String
who
Nick
sender <- Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Nick
me <- Cmd (ModuleT NoticeBoard LB) 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 -> ShowS
forall a. [a] -> [a] -> [a]
++ NoteType -> String
verb NoteType
ntype String -> ShowS
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 (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args = (Bool
False, String
"What should I " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NoteType -> String
verb NoteType
ntype String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
who String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?")
| Bool
otherwise = (Bool
True, String
"Consider it noted.")
Bool
-> Cmd (ModuleT NoticeBoard LB) ()
-> Cmd (ModuleT NoticeBoard LB) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
record (Cmd (ModuleT NoticeBoard LB) ()
-> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
-> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ do
Maybe String
autoReply <- Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe String)
getAutoReply Nick
recipient
case Maybe String
autoReply of
Maybe String
Nothing -> () -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
s -> String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say (String -> Cmd (ModuleT NoticeBoard LB) ())
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ String
who String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" lets you know: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
Nick
-> Nick -> String -> NoteType -> Cmd (ModuleT NoticeBoard LB) ()
writeDown Nick
recipient Nick
sender String
rest NoteType
ntype
String -> Cmd (ModuleT NoticeBoard LB) ()
forall (m :: * -> *). Monad m => String -> Cmd m ()
say String
res
doAutoReply :: String -> Cmd Tell ()
doAutoReply :: String -> Cmd (ModuleT NoticeBoard LB) ()
doAutoReply String
"" = String -> Cmd (ModuleT NoticeBoard LB) ()
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 (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getSender
Nick -> String -> Cmd (ModuleT NoticeBoard LB) ()
setAutoReply Nick
sender String
msg
String -> Cmd (ModuleT NoticeBoard LB) ()
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."
doRemind :: Nick -> (String -> Cmd Tell ()) -> Cmd Tell ()
doRemind :: Nick
-> (String -> Cmd (ModuleT NoticeBoard LB) ())
-> Cmd (ModuleT NoticeBoard LB) ()
doRemind Nick
sender String -> Cmd (ModuleT NoticeBoard LB) ()
remind = do
Maybe [Note]
ms <- Nick -> Cmd (ModuleT NoticeBoard LB) (Maybe [Note])
getMessages Nick
sender
ClockTime
now <- IO ClockTime -> Cmd (ModuleT NoticeBoard LB) ClockTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO ClockTime
getClockTime
Nick
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
modEntry Nick
sender (((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ())
-> ((Maybe ClockTime, [Note], Maybe String)
-> (Maybe ClockTime, [Note], Maybe String))
-> Cmd (ModuleT NoticeBoard LB) ()
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 (ModuleT NoticeBoard LB) String
forall (m :: * -> *). Monad m => Nick -> Cmd m String
showNick (Nick -> Cmd (ModuleT NoticeBoard LB) String)
-> Cmd (ModuleT NoticeBoard LB) Nick
-> Cmd (ModuleT NoticeBoard LB) String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd (ModuleT NoticeBoard LB) Nick
forall (m :: * -> *). Monad m => Cmd m Nick
getLambdabotName
let n :: Int
n = [Note] -> 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 (ModuleT NoticeBoard LB) ()
remind (String -> Cmd (ModuleT NoticeBoard LB) ())
-> String -> Cmd (ModuleT NoticeBoard LB) ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String -> String -> ShowS
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 (ModuleT NoticeBoard LB) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()