1module Matterhorn.State.Teams 2 ( nextTeam 3 , prevTeam 4 , handleJoinTeam 5 , handleLeaveTeam 6 , handleUpdateTeam 7 , buildTeamState 8 , moveCurrentTeamLeft 9 , moveCurrentTeamRight 10 , setTeam 11 ) 12where 13 14import Prelude () 15import Matterhorn.Prelude 16 17import Brick.Main ( invalidateCache, hScrollToBeginning, viewportScroll ) 18import qualified Data.Sequence as Seq 19import qualified Data.Text as T 20import Data.Time.Clock ( getCurrentTime ) 21import qualified Data.HashMap.Strict as HM 22import Lens.Micro.Platform ( (%=), (.=), at ) 23 24import Network.Mattermost.Lenses ( userIdL ) 25import Network.Mattermost.Types ( TeamId, Team, User, userId 26 , getId, channelId, teamId, UserParam(..) 27 , teamOrderPref 28 ) 29import qualified Network.Mattermost.Endpoints as MM 30 31import Matterhorn.Types 32import Matterhorn.LastRunState 33import Matterhorn.State.Async 34import Matterhorn.State.ChannelList 35import Matterhorn.State.Channels 36import Matterhorn.State.Messages 37import Matterhorn.State.Setup.Threads ( maybeStartSpellChecker ) 38import qualified Matterhorn.Zipper as Z 39 40 41-- | Move right in the channel list to select the next team. 42nextTeam :: MH () 43nextTeam = setTeamFocusWith Z.right 44 45-- | Move left in the channel list to select the previous team. 46prevTeam :: MH () 47prevTeam = setTeamFocusWith Z.left 48 49-- | Set the current team directly 50setTeam :: TeamId -> MH () 51setTeam tId = setTeamFocusWith $ Z.findRight (== tId) 52 53-- | Change the selected team with the specified team zipper 54-- transformation. This function also takes care of book-keeping 55-- necessary during team switching. 56setTeamFocusWith :: (Z.Zipper () TeamId -> Z.Zipper () TeamId) -> MH () 57setTeamFocusWith f = do 58 -- Before we leave this team to view another one, indicate that 59 -- we've viewed the current team's currently-selected channel so 60 -- that this team doesn't get left with an unread indicator once we 61 -- are looking at the other team. We do this when switching channels 62 -- within a team in the same way. 63 updateViewed True 64 65 csTeamZipper %= f 66 postChangeTeamCommon 67 68-- | Book-keeping common to all team selection changes. 69postChangeTeamCommon :: MH () 70postChangeTeamCommon = do 71 updateViewed False 72 fetchVisibleIfNeeded 73 mh $ hScrollToBeginning (viewportScroll TeamList) 74 75-- | Fetch the specified team and add it to the application state. 76-- 77-- This is called in response to a server event indicating that the 78-- current user was added to the team. 79handleJoinTeam :: TeamId -> MH () 80handleJoinTeam tId = do 81 session <- getSession 82 cr <- use csResources 83 me <- use csMe 84 85 mhLog LogGeneral $ T.pack $ "Joining team " <> show tId 86 doAsyncWith Normal $ do 87 t <- MM.mmGetTeam tId session 88 (ts, chans) <- buildTeamState cr me t 89 return $ Just $ do 90 curTs <- use csTeams 91 let myTIds = HM.keys curTs 92 when (not $ tId `elem` myTIds) $ do 93 addTeamState ts chans 94 updateSidebar $ Just tId 95 updateWindowTitle 96 refreshTeamZipper 97 98-- | Remove the specified team to the application state. 99-- 100-- This is called in response to a server event indicating that the 101-- current user was removed from the team. 102handleLeaveTeam :: TeamId -> MH () 103handleLeaveTeam tId = 104 doAsyncWith Normal $ return $ Just $ do 105 mhLog LogGeneral $ T.pack $ "Leaving team " <> show tId 106 removeTeam tId 107 updateWindowTitle 108 -- Invalidating the cache here expunges any cached message 109 -- renderings from the team we are leaving. 110 mh invalidateCache 111 112-- | Fetch the specified team's metadata and update it in the 113-- application state. 114-- 115-- This is called in response to a server event indicating that the 116-- specified team was updated in some way. 117handleUpdateTeam :: TeamId -> MH () 118handleUpdateTeam tId = do 119 session <- getSession 120 mhLog LogGeneral $ T.pack $ "Updating team " <> show tId 121 doAsyncWith Normal $ do 122 t <- MM.mmGetTeam tId session 123 return $ Just $ do 124 updateTeam t 125 -- Invalidate the cache since we happen to know that the 126 -- team name is in the cached sidebar. 127 mh invalidateCache 128 129-- | Set the team zipper ordering with the specified transformation, 130-- which is expected to be either 'moveLeft' or 'moveRight'. 131setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH () 132setTeamOrderWith sortFunc = do 133 session <- getSession 134 me <- use csMe 135 136 tId <- use csCurrentTeamId 137 z <- use csTeamZipper 138 let tIds = teamZipperIds z 139 newList = sortFunc tId tIds 140 141 doAsyncWith Normal $ do 142 let pref = teamOrderPref (me^.userIdL) newList 143 MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session 144 return Nothing 145 146-- | Move the selected team left in the team list. 147moveCurrentTeamLeft :: MH () 148moveCurrentTeamLeft = setTeamOrderWith moveLeft 149 150-- | Move the selected team right in the team list. 151moveCurrentTeamRight :: MH () 152moveCurrentTeamRight = setTeamOrderWith moveRight 153 154-- | Build a new 'TeamState' for the specified team. 155-- 156-- This function starts a new spell checker thread for the team's 157-- message editor, loads the last-run state for the team (to ensure that 158-- the initially-selected channel is honored), and fetches the channel 159-- metadata for the team. 160-- 161-- This returns the resulting team state as well as the channels 162-- associated with the team. The caller is responsible for adding the 163-- channels and the team state to the application state. 164buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels) 165buildTeamState cr me team = do 166 let tId = teamId team 167 session = getResourceSession cr 168 169 -- Create a predicate to find the last selected channel by reading 170 -- the run state file. If unable to read or decode or validate the 171 -- file, this predicate is just `isTownSquare`. 172 isLastSelectedChannel <- do 173 result <- readLastRunState tId 174 case result of 175 Right lrs | isValidLastRunState cr me lrs -> return $ \c -> 176 channelId c == lrs^.lrsSelectedChannelId 177 _ -> return isTownSquare 178 179 -- Get all channels, but filter down to just the one we want 180 -- to start in. We get all, rather than requesting by name or 181 -- ID, because we don't know whether the server will give us a 182 -- last-viewed preference. We first try to find a channel matching 183 -- with the last selected channel ID, failing which we look for the 184 -- Town Square channel by name. 185 userChans <- MM.mmGetChannelsForUser UserMe tId session 186 let lastSelectedChans = Seq.filter isLastSelectedChannel userChans 187 chans = if Seq.null lastSelectedChans 188 then Seq.filter isTownSquare userChans 189 else lastSelectedChans 190 191 -- Since the only channel we are dealing with is by construction the 192 -- last channel, we don't have to consider other cases here: 193 chanPairs <- forM (toList chans) $ \c -> do 194 cChannel <- makeClientChannel (userId me) c 195 return (getId c, cChannel) 196 197 -- Start the spell checker and spell check timer, if configured 198 spResult <- maybeStartSpellChecker (cr^.crConfiguration) (cr^.crEventQueue) 199 200 now <- getCurrentTime 201 let chanIds = mkChannelZipperList now (cr^.crConfiguration) tId 202 Nothing (cr^.crUserPreferences) 203 clientChans noUsers 204 chanZip = Z.fromList chanIds 205 clientChans = foldr (uncurry addChannel) noChannels chanPairs 206 207 return (newTeamState team chanZip spResult, clientChans) 208 209-- | Add a new 'TeamState' and corresponding channels to the application 210-- state. 211addTeamState :: TeamState -> ClientChannels -> MH () 212addTeamState ts chans = do 213 let tId = teamId $ _tsTeam ts 214 csTeams.at tId .= Just ts 215 csChannels %= (chans <>) 216 217-- | Update the specified team metadata in the application state (only 218-- if we are already a member of that team). 219updateTeam :: Team -> MH () 220updateTeam t = do 221 let tId = teamId t 222 ts <- use csTeams 223 when (tId `elem` HM.keys ts) $ do 224 csTeam(tId).tsTeam .= t 225 226-- | Remove the specified team from the application state. 227removeTeam :: TeamId -> MH () 228removeTeam tId = do 229 csTeams.at tId .= Nothing 230 setTeamFocusWith $ Z.filterZipper (/= tId) 231