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


-- | Show the user list overlay for searching/showing members of the
-- current channel.
enterChannelMembersUserList :: MH ()
enterChannelMembersUserList :: MH ()
enterChannelMembersUserList = do
    TeamId
myTId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
myTId)
    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 (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 -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel UserInfo
u Maybe (ChannelId -> MH ())
forall a. Maybe a
Nothing MH () -> MH Bool -> MH Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                Bool
False -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: MH ()
enterChannelInviteUserList = do
    TeamId
myTId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    ChannelId
cId <- Getting ChannelId ChatState ChannelId -> MH ChannelId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
myTId)
    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 -> UserInfo -> MH ()
addUserToCurrentChannel UserInfo
u MH () -> MH Bool -> MH Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Bool
False -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: MH ()
enterDMSearchUserList = do
    UserId
myId <- (ChatState -> UserId) -> MH UserId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    TeamId
myTId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    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 -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel UserInfo
u Maybe (ChannelId -> MH ())
forall a. Maybe a
Nothing MH () -> MH Bool -> MH Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Bool
False -> Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      )

-- | Show the user list overlay with the given search scope, and issue a
-- request to gather the first search results.
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
.(ListOverlayState UserInfo UserSearchScope
 -> Identity (ListOverlayState UserInfo UserSearchScope))
-> TeamState -> Identity TeamState
Lens' TeamState (ListOverlayState UserInfo UserSearchScope)
tsUserListOverlay((ListOverlayState UserInfo UserSearchScope
  -> Identity (ListOverlayState UserInfo UserSearchScope))
 -> TeamState -> Identity TeamState)
-> ((Maybe Int -> Identity (Maybe Int))
    -> ListOverlayState UserInfo UserSearchScope
    -> Identity (ListOverlayState 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))
-> ListOverlayState UserInfo UserSearchScope
-> Identity (ListOverlayState UserInfo UserSearchScope)
forall a b. Lens' (ListOverlayState a b) (Maybe Int)
listOverlayRecordCount ((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
    Lens' ChatState (ListOverlayState UserInfo UserSearchScope)
-> Mode
-> UserSearchScope
-> (UserInfo -> MH Bool)
-> (UserSearchScope -> Session -> Text -> IO (Vector UserInfo))
-> MH ()
forall a b.
Lens' ChatState (ListOverlayState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListOverlayMode (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState UserInfo UserSearchScope
     -> f (ListOverlayState UserInfo UserSearchScope))
    -> TeamState -> f TeamState)
-> (ListOverlayState UserInfo UserSearchScope
    -> f (ListOverlayState UserInfo UserSearchScope))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState UserInfo UserSearchScope
 -> f (ListOverlayState UserInfo UserSearchScope))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState UserInfo UserSearchScope)
tsUserListOverlay) Mode
UserListOverlay 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

-- | Move the selection up in the user list overlay by one user.
userListSelectUp :: MH ()
userListSelectUp :: MH ()
userListSelectUp = (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove List Name UserInfo -> List Name UserInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveUp

-- | Move the selection down in the user list overlay by one user.
userListSelectDown :: MH ()
userListSelectDown :: MH ()
userListSelectDown = (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove List Name UserInfo -> List Name UserInfo
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveDown

-- | Move the selection up in the user list overlay by a page of users
-- (userListPageSize).
userListPageUp :: MH ()
userListPageUp :: MH ()
userListPageUp = (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove (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))

-- | Move the selection down in the user list overlay by a page of users
-- (userListPageSize).
userListPageDown :: MH ()
userListPageDown :: MH ()
userListPageDown = (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove (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)

-- | 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 :: (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove = Lens' ChatState (ListOverlayState UserInfo UserSearchScope)
-> (List Name UserInfo -> List Name UserInfo) -> MH ()
forall a b.
Lens' ChatState (ListOverlayState a b)
-> (List Name a -> List Name a) -> MH ()
listOverlayMove ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState UserInfo UserSearchScope
     -> f (ListOverlayState UserInfo UserSearchScope))
    -> TeamState -> f TeamState)
-> (ListOverlayState UserInfo UserSearchScope
    -> f (ListOverlayState UserInfo UserSearchScope))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState UserInfo UserSearchScope
 -> f (ListOverlayState UserInfo UserSearchScope))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState UserInfo UserSearchScope)
tsUserListOverlay)

-- | The number of users in a "page" for cursor movement purposes.
userListPageSize :: Int
userListPageSize :: Int
userListPageSize = Int
10

getUserSearchResults :: UserSearchScope
                     -- ^ The scope to search
                     -> Session
                     -- ^ The connection session
                     -> Text
                     -- ^ The search string
                     -> IO (Vec.Vector UserInfo)
getUserSearchResults :: UserSearchScope -> Session -> Text -> IO (Vector UserInfo)
getUserSearchResults UserSearchScope
scope Session
s Text
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
query = UserSearch :: Text
-> Bool
-> Bool
-> Maybe ChannelId
-> Maybe TeamId
-> Maybe ChannelId
-> Maybe TeamId
-> UserSearch
UserSearch { userSearchTerm :: Text
userSearchTerm = if Text -> Bool
T.null Text
searchString then Text
" " else Text
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 :: 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 (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

    -- Now fetch status info for the users we got.
    case [User] -> 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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return Vector UserInfo
forall a. Monoid a => a
mempty