forked from lambdabot/lambdabot
/
Dashboard.hs
228 lines (206 loc) · 12.1 KB
/
Dashboard.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
{-# LANGUAGE FlexibleInstances #-}
module Lambdabot.Plugin.Dashboard.Dashboard where
import Lambdabot.Config.Dashboard (dashboardPort, garbageCollectionIntervalInSeconds)
import Lambdabot.Plugin.Dashboard.Configuration (
Badge (MkBadge),
Channel (..),
ChannelName,
Dashboard,
DashboardState (..),
Message (..),
Spoken (..),
Watcher (..),
WatcherName,
Watching (..),
channelNameFromSpoken,
listOfMessageUniqueIdentifierFromSpoken,
nameFromChannel,
uniqueIdentifierFromWatcher,
uniqueIdentifierFromWatching,
watchingFromChannel,
)
import Lambdabot.Plugin.Dashboard.Garbage (startCollectingGarbage)
import Lambdabot.Plugin.Dashboard.Service (startListening)
import Lambdabot.IRC (IrcMessage, IrcTag, ircMsgParams, ircTags)
import Lambdabot.Logging (noticeM)
import qualified Lambdabot.Message as Msg
import Lambdabot.Monad (registerCallback)
import Lambdabot.Plugin (Module, MonadLBState (withMS), Nick (..), getConfig, moduleDefState, moduleExit, moduleInit, moduleSerialize, newModule, stdSerial)
import Lambdabot.Plugin.Dashboard.StateChange (StateChange (..), fromStateChange, whenModified)
import Data.List (partition)
import Data.Maybe (fromJust)
data MessageType = Join | Part | Quit | Rename | Speak | Room | User | Audience deriving (Eq)
dashboardPlugin :: Module DashboardState
dashboardPlugin =
newModule
{ moduleSerialize = Just stdSerial
, moduleDefState = do
pure $ MkDashboardState{focusedChannel = "", shutdown = False, watchers = [], watching = [], messages = [], speaking = []}
, moduleInit = do
withMS $ \dashboardState writer -> writer dashboardState{shutdown = False}
sequence_
[ registerCallback signal (withDashboardFM cb)
| (signal, cb) <-
[ ("JOIN", updateState Join)
, ("PART", updateState Part)
, ("QUIT", updateState Quit)
, ("NICK", updateState Rename)
, ("353", updateState Audience)
, ("PRIVMSG", updateState Speak)
, ("USERSTATE", updateState User)
, ("ROOMSTATE", updateState Room)
]
]
getConfig dashboardPort >>= startListening
getConfig garbageCollectionIntervalInSeconds >>= startCollectingGarbage
, moduleExit = withMS $ \dashboardState writer -> writer dashboardState{shutdown = True}
}
withDashboardFM :: Msg.Message a => (a -> Nick -> Nick -> StateChange DashboardState -> StateChange DashboardState) -> (a -> Dashboard ())
withDashboardFM handler msg = do
let channel = head . Msg.channels $! msg
nickname = Msg.nick msg
noticeM $ "Received :: " ++ nTag channel ++ " <> " ++ nName channel ++ " <> " ++ nTag nickname ++ " <> " ++ nName nickname
withMS $ \dashboardState writer -> whenModified (pure ()) writer $ handler msg channel nickname (Original dashboardState)
updateState :: MessageType -> IrcMessage -> Nick -> Nick -> StateChange DashboardState -> StateChange DashboardState
updateState User _ chnl _ stateChange =
let dashboardState = fromStateChange stateChange
channelName = nName chnl
otherChannel = filter ((channelName /=) . nameFromChannel) $ watching dashboardState
in Modified dashboardState{watching = MkChannel (channelName, []) : otherChannel}
updateState Audience msg chnl sndr stateChange =
let sansBotName = tail $ tail $ ircMsgParams msg
channelName = head sansBotName
listOfWatcher = words $ tail $ head $ tail sansBotName
in foldl (audienceJoin msg chnl{nName = channelName} sndr) stateChange listOfWatcher
updateState messageType msg chnl sndr stateChange =
let uniqueWatcherIdentifier = nName sndr
channelName = nName chnl
watcherName = nName sndr
wtchr = MkWatcher (uniqueWatcherIdentifier, watcherName, Nothing)
newWatching = MkWatching (uniqueWatcherIdentifier, [])
in updateState' messageType msg channelName wtchr newWatching stateChange
audienceJoin :: IrcMessage -> Nick -> Nick -> StateChange DashboardState -> WatcherName -> StateChange DashboardState
audienceJoin msg chnl sndr stateChange watcher = updateState Join msg chnl (Nick{nName = watcher, nTag = nTag sndr}) stateChange
updateState' :: MessageType -> IrcMessage -> ChannelName -> Watcher -> Watching -> StateChange DashboardState -> StateChange DashboardState
updateState' Speak msg channelName watcher newWatching@(MkWatching (uniqueWatcherIdentifier, _)) stateChange =
if null $ ircTags msg
then stateChange
else
let idTags = tagNamed "id" $ ircTags msg
updatedWatcher = maybeUpdateWatcherName watcher $ tagNamed "display-name" $ ircTags msg
updatedWatching = maybeAddTagToWatchingBadges newWatching $ tagNamed "mod" $ ircTags msg
in if null idTags
then stateChange
else
let uniqueMessageIdentifier = snd $ head idTags
maybeMessage = Just $ MkMessage (uniqueMessageIdentifier, uniqueWatcherIdentifier, getTextOfMessage msg, [])
in updateState'' Speak channelName updatedWatcher updatedWatching maybeMessage stateChange
updateState' messageType _ channelName watcher newWatching stateChange = updateState'' messageType channelName watcher newWatching Nothing stateChange
maybeAddTagToWatchingBadges :: Watching -> [IrcTag] -> Watching
maybeAddTagToWatchingBadges existingWatching@(MkWatching (uniqueWatcherIdentifier, badges)) modTag =
if not $ null modTag
then
let (tagName, tagValue) = head modTag
in MkWatching (uniqueWatcherIdentifier, MkBadge (tagName, read tagValue) : badges)
else existingWatching
-- Skip first param (channel name)
-- Trim colon prefix
getTextOfMessage :: IrcMessage -> String
getTextOfMessage = tail . unwords . drop 1 . ircMsgParams
maybeUpdateWatcherName :: Watcher -> [IrcTag] -> Watcher
maybeUpdateWatcherName watcher@(MkWatcher (uniqueWatcherIdentifier, _, watcherSystemIdentifier)) displayNameTag =
if not $ null displayNameTag
then MkWatcher (uniqueWatcherIdentifier, snd $ head displayNameTag, watcherSystemIdentifier)
else watcher
updateState'' :: MessageType -> ChannelName -> Watcher -> Watching -> Maybe Message -> StateChange DashboardState -> StateChange DashboardState
updateState'' messageType channelName watcher newWatching maybeMessage stateChange =
let dashboardState = fromStateChange stateChange
partitionedWatching = partition ((channelName ==) . nameFromChannel) $ watching dashboardState
partitionedWatchers = partition (`sameWatcher` watcher) (watchers dashboardState)
partitionedSpeaking = partition ((channelName ==) . channelNameFromSpoken) $ speaking dashboardState
addOrUpdateWatcher' = addOrUpdateWatcher partitionedWatchers watcher
addOrUpdateWatching' = addOrUpdateWatching partitionedWatching channelName newWatching
addMessage' = addMessage partitionedSpeaking channelName (fromJust maybeMessage)
removeWatching' = removeWatching partitionedWatching channelName newWatching
todo = case messageType of
Join -> Just [addOrUpdateWatcher', addOrUpdateWatching']
Speak -> Just [addMessage', addOrUpdateWatcher', addOrUpdateWatching']
Part -> Just [addOrUpdateWatcher', removeWatching']
_ -> Nothing
in updateState''' todo stateChange
updateState''' :: Maybe [StateChange DashboardState -> StateChange DashboardState] -> StateChange DashboardState -> StateChange DashboardState
updateState''' todo stateChange = case todo of
Just strategies -> foldl (\state strategy -> strategy state) stateChange strategies
Nothing -> stateChange
sameWatcher :: Watcher -> Watcher -> Bool
sameWatcher a b = uniqueIdentifierFromWatcher a == uniqueIdentifierFromWatcher b
sameWatching :: Watching -> Watching -> Bool
sameWatching a b = uniqueIdentifierFromWatching a == uniqueIdentifierFromWatching b
addMessage :: ([Spoken], [Spoken]) -> ChannelName -> Message -> StateChange DashboardState -> StateChange DashboardState
addMessage (channelSpoken, otherSpoken) channelName theMessage@(MkMessage (uniqueMessageIdentifier, _, _, _)) (Original dashboardState) =
let umids = if null channelSpoken then [] else listOfMessageUniqueIdentifierFromSpoken $ head channelSpoken
in Modified
dashboardState
{ messages = theMessage : messages dashboardState
, speaking = MkSpoken (channelName, uniqueMessageIdentifier : umids) : otherSpoken
}
addMessage (channelSpoken, otherSpoken) channelName theMessage@(MkMessage (uniqueMessageIdentifier, _, _, _)) (Modified dashboardState) =
let umids = if null channelSpoken then [] else listOfMessageUniqueIdentifierFromSpoken $ head channelSpoken
in Modified
dashboardState
{ messages = theMessage : messages dashboardState
, speaking = MkSpoken (channelName, uniqueMessageIdentifier : umids) : otherSpoken
}
addOrUpdateWatcher :: ([Watcher], [Watcher]) -> Watcher -> StateChange DashboardState -> StateChange DashboardState
addOrUpdateWatcher (thisWatcher, otherWatcher) newWatcher (Original dashboardState) =
if null thisWatcher
then Modified dashboardState{watchers = newWatcher : otherWatcher}
else
let existingWatcher = head thisWatcher
in if existingWatcher == newWatcher
then Original dashboardState
else Modified dashboardState{watchers = newWatcher : otherWatcher}
addOrUpdateWatcher (thisWatcher, otherWatcher) newWatcher (Modified dashboardState) =
if null thisWatcher
then Modified dashboardState{watchers = newWatcher : otherWatcher}
else
let existingWatcher = head thisWatcher
in if existingWatcher == newWatcher
then Modified dashboardState
else Modified dashboardState{watchers = newWatcher : otherWatcher}
addOrUpdateWatching :: ([Channel], [Channel]) -> ChannelName -> Watching -> StateChange DashboardState -> StateChange DashboardState
addOrUpdateWatching (thisChannel, otherChannel) channelName newWatching (Original dashboardState) =
if null thisChannel
then Modified dashboardState{watching = MkChannel (channelName, [newWatching]) : otherChannel}
else
let (thisWatching, otherWatching) = partition (`sameWatching` newWatching) $ watchingFromChannel $ head thisChannel
in if null thisWatching || head thisWatching /= newWatching
then Modified dashboardState{watching = MkChannel (channelName, newWatching : otherWatching) : otherChannel}
else Original dashboardState
addOrUpdateWatching (thisChannel, otherChannel) channelName newWatching (Modified dashboardState) =
if null thisChannel
then Modified dashboardState{watching = MkChannel (channelName, [newWatching]) : otherChannel}
else
let (thisWatching, otherWatching) = partition (`sameWatching` newWatching) $ watchingFromChannel $ head thisChannel
in if null thisWatching || head thisWatching /= newWatching
then Modified dashboardState{watching = MkChannel (channelName, newWatching : otherWatching) : otherChannel}
else Modified dashboardState
removeWatching :: ([Channel], [Channel]) -> ChannelName -> Watching -> StateChange DashboardState -> StateChange DashboardState
removeWatching (thisChannel, otherChannel) channelName (MkWatching (uniqueWatcherIdentifier, _)) (Original dashboardState) =
if not $ null thisChannel
then
let (thisWatching, otherWatching) = partition ((==) uniqueWatcherIdentifier . uniqueIdentifierFromWatching) $ watchingFromChannel $ head thisChannel
in if not $ null thisWatching
then Modified dashboardState{watching = MkChannel (channelName, otherWatching) : otherChannel}
else Original dashboardState
else Original dashboardState
removeWatching (thisChannel, otherChannel) channelName (MkWatching (uniqueWatcherIdentifier, _)) (Modified dashboardState) =
if not $ null thisChannel
then
let (thisWatching, otherWatching) = partition ((==) uniqueWatcherIdentifier . uniqueIdentifierFromWatching) $ watchingFromChannel $ head thisChannel
in if not $ null thisWatching
then Modified dashboardState{watching = MkChannel (channelName, otherWatching) : otherChannel}
else Modified dashboardState
else Modified dashboardState
tagNamed :: Eq a => a -> [(a, b)] -> [(a, b)]
tagNamed named = filter ((==) named . fst)