module Matterhorn.State.ChannelList ( updateSidebar , updateWindowTitle , toggleChannelListVisibility , showChannelInSidebar ) where import Prelude () import Matterhorn.Prelude import Brick.Main ( getVtyHandle, invalidateCache, invalidateCacheEntry ) import qualified Data.HashMap.Strict as HM import qualified Data.Sequence as Seq import Data.Time.Clock ( getCurrentTime ) import Data.Maybe ( fromJust ) import qualified Graphics.Vty as Vty import Lens.Micro.Platform import Network.Mattermost.Types import Network.Mattermost.Lenses import qualified Network.Mattermost.Endpoints as MM import {-# SOURCE #-} Matterhorn.State.Messages ( fetchVisibleIfNeeded ) import Matterhorn.Types import Matterhorn.State.Async import qualified Matterhorn.Zipper as Z -- | Update the sidebar for the specified team state only, or all team -- states if not given a specific team ID. -- -- In either case, schedule user status fetches for all users mentioned -- in the current team's sidebar. (This should be safe because all -- sidebars should contain the same user list.) updateSidebar :: Maybe TeamId -> MH () updateSidebar mTid = do case mTid of Nothing -> do ts <- use csTeams forM_ (HM.keys ts) updateTeamSidebar Just tId -> do updateTeamSidebar tId -- Schedule the current team's sidebar for user status updates at -- the end of this MH action. This is okay because all team sidebars -- should include the same set of DM channels. withCurrentTeam $ \tId -> do z <- use (csTeam(tId).tsFocus) myId <- gets myUserId scheduleUserStatusFetches $ myId : userIdsFromZipper z updateWindowTitle updateWindowTitle :: MH () updateWindowTitle = do -- Update the window title based on the unread status of the -- channels in all teams. ts <- use csTeams unreadCounts <- forM (HM.keys ts) $ \tId -> do z <- use (csTeam(tId).tsFocus) return $ sum $ (channelListGroupUnread . fst) <$> Z.toList z let title = "matterhorn" <> if unread > 0 then "(" <> show unread <> ")" else "" unread = sum unreadCounts vty <- mh getVtyHandle liftIO $ Vty.setWindowTitle vty title updateTeamSidebar :: TeamId -> MH () updateTeamSidebar tId = do -- Invalidate the cached sidebar rendering since we are about to -- change the underlying state mh $ invalidateCacheEntry $ ChannelSidebar tId -- Get the currently-focused channel ID so we can compare after the -- zipper is rebuilt cconfig <- use csClientConfig oldCid <- use (csCurrentChannelId tId) -- Update the zipper cs <- use csChannels sorting <- use (csTeam(tId).tsChannelListSorting) us <- getUsers prefs <- use (csResources.crUserPreferences) hidden <- use csHiddenChannelGroups now <- liftIO getCurrentTime config <- use (csResources.crConfiguration) let zl = mkChannelZipperList sorting now config tId cconfig prefs hidden cs us compareEntries mOld new = (channelListEntryChannelId <$> mOld) == Just (channelListEntryChannelId new) csTeam(tId).tsFocus %= Z.updateListBy compareEntries zl -- If the zipper rebuild caused the current channel to change, such -- as when the previously-focused channel was removed, we need to -- call fetchVisibleIfNeeded on the newly-focused channel to ensure -- that it gets loaded. newCid <- use (csCurrentChannelId tId) when (newCid /= oldCid) $ fetchVisibleIfNeeded tId toggleChannelListVisibility :: MH () toggleChannelListVisibility = do mh invalidateCache csResources.crConfiguration.configShowChannelListL %= not showChannelInSidebar :: ChannelId -> Bool -> MH () showChannelInSidebar cId setPending = do mChan <- preuse $ csChannel cId me <- gets myUser prefs <- use (csResources.crUserPreferences) session <- getSession case mChan of Nothing -> -- The requested channel doesn't actually exist yet, so no -- action can be taken. It's likely that this is a -- pendingChannel situation and not all of the operations to -- locally define the channel have completed, in which case -- this code will be re-entered later and the mChan will be -- known. return () Just ch -> do -- Able to successfully switch to a known channel. This -- should clear any pending channel intention. If the -- intention was for this channel, then: done. If the -- intention was for a different channel, reaching this -- point means that the pending is still outstanding but -- that the user identified a new channel which *was* -- displayable, and the UI should always prefer to SATISFY -- the user's latest request over any pending/background -- task. now <- liftIO getCurrentTime csChannel(cId).ccInfo.cdSidebarShowOverride .= Just now updateSidebar (ch^.ccInfo.cdTeamId) case ch^.ccInfo.cdType of Direct -> do let uId = fromJust $ ch^.ccInfo.cdDMUserId case dmChannelShowPreference prefs uId of Just False -> do let pref = showDirectChannelPref (me^.userIdL) uId True when setPending $ withCurrentTeam $ \tId -> csTeam(tId).tsPendingChannelChange .= Just (ChangeByChannelId tId (ch^.ccInfo.cdChannelId) Nothing) doAsyncWith Preempt $ do MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session return Nothing _ -> return () Group -> case groupChannelShowPreference prefs cId of Just False -> do let pref = showGroupChannelPref cId (me^.userIdL) when setPending $ withCurrentTeam $ \tId -> csTeam(tId).tsPendingChannelChange .= Just (ChangeByChannelId tId (ch^.ccInfo.cdChannelId) Nothing) doAsyncWith Preempt $ do MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session return Nothing _ -> return () _ -> return ()