module Matterhorn.State.UserListOverlay
( enterChannelMembersUserList
, enterChannelInviteUserList
, enterDMSearchUserList
, userListSelectDown
, userListSelectUp
, userListPageDown
, userListPageUp
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Brick.Widgets.List as L
import qualified Data.HashMap.Strict as HM
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Vector as Vec
import Lens.Micro.Platform ( (.~), (.=) )
import qualified Network.Mattermost.Endpoints as MM
import qualified Network.Mattermost.Types.Config as MM
import Network.Mattermost.Types
import Matterhorn.State.Async ( doAsyncWith, AsyncPriority(Preempt) )
import Matterhorn.State.Channels ( createOrFocusDMChannel, addUserToCurrentChannel )
import Matterhorn.State.ListOverlay
import Matterhorn.Types
enterChannelMembersUserList :: MH ()
enterChannelMembersUserList = do
cId <- use csCurrentChannelId
myId <- gets myUserId
myTId <- gets myTeamId
session <- getSession
doAsyncWith Preempt $ do
stats <- MM.mmGetChannelStatistics cId session
return $ Just $ do
enterUserListMode (ChannelMembers cId myTId) (Just $ channelStatsMemberCount stats)
(\u -> case u^.uiId /= myId of
True -> createOrFocusDMChannel u Nothing >> return True
False -> return False
)
enterChannelInviteUserList :: MH ()
enterChannelInviteUserList = do
cId <- use csCurrentChannelId
myId <- gets myUserId
myTId <- gets myTeamId
enterUserListMode (ChannelNonMembers cId myTId) Nothing
(\u -> case u^.uiId /= myId of
True -> addUserToCurrentChannel u >> return True
False -> return False
)
enterDMSearchUserList :: MH ()
enterDMSearchUserList = do
myId <- gets myUserId
myTId <- gets myTeamId
config <- use csClientConfig
let restrictTeam = case MM.clientConfigRestrictDirectMessage <$> config of
Just MM.RestrictTeam -> Just myTId
_ -> Nothing
enterUserListMode (AllUsers restrictTeam) Nothing
(\u -> case u^.uiId /= myId of
True -> createOrFocusDMChannel u Nothing >> return True
False -> return False
)
enterUserListMode :: UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode scope resultCount enterHandler = do
csUserListOverlay.listOverlayRecordCount .= resultCount
enterListOverlayMode csUserListOverlay UserListOverlay scope enterHandler getUserSearchResults
userInfoFromPair :: User -> Text -> UserInfo
userInfoFromPair u status =
userInfoFromUser u True & uiStatus .~ statusFromText status
userListSelectUp :: MH ()
userListSelectUp = userListMove L.listMoveUp
userListSelectDown :: MH ()
userListSelectDown = userListMove L.listMoveDown
userListPageUp :: MH ()
userListPageUp = userListMove (L.listMoveBy (-1 * userListPageSize))
userListPageDown :: MH ()
userListPageDown = userListMove (L.listMoveBy userListPageSize)
userListMove :: (L.List Name UserInfo -> L.List Name UserInfo) -> MH ()
userListMove = listOverlayMove csUserListOverlay
userListPageSize :: Int
userListPageSize = 10
getUserSearchResults :: UserSearchScope
-> Session
-> Text
-> IO (Vec.Vector UserInfo)
getUserSearchResults scope s searchString = do
let query = UserSearch { userSearchTerm = if T.null searchString then " " else searchString
, 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 = case scope of
AllUsers tId -> tId
ChannelMembers _ tId -> Just tId
ChannelNonMembers _ tId -> Just tId
}
users <- MM.mmSearchUsers query s
let uList = toList users
uIds = userId <$> uList
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