module Network.IRC.Fun.Client.NickTracker
( ChannelTracker (..)
, NetworkTracker (..)
, isMemberOf
, isInChannel
, presence
, newChannel
, newNetwork
, addMember
, addToChannel
, changeNick
, addChannel
, removeMember
, removeFromChannel
, removeFromNetwork
, removeChannel
, removeChannels
)
where
import qualified Data.HashMap.Lazy as M
import qualified Data.HashSet as S
import Network.IRC.Fun.Messages.TypeAliases
newtype ChannelTracker = ChannelTracker (S.HashSet NickName)
newtype NetworkTracker = NetworkTracker (M.HashMap ChannelName ChannelTracker)
isMemberOf :: NickName -> ChannelTracker -> Bool
nick `isMemberOf` (ChannelTracker nicks) = nick `S.member` nicks
isInChannel :: NickName -> ChannelName -> NetworkTracker -> Bool
isInChannel nick chan (NetworkTracker cts) =
case M.lookup chan cts of
Nothing -> False
Just ct -> nick `isMemberOf` ct
applySnd :: (b -> c) -> (a, b) -> (a, c)
applySnd f (x, y) = (x, f y)
presence :: NickName -> NetworkTracker -> [ChannelName]
presence nick (NetworkTracker cts) =
[ chan | (chan, True) <- map (applySnd (nick `isMemberOf`)) $ M.toList cts]
newChannel :: [NickName] -> ChannelTracker
newChannel nicks = ChannelTracker $ S.fromList nicks
newNetwork :: NetworkTracker
newNetwork = NetworkTracker $ M.empty
addMember :: NickName -> ChannelTracker -> ChannelTracker
addMember nick (ChannelTracker nicks) = ChannelTracker $ S.insert nick nicks
addToChannel :: ChannelName -> NickName -> NetworkTracker -> NetworkTracker
addToChannel chan nick (NetworkTracker cts) = NetworkTracker $ f cts
where
f chans =
case M.lookup chan chans of
Nothing ->
let ct = ChannelTracker $ S.singleton nick
in M.insert chan ct chans
Just (ChannelTracker nicks) ->
let ct = ChannelTracker $ S.insert nick nicks
in M.insert chan ct chans
changeNick :: NickName -> NickName -> NetworkTracker -> NetworkTracker
changeNick old new (NetworkTracker cts) = NetworkTracker $ f cts
where
f chans =
let chansP = M.filter (old `isMemberOf`) chans
chansR = M.map (removeMember old) chansP
chansN = M.map (addMember new) chansR
in chansN `M.union` chans
addChannel :: ChannelName -> [NickName] -> NetworkTracker -> NetworkTracker
addChannel chan nicks (NetworkTracker cts) = NetworkTracker $ f cts
where
f = M.insert chan $ newChannel nicks
removeMember :: NickName -> ChannelTracker -> ChannelTracker
removeMember nick (ChannelTracker nicks) = ChannelTracker $ S.delete nick nicks
removeFromChannel :: ChannelName
-> NickName
-> NetworkTracker
-> NetworkTracker
removeFromChannel chan nick (NetworkTracker cts) = NetworkTracker $ f cts
where
f chans = M.adjust (removeMember nick) chan chans
removeFromNetwork :: NickName -> NetworkTracker -> NetworkTracker
removeFromNetwork nick (NetworkTracker cts) = NetworkTracker $ f cts
where
f = M.map (removeMember nick)
removeChannel :: ChannelName -> NetworkTracker -> NetworkTracker
removeChannel chan (NetworkTracker cts) = NetworkTracker $ f cts
where
f = M.delete chan
removeChannels :: [ChannelName] -> NetworkTracker -> NetworkTracker
removeChannels chans (NetworkTracker cts) = NetworkTracker $ f cts
where
f ts = ts `M.difference` M.fromList (zip chans (repeat ()))