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