diff --git a/src/Client/Commands/Window.hs b/src/Client/Commands/Window.hs index 22f5119f..959e4527 100644 --- a/src/Client/Commands/Window.hs +++ b/src/Client/Commands/Window.hs @@ -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) @@ -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 @@ -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 diff --git a/src/Client/State/Channel.hs b/src/Client/State/Channel.hs index 85781de6..8c2055d4 100644 --- a/src/Client/State/Channel.hs +++ b/src/Client/State/Channel.hs @@ -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(..) @@ -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 @@ -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 diff --git a/src/Client/State/Network.hs b/src/Client/State/Network.hs index 96001894..75bb7803 100644 --- a/src/Client/State/Network.hs +++ b/src/Client/State/Network.hs @@ -51,6 +51,7 @@ module Client.State.Network , csAuthenticationState , csSeed , csAway + , csJoinedChannels , clsElist , clsDone , clsItems @@ -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) @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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