1module Matterhorn.State.UserListOverlay 2 ( enterChannelMembersUserList 3 , enterChannelInviteUserList 4 , enterDMSearchUserList 5 6 , userListSelectDown 7 , userListSelectUp 8 , userListPageDown 9 , userListPageUp 10 ) 11where 12 13import Prelude () 14import Matterhorn.Prelude 15 16import qualified Brick.Widgets.List as L 17import qualified Data.HashMap.Strict as HM 18import qualified Data.Sequence as Seq 19import qualified Data.Text as T 20import qualified Data.Vector as Vec 21import Lens.Micro.Platform ( (.~), (.=) ) 22 23import qualified Network.Mattermost.Endpoints as MM 24import qualified Network.Mattermost.Types.Config as MM 25import Network.Mattermost.Types 26 27import Matterhorn.State.Async ( doAsyncWith, AsyncPriority(Preempt) ) 28import Matterhorn.State.Channels ( createOrFocusDMChannel, addUserToCurrentChannel ) 29import Matterhorn.State.ListOverlay 30import Matterhorn.Types 31 32 33-- | Show the user list overlay for searching/showing members of the 34-- current channel. 35enterChannelMembersUserList :: MH () 36enterChannelMembersUserList = do 37 myTId <- use csCurrentTeamId 38 cId <- use (csCurrentChannelId myTId) 39 myId <- gets myUserId 40 session <- getSession 41 42 doAsyncWith Preempt $ do 43 stats <- MM.mmGetChannelStatistics cId session 44 return $ Just $ do 45 enterUserListMode myTId (ChannelMembers cId myTId) (Just $ channelStatsMemberCount stats) 46 (\u -> case u^.uiId /= myId of 47 True -> createOrFocusDMChannel u Nothing >> return True 48 False -> return False 49 ) 50 51-- | Show the user list overlay for showing users that are not members 52-- of the current channel for the purpose of adding them to the 53-- channel. 54enterChannelInviteUserList :: MH () 55enterChannelInviteUserList = do 56 myTId <- use csCurrentTeamId 57 cId <- use (csCurrentChannelId myTId) 58 myId <- gets myUserId 59 enterUserListMode myTId (ChannelNonMembers cId myTId) Nothing 60 (\u -> case u^.uiId /= myId of 61 True -> addUserToCurrentChannel u >> return True 62 False -> return False 63 ) 64 65-- | Show the user list overlay for showing all users for the purpose of 66-- starting a direct message channel with another user. 67enterDMSearchUserList :: MH () 68enterDMSearchUserList = do 69 myId <- gets myUserId 70 myTId <- use csCurrentTeamId 71 config <- use csClientConfig 72 let restrictTeam = case MM.clientConfigRestrictDirectMessage <$> config of 73 Just MM.RestrictTeam -> Just myTId 74 _ -> Nothing 75 enterUserListMode myTId (AllUsers restrictTeam) Nothing 76 (\u -> case u^.uiId /= myId of 77 True -> createOrFocusDMChannel u Nothing >> return True 78 False -> return False 79 ) 80 81-- | Show the user list overlay with the given search scope, and issue a 82-- request to gather the first search results. 83enterUserListMode :: TeamId -> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH () 84enterUserListMode tId scope resultCount enterHandler = do 85 csTeam(tId).tsUserListOverlay.listOverlayRecordCount .= resultCount 86 enterListOverlayMode (csTeam(tId).tsUserListOverlay) UserListOverlay scope enterHandler getUserSearchResults 87 88userInfoFromPair :: User -> Text -> UserInfo 89userInfoFromPair u status = 90 userInfoFromUser u True & uiStatus .~ statusFromText status 91 92-- | Move the selection up in the user list overlay by one user. 93userListSelectUp :: MH () 94userListSelectUp = userListMove L.listMoveUp 95 96-- | Move the selection down in the user list overlay by one user. 97userListSelectDown :: MH () 98userListSelectDown = userListMove L.listMoveDown 99 100-- | Move the selection up in the user list overlay by a page of users 101-- (userListPageSize). 102userListPageUp :: MH () 103userListPageUp = userListMove (L.listMoveBy (-1 * userListPageSize)) 104 105-- | Move the selection down in the user list overlay by a page of users 106-- (userListPageSize). 107userListPageDown :: MH () 108userListPageDown = userListMove (L.listMoveBy userListPageSize) 109 110-- | Transform the user list results in some way, e.g. by moving the 111-- cursor, and then check to see whether the modification warrants a 112-- prefetch of more search results. 113userListMove :: (L.List Name UserInfo -> L.List Name UserInfo) -> MH () 114userListMove = listOverlayMove (csCurrentTeam.tsUserListOverlay) 115 116-- | The number of users in a "page" for cursor movement purposes. 117userListPageSize :: Int 118userListPageSize = 10 119 120getUserSearchResults :: UserSearchScope 121 -- ^ The scope to search 122 -> Session 123 -- ^ The connection session 124 -> Text 125 -- ^ The search string 126 -> IO (Vec.Vector UserInfo) 127getUserSearchResults scope s searchString = do 128 -- Unfortunately, we don't get pagination control when there is a 129 -- search string in effect. We'll get at most 100 results from a 130 -- search. 131 let query = UserSearch { userSearchTerm = if T.null searchString then " " else searchString 132 -- Hack alert: Searching with the string " " 133 -- above is a hack to use the search 134 -- endpoint to get "all users" instead of 135 -- those matching a particular non-empty 136 -- non-whitespace string. This is because 137 -- only the search endpoint provides a 138 -- control to eliminate deleted users from 139 -- the results. If we don't do this, and 140 -- use the /users endpoint instead, we'll 141 -- get deleted users in those results and 142 -- then those deleted users will disappear 143 -- from the results once the user enters a 144 -- non-empty string string. 145 , userSearchAllowInactive = False 146 , userSearchWithoutTeam = False 147 , userSearchInChannelId = case scope of 148 ChannelMembers cId _ -> Just cId 149 _ -> Nothing 150 , userSearchNotInTeamId = Nothing 151 , userSearchNotInChannelId = case scope of 152 ChannelNonMembers cId _ -> Just cId 153 _ -> Nothing 154 , userSearchTeamId = case scope of 155 AllUsers tId -> tId 156 ChannelMembers _ tId -> Just tId 157 ChannelNonMembers _ tId -> Just tId 158 } 159 users <- MM.mmSearchUsers query s 160 161 let uList = toList users 162 uIds = userId <$> uList 163 164 -- Now fetch status info for the users we got. 165 case null uList of 166 False -> do 167 statuses <- MM.mmGetUserStatusByIds (Seq.fromList uIds) s 168 let statusMap = HM.fromList [ (statusUserId e, statusStatus e) | e <- toList statuses ] 169 usersWithStatus = [ userInfoFromPair u (fromMaybe "" $ HM.lookup (userId u) statusMap) 170 | u <- uList 171 ] 172 173 return $ Vec.fromList usersWithStatus 174 True -> return mempty 175