Skip to content

Commit

Permalink
Track information about channels we're not joined to
Browse files Browse the repository at this point in the history
/clear will flush this information when used while parted
  • Loading branch information
glguy committed Jul 31, 2024
1 parent a95a320 commit 6d3268e
Show file tree
Hide file tree
Showing 3 changed files with 44 additions and 21 deletions.
20 changes: 15 additions & 5 deletions src/Client/Commands/Window.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ import Client.State
import Client.State.EditBox qualified as Edit
import Client.State.Focus
import Client.State.Network (csChannels)
import Client.State.Channel (chanJoined)
import Client.State.Window (windowClear, wlText, winMessages, winHidden, winActivityFilter, winName, activityFilterStrings, readActivityFilter)
import Control.Applicative (liftA2)
import Control.Exception (SomeException, Exception(displayException), try)
Expand Down Expand Up @@ -326,11 +327,19 @@ cmdClear focusDefault st args =

clearFocus focus = commandSuccess (clearFocus1 focus st)

clearFocus1 focus st' = focusEffect (windowEffect st')
clearFocus1 focus st' = channelEffect (focusEffect (windowEffect st'))
where
channelEffect =
case focus of
ChannelFocus network channel | not isActive ->
over (clientConnection network . csChannels) (sans channel)
_ -> id

-- clear or delete the window buffer
windowEffect = over (clientWindows . at focus)
(if isActive then fmap windowClear else const Nothing)

-- stay on the current focus or find a new one
focusEffect
| noChangeNeeded = id
| prevExists = changeFocus prev
Expand All @@ -341,12 +350,13 @@ cmdClear focusDefault st args =

prev = view clientPrevFocus st

-- active windows are cleared instead of deleted
isActive =
case focus of
Unfocused -> False
NetworkFocus network -> has (clientConnection network) st'
ChannelFocus network channel -> has (clientConnection network
.csChannels . ix channel) st'
Unfocused -> False
NetworkFocus network -> has (clientConnection network) st'
ChannelFocus network channel ->
orOf (clientConnection network . csChannels . ix channel . chanJoined) st'

-- | Tab completion for @/splits[+]@. When given no arguments this
-- populates the current list of splits, otherwise it tab completes
Expand Down
16 changes: 10 additions & 6 deletions src/Client/State/Channel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,14 +17,15 @@ module Client.State.Channel
(
-- * Channel state
ChannelState(..)
, chanCreation
, chanJoined
, chanLists
, chanModes
, chanQueuedModeration
, chanTopic
, chanTopicProvenance
, chanUrl
, chanUsers
, chanModes
, chanLists
, chanCreation
, chanQueuedModeration

-- * Mask list entries
, MaskListEntry(..)
Expand Down Expand Up @@ -58,7 +59,9 @@ import Irc.UserInfo (UserInfo)

-- | Dynamic information about the state of an IRC channel
data ChannelState = ChannelState
{ _chanTopic :: !Text
{ _chanJoined :: !Bool
-- ^ client is currently connected to this channel
, _chanTopic :: !Text
-- ^ topic text
, _chanTopicProvenance :: !(Maybe TopicProvenance)
-- ^ author and timestamp for topic
Expand Down Expand Up @@ -94,7 +97,8 @@ makeLenses ''MaskListEntry
-- | Construct an empty 'ChannelState'
newChannel :: ChannelState
newChannel = ChannelState
{ _chanTopic = Text.empty
{ _chanJoined = False
, _chanTopic = Text.empty
, _chanUrl = Nothing
, _chanTopicProvenance = Nothing
, _chanUsers = HashMap.empty
Expand Down
29 changes: 19 additions & 10 deletions src/Client/State/Network.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ module Client.State.Network
, csAuthenticationState
, csSeed
, csAway
, csJoinedChannels
, clsElist
, clsDone
, clsItems
Expand Down Expand Up @@ -356,8 +357,14 @@ noReply = reply []
reply :: [RawIrcMsg] -> NetworkState -> Apply
reply = Apply

-- Fold over the channels we're currently joined
csJoinedChannels :: Fold NetworkState ChannelState
csJoinedChannels = csChannels . folded . filtered _chanJoined

-- | Apply an update function to a channel. If the channel doesn't
-- exist the update function is applied to a fresh channel
overChannel :: Identifier -> (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannel chan = overStrict (csChannels . ix chan)
overChannel chan f = overStrict (csChannels . at chan) (Just . f . fromMaybe newChannel)

overChannels :: (ChannelState -> ChannelState) -> NetworkState -> NetworkState
overChannels = overStrict (csChannels . traverse)
Expand Down Expand Up @@ -438,7 +445,7 @@ applyMessage' msgWhen msg cs =
where
exitChannel chan nick
| nick == view csNick cs = noReply $ pruneUsers
$ over csChannels (sans chan) cs
$ set (csChannels . ix chan . chanJoined) False cs

| otherwise = noReply $ forgetUser' nick
$ overChannel chan (partChannel nick) cs
Expand All @@ -448,7 +455,8 @@ applyMessage' msgWhen msg cs =
pruneUsers :: NetworkState -> NetworkState
pruneUsers cs = over csUsers (`HashMap.intersection` u) cs
where
u = foldOf (csChannels . folded . chanUsers) cs
-- only considers joined (actively updated) channels
u = foldOf (csJoinedChannels . chanUsers) cs

-- | 001 'RPL_WELCOME' is the first message received when transitioning
-- from the initial handshake to a connected state. At this point we know
Expand Down Expand Up @@ -698,12 +706,10 @@ saveList ::
NetworkState -> NetworkState
saveList mode tgt cs
= set csTransaction NoTransaction
$ setStrict
(csChannels . ix (mkId tgt) . chanLists . at mode)
(Just $! newList)
cs
$ overChannel (mkId tgt) upd cs
where
newList = HashMap.fromList (view (csTransaction . _BanTransaction) cs)
upd = set (chanLists . at mode) (Just $! newList)


-- | These replies are interpreted by the client and should only be shown
Expand Down Expand Up @@ -771,7 +777,7 @@ doMode _ _ _ _ _ cs = noReply cs -- ignore bad mode command
-- | Predicate to test if the connection has op in a given channel.
iHaveOp :: Identifier -> NetworkState -> Bool
iHaveOp channel cs =
elemOf (csChannels . ix channel . chanUsers . ix me . folded) '@' cs
elemOf (csChannels . ix channel . filtered _chanJoined . chanUsers . ix me . folded) '@' cs
where
me = view csNick cs

Expand Down Expand Up @@ -1037,8 +1043,10 @@ createOnJoin :: UserInfo -> Identifier -> NetworkState -> NetworkState
createOnJoin who chan cs
| userNick who == view csNick cs =
set csUserInfo who -- great time to learn our userinfo
$ set (csChannels . at chan) (Just newChannel) cs
$ set (csChannels . at chan) (Just newJoinedChannel) cs
| otherwise = cs
where
newJoinedChannel = newChannel { _chanJoined = True }

updateMyNick :: Identifier -> Identifier -> NetworkState -> NetworkState
updateMyNick oldNick newNick cs
Expand Down Expand Up @@ -1163,8 +1171,9 @@ massRegistration cs
where
infos = view (csTransaction . _WhoTransaction) cs

-- users in channels we're joined to
channelUsers =
HashSet.fromList (views (csChannels . folded . chanUsers) HashMap.keys cs)
HashSet.fromList (views (csJoinedChannels . chanUsers) HashMap.keys cs)

updateUsers users = foldl' updateUser users infos

Expand Down

0 comments on commit 6d3268e

Please sign in to comment.