module State.UserListOverlay ( enterChannelMembersUserList , enterChannelInviteUserList , enterDMSearchUserList , resetUserListSearch , exitUserListMode , userListActivateCurrent , userListSelectDown , userListSelectUp , userListPageDown , userListPageUp , userListSearchString ) where import Prelude () import Prelude.MH import qualified Brick.Widgets.Edit as E import qualified Brick.Widgets.List as L import qualified Data.Foldable as F import qualified Data.HashMap.Strict as HM import qualified Data.Sequence as Seq import qualified Data.Text as T import qualified Data.Text.Zipper as Z import qualified Data.Vector as Vec import Lens.Micro.Platform ( (.=), (%=), (.~), to ) import qualified Network.Mattermost.Endpoints as MM import Network.Mattermost.Types import State ( changeChannel, addUserToCurrentChannel ) import State.Common import Types -- | Show the user list overlay for searching/showing members of the -- current channel. enterChannelMembersUserList :: MH () enterChannelMembersUserList = do cId <- use csCurrentChannelId myId <- gets myUserId enterUserListMode (ChannelMembers cId) (\u -> case u^.uiId /= myId of True -> changeChannel (u^.uiName) >> return True False -> return False ) -- | Show the user list overlay for showing users that are not members -- of the current channel for the purpose of adding them to the -- channel. enterChannelInviteUserList :: MH () enterChannelInviteUserList = do cId <- use csCurrentChannelId myId <- gets myUserId enterUserListMode (ChannelNonMembers cId) (\u -> case u^.uiId /= myId of True -> addUserToCurrentChannel (u^.uiName) >> return True False -> return False ) -- | Show the user list overlay for showing all users for the purpose of -- starting a direct message channel with another user. enterDMSearchUserList :: MH () enterDMSearchUserList = do myId <- gets myUserId enterUserListMode AllUsers (\u -> case u^.uiId /= myId of True -> changeChannel (u^.uiName) >> return True False -> return False ) -- | Interact with the currently-selected user (depending on how the -- overlay is configured). userListActivateCurrent :: MH () userListActivateCurrent = do mItem <- L.listSelectedElement <$> use (csUserListOverlay.userListSearchResults) case mItem of Nothing -> return () Just (_, user) -> do handler <- use (csUserListOverlay.userListEnterHandler) activated <- handler user if activated then setMode Main else return () -- | Show the user list overlay with the given search scope, and issue a -- request to gather the first search results. enterUserListMode :: UserSearchScope -> (UserInfo -> MH Bool) -> MH () enterUserListMode scope enterHandler = do csUserListOverlay.userListSearchScope .= scope csUserListOverlay.userListSearchInput.E.editContentsL %= Z.clearZipper csUserListOverlay.userListEnterHandler .= enterHandler csUserListOverlay.userListSearching .= False csUserListOverlay.userListHasAllResults .= False setMode UserListOverlay resetUserListSearch resetUserListSearch :: MH () resetUserListSearch = do searchPending <- use (csUserListOverlay.userListSearching) when (not searchPending) $ do searchString <- userListSearchString csUserListOverlay.userListSearching .= True csUserListOverlay.userListHasAllResults .= False csUserListOverlay.userListSearchResults .= listFromUserSearchResults mempty session <- getSession scope <- use (csUserListOverlay.userListSearchScope) myTId <- gets myTeamId doAsyncWith Preempt $ do results <- fetchInitialResults myTId scope session searchString return $ do let lst = listFromUserSearchResults results csUserListOverlay.userListSearchResults .= lst -- NOTE: Disabled for now. See the hack note below for -- details. -- -- csUserListOverlay.userListHasAllResults .= (length results < searchResultsChunkSize) csUserListOverlay.userListSearching .= False -- Now that the results are available, check to see if the -- search string changed since this request was submitted. -- If so, issue another search. afterSearchString <- userListSearchString when (searchString /= afterSearchString) resetUserListSearch userInfoFromPair :: User -> Text -> UserInfo userInfoFromPair u status = userInfoFromUser u True & uiStatus .~ statusFromText status -- | Clear out the state of the user list overlay and return to the Main -- mode. exitUserListMode :: MH () exitUserListMode = do csUserListOverlay.userListSearchResults .= listFromUserSearchResults mempty csUserListOverlay.userListEnterHandler .= (const $ return False) setMode Main -- | Move the selection up in the user list overlay by one user. userListSelectUp :: MH () userListSelectUp = userListMove L.listMoveUp -- | Move the selection down in the user list overlay by one user. userListSelectDown :: MH () userListSelectDown = userListMove L.listMoveDown -- | Move the selection up in the user list overlay by a page of users -- (userListPageSize). userListPageUp :: MH () userListPageUp = userListMove (L.listMoveBy (-1 * userListPageSize)) -- | Move the selection down in the user list overlay by a page of users -- (userListPageSize). userListPageDown :: MH () userListPageDown = userListMove (L.listMoveBy userListPageSize) -- | Transform the user list results in some way, e.g. by moving the -- cursor, and then check to see whether the modification warrants a -- prefetch of more search results. userListMove :: (L.List Name UserInfo -> L.List Name UserInfo) -> MH () userListMove f = do csUserListOverlay.userListSearchResults %= f -- NOTE! Do not enable this. See the docs for maybePrefetchNextChunk. -- For now we want to keep the code around in case it can be -- reinstated in the future. -- maybePrefetchNextChunk -- | We'll attempt to prefetch the next page of results if the cursor -- gets within this many positions of the last result we have. selectionPrefetchDelta :: Int selectionPrefetchDelta = 10 -- Prefetch the next chunk of user list search results if all of the -- following are true: -- -- * the search string is empty (because we can't paginate searches, -- just fetches for all users), and -- * cursor is within selectionPrefetchDelta positions of the end of -- list, and -- * the length of the current results list is exactly a multiple of -- fetching chunk size (thus indicating a very high probability that -- there are more results to be fetched). -- -- NOTE: this function should be reinstated and called in 'userListMove' -- if we start using the /users endpoint again in the future. See the -- hack note in the getUserSearchResultsPage below for details. In the -- mean time, no pagination of results is possible so no prefetching -- should be done. _maybePrefetchNextChunk :: MH () _maybePrefetchNextChunk = do gettingMore <- use (csUserListOverlay.userListRequestingMore) hasAll <- use (csUserListOverlay.userListHasAllResults) searchString <- userListSearchString curIdx <- use (csUserListOverlay.userListSearchResults.L.listSelectedL) numResults <- use (csUserListOverlay.userListSearchResults.to F.length) let selectionNearEnd = case curIdx of Nothing -> False Just i -> numResults - (i + 1) < selectionPrefetchDelta when (not hasAll && T.null searchString && not gettingMore && selectionNearEnd) $ do let pageNum = numResults `div` searchResultsChunkSize csUserListOverlay.userListRequestingMore .= True session <- getSession scope <- use (csUserListOverlay.userListSearchScope) myTId <- gets myTeamId doAsyncWith Preempt $ do newChunk <- getUserSearchResultsPage pageNum myTId scope session searchString return $ do -- Because we only ever append, this is safe to do w.r.t. -- the selected index of the list. If we ever prepended or -- removed, we'd also need to manage the selection index -- to ensure it stays in bounds. csUserListOverlay.userListSearchResults.L.listElementsL %= (<> newChunk) csUserListOverlay.userListRequestingMore .= False -- If we got fewer results than we asked for, then we have -- them all! -- -- NOTE: disabled for now, see the hack note below. -- -- csUserListOverlay.userListHasAllResults .= -- (length newChunk < searchResultsChunkSize) -- | The number of users in a "page" for cursor movement purposes. userListPageSize :: Int userListPageSize = 10 -- | Perform an initial request for search results in the specified -- scope. fetchInitialResults :: TeamId -> UserSearchScope -> Session -> Text -> IO (Vec.Vector UserInfo) fetchInitialResults = getUserSearchResultsPage 0 searchResultsChunkSize :: Int searchResultsChunkSize = 40 getUserSearchResultsPage :: Int -- ^ The page number of results to fetch, starting at zero. -> TeamId -- ^ My team ID. -> UserSearchScope -- ^ The scope to search -> Session -- ^ The connection session -> Text -- ^ The search string -> IO (Vec.Vector UserInfo) getUserSearchResultsPage _pageNum myTId scope s searchString = do -- Unfortunately, we don't get pagination control when there is a -- search string in effect. We'll get at most 100 results from a -- search. let query = UserSearch { userSearchTerm = if T.null searchString then " " else searchString -- Hack alert: Searching with the string " " -- above is a hack to use the search -- endpoint to get "all users" instead of -- those matching a particular non-empty -- non-whitespace string. This is because -- only the search endpoint provides a -- control to eliminate deleted users from -- the results. If we don't do this, and -- use the /users endpoint instead, we'll -- get deleted users in those results and -- then those deleted users will disappear -- from the results once the user enters a -- non-empty string string. , userSearchAllowInactive = False , userSearchWithoutTeam = False , userSearchInChannelId = case scope of ChannelMembers cId -> Just cId _ -> Nothing , userSearchNotInTeamId = Nothing , userSearchNotInChannelId = case scope of ChannelNonMembers cId -> Just cId _ -> Nothing , userSearchTeamId = Just myTId } users <- MM.mmSearchUsers query s let uList = toList users uIds = userId <$> uList -- Now fetch status info for the users we got. case null uList of False -> do statuses <- MM.mmGetUserStatusByIds (Seq.fromList uIds) s let statusMap = HM.fromList [ (statusUserId e, statusStatus e) | e <- toList statuses ] usersWithStatus = [ userInfoFromPair u (fromMaybe "" $ HM.lookup (userId u) statusMap) | u <- uList ] return $ Vec.fromList usersWithStatus True -> return mempty userListSearchString :: MH Text userListSearchString = (head . E.getEditContents) <$> use (csUserListOverlay.userListSearchInput)