module Matterhorn.State.UserListWindow
( 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.ListWindow
import Matterhorn.Types
enterChannelMembersUserList :: TeamId -> MH ()
enterChannelMembersUserList :: TeamId -> MH ()
enterChannelMembersUserList TeamId
myTId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
myTId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
Session
session <- MH Session
getSession
AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
ChannelStats
stats <- ChannelId -> Session -> IO ChannelStats
MM.mmGetChannelStatistics ChannelId
cId Session
session
Maybe (MH ()) -> IO (Maybe (MH ()))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
TeamId
-> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode TeamId
myTId (ChannelId -> TeamId -> UserSearchScope
ChannelMembers ChannelId
cId TeamId
myTId) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ChannelStats -> Int
channelStatsMemberCount ChannelStats
stats)
(\UserInfo
u -> case UserInfo
uUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
myId of
Bool
True -> TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
myTId UserInfo
u Maybe (ChannelId -> MH ())
forall a. Maybe a
Nothing MH () -> MH Bool -> MH Bool
forall a b. MH a -> MH b -> MH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False -> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
enterChannelInviteUserList :: TeamId -> MH ()
enterChannelInviteUserList :: TeamId -> MH ()
enterChannelInviteUserList TeamId
myTId = do
TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
myTId ((ChannelId -> ClientChannel -> MH ()) -> MH ())
-> (ChannelId -> ClientChannel -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
TeamId
-> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode TeamId
myTId (ChannelId -> TeamId -> UserSearchScope
ChannelNonMembers ChannelId
cId TeamId
myTId) Maybe Int
forall a. Maybe a
Nothing
(\UserInfo
u -> case UserInfo
uUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
myId of
Bool
True -> TeamId -> UserInfo -> MH ()
addUserToCurrentChannel TeamId
myTId UserInfo
u MH () -> MH Bool -> MH Bool
forall a b. MH a -> MH b -> MH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False -> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
enterDMSearchUserList :: TeamId -> MH ()
enterDMSearchUserList :: TeamId -> MH ()
enterDMSearchUserList TeamId
myTId = do
UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
Maybe ClientConfig
config <- Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
-> MH (Maybe ClientConfig)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
Lens' ChatState (Maybe ClientConfig)
csClientConfig
let restrictTeam :: Maybe TeamId
restrictTeam = case ClientConfig -> RestrictDirectMessageSetting
MM.clientConfigRestrictDirectMessage (ClientConfig -> RestrictDirectMessageSetting)
-> Maybe ClientConfig -> Maybe RestrictDirectMessageSetting
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ClientConfig
config of
Just RestrictDirectMessageSetting
MM.RestrictTeam -> TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
myTId
Maybe RestrictDirectMessageSetting
_ -> Maybe TeamId
forall a. Maybe a
Nothing
TeamId
-> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode TeamId
myTId (Maybe TeamId -> UserSearchScope
AllUsers Maybe TeamId
restrictTeam) Maybe Int
forall a. Maybe a
Nothing
(\UserInfo
u -> case UserInfo
uUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
/= UserId
myId of
Bool
True -> TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
myTId UserInfo
u Maybe (ChannelId -> MH ())
forall a. Maybe a
Nothing MH () -> MH Bool -> MH Bool
forall a b. MH a -> MH b -> MH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Bool
False -> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
)
enterUserListMode :: TeamId -> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode :: TeamId
-> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode TeamId
tId UserSearchScope
scope Maybe Int
resultCount UserInfo -> MH Bool
enterHandler = do
TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState)
-> ((Maybe Int -> Identity (Maybe Int))
-> TeamState -> Identity TeamState)
-> (Maybe Int -> Identity (Maybe Int))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState UserInfo UserSearchScope
-> Identity (ListWindowState UserInfo UserSearchScope))
-> TeamState -> Identity TeamState
Lens' TeamState (ListWindowState UserInfo UserSearchScope)
tsUserListWindow((ListWindowState UserInfo UserSearchScope
-> Identity (ListWindowState UserInfo UserSearchScope))
-> TeamState -> Identity TeamState)
-> ((Maybe Int -> Identity (Maybe Int))
-> ListWindowState UserInfo UserSearchScope
-> Identity (ListWindowState UserInfo UserSearchScope))
-> (Maybe Int -> Identity (Maybe Int))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Int -> Identity (Maybe Int))
-> ListWindowState UserInfo UserSearchScope
-> Identity (ListWindowState UserInfo UserSearchScope)
forall a b (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int))
-> ListWindowState a b -> f (ListWindowState a b)
listWindowRecordCount ((Maybe Int -> Identity (Maybe Int))
-> ChatState -> Identity ChatState)
-> Maybe Int -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
resultCount
TeamId
-> Lens' ChatState (ListWindowState UserInfo UserSearchScope)
-> Mode
-> UserSearchScope
-> (UserInfo -> MH Bool)
-> (UserSearchScope -> Session -> Text -> IO (Vector UserInfo))
-> MH ()
forall a b.
TeamId
-> Lens' ChatState (ListWindowState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListWindowMode TeamId
tId (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState UserInfo UserSearchScope
-> f (ListWindowState UserInfo UserSearchScope))
-> TeamState -> f TeamState)
-> (ListWindowState UserInfo UserSearchScope
-> f (ListWindowState UserInfo UserSearchScope))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState UserInfo UserSearchScope
-> f (ListWindowState UserInfo UserSearchScope))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState UserInfo UserSearchScope)
tsUserListWindow) Mode
UserListWindow UserSearchScope
scope UserInfo -> MH Bool
enterHandler UserSearchScope -> Session -> Text -> IO (Vector UserInfo)
getUserSearchResults
userInfoFromPair :: User -> Text -> UserInfo
userInfoFromPair :: User -> Text -> UserInfo
userInfoFromPair User
u Text
status =
User -> Bool -> UserInfo
userInfoFromUser User
u Bool
True UserInfo -> (UserInfo -> UserInfo) -> UserInfo
forall a b. a -> (a -> b) -> b
& (UserStatus -> Identity UserStatus)
-> UserInfo -> Identity UserInfo
Lens' UserInfo UserStatus
uiStatus ((UserStatus -> Identity UserStatus)
-> UserInfo -> Identity UserInfo)
-> UserStatus -> UserInfo -> UserInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> UserStatus
statusFromText Text
status
userListSelectUp :: TeamId -> MH ()
userListSelectUp :: TeamId -> MH ()
userListSelectUp TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId List Name UserInfo -> List Name UserInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveUp
userListSelectDown :: TeamId -> MH ()
userListSelectDown :: TeamId -> MH ()
userListSelectDown TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId List Name UserInfo -> List Name UserInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveDown
userListPageUp :: TeamId -> MH ()
userListPageUp :: TeamId -> MH ()
userListPageUp TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId (Int -> List Name UserInfo -> List Name UserInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
userListPageSize))
userListPageDown :: TeamId -> MH ()
userListPageDown :: TeamId -> MH ()
userListPageDown TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId (Int -> List Name UserInfo -> List Name UserInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy Int
userListPageSize)
userListMove :: TeamId -> (L.List Name UserInfo -> L.List Name UserInfo) -> MH ()
userListMove :: TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId = Lens' ChatState (ListWindowState UserInfo UserSearchScope)
-> (List Name UserInfo -> List Name UserInfo) -> MH ()
forall a b.
Lens' ChatState (ListWindowState a b)
-> (List Name a -> List Name a) -> MH ()
listWindowMove (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState UserInfo UserSearchScope
-> f (ListWindowState UserInfo UserSearchScope))
-> TeamState -> f TeamState)
-> (ListWindowState UserInfo UserSearchScope
-> f (ListWindowState UserInfo UserSearchScope))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState UserInfo UserSearchScope
-> f (ListWindowState UserInfo UserSearchScope))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState UserInfo UserSearchScope)
tsUserListWindow)
userListPageSize :: Int
userListPageSize :: Int
userListPageSize = Int
10
getUserSearchResults :: UserSearchScope
-> Session
-> Text
-> IO (Vec.Vector UserInfo)
getUserSearchResults :: UserSearchScope -> Session -> Text -> IO (Vector UserInfo)
getUserSearchResults UserSearchScope
scope Session
s Text
searchString = do
let query :: UserSearch
query = UserSearch { userSearchTerm :: Text
userSearchTerm = if Text -> Bool
T.null Text
searchString then Text
" " else Text
searchString
, userSearchAllowInactive :: Bool
userSearchAllowInactive = Bool
False
, userSearchWithoutTeam :: Bool
userSearchWithoutTeam = Bool
False
, userSearchInChannelId :: Maybe ChannelId
userSearchInChannelId = case UserSearchScope
scope of
ChannelMembers ChannelId
cId TeamId
_ -> ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId
UserSearchScope
_ -> Maybe ChannelId
forall a. Maybe a
Nothing
, userSearchNotInTeamId :: Maybe TeamId
userSearchNotInTeamId = Maybe TeamId
forall a. Maybe a
Nothing
, userSearchNotInChannelId :: Maybe ChannelId
userSearchNotInChannelId = case UserSearchScope
scope of
ChannelNonMembers ChannelId
cId TeamId
_ -> ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId
UserSearchScope
_ -> Maybe ChannelId
forall a. Maybe a
Nothing
, userSearchTeamId :: Maybe TeamId
userSearchTeamId = case UserSearchScope
scope of
AllUsers Maybe TeamId
tId -> Maybe TeamId
tId
ChannelMembers ChannelId
_ TeamId
tId -> TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tId
ChannelNonMembers ChannelId
_ TeamId
tId -> TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just TeamId
tId
}
Seq User
users <- UserSearch -> Session -> IO (Seq User)
MM.mmSearchUsers UserSearch
query Session
s
let uList :: [User]
uList = Seq User -> [User]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq User
users
uIds :: [UserId]
uIds = User -> UserId
userId (User -> UserId) -> [User] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [User]
uList
case [User] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [User]
uList of
Bool
False -> do
Seq Status
statuses <- Seq UserId -> Session -> IO (Seq Status)
MM.mmGetUserStatusByIds ([UserId] -> Seq UserId
forall a. [a] -> Seq a
Seq.fromList [UserId]
uIds) Session
s
let statusMap :: HashMap UserId Text
statusMap = [(UserId, Text)] -> HashMap UserId Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [ (Status -> UserId
statusUserId Status
e, Status -> Text
statusStatus Status
e) | Status
e <- Seq Status -> [Status]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Status
statuses ]
usersWithStatus :: [UserInfo]
usersWithStatus = [ User -> Text -> UserInfo
userInfoFromPair User
u (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ UserId -> HashMap UserId Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (User -> UserId
userId User
u) HashMap UserId Text
statusMap)
| User
u <- [User]
uList
]
Vector UserInfo -> IO (Vector UserInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector UserInfo -> IO (Vector UserInfo))
-> Vector UserInfo -> IO (Vector UserInfo)
forall a b. (a -> b) -> a -> b
$ [UserInfo] -> Vector UserInfo
forall a. [a] -> Vector a
Vec.fromList [UserInfo]
usersWithStatus
Bool
True -> Vector UserInfo -> IO (Vector UserInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector UserInfo
forall a. Monoid a => a
mempty