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


-- | Show the user list window for searching/showing members of the
-- current channel.
enterChannelMembersUserList :: TeamId -> MH ()
enterChannelMembersUserList :: TeamId -> MH ()
enterChannelMembersUserList TeamId
myTId = do
    TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
myTId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
        UserId
myId <- 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 forall a b. (a -> b) -> a -> b
$ do
            ChannelStats
stats <- ChannelId -> Session -> IO ChannelStats
MM.mmGetChannelStatistics ChannelId
cId Session
session
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just 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) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ChannelStats -> Int
channelStatsMemberCount ChannelStats
stats)
                  (\UserInfo
u -> case UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId forall a. Eq a => a -> a -> Bool
/= UserId
myId of
                    Bool
True -> TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
myTId UserInfo
u forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                    Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                  )

-- | Show the user list window for showing users that are not members
-- of the current channel for the purpose of adding them to the
-- channel.
enterChannelInviteUserList :: TeamId -> MH ()
enterChannelInviteUserList :: TeamId -> MH ()
enterChannelInviteUserList TeamId
myTId = do
    TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
myTId forall a b. (a -> b) -> a -> b
$ \ChannelId
cId ClientChannel
_ -> do
        UserId
myId <- 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) forall a. Maybe a
Nothing
          (\UserInfo
u -> case UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId forall a. Eq a => a -> a -> Bool
/= UserId
myId of
            Bool
True -> TeamId -> UserInfo -> MH ()
addUserToCurrentChannel TeamId
myTId UserInfo
u forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
          )

-- | Show the user list window for showing all users for the purpose of
-- starting a direct message channel with another user.
enterDMSearchUserList :: TeamId -> MH ()
enterDMSearchUserList :: TeamId -> MH ()
enterDMSearchUserList TeamId
myTId = do
    UserId
myId <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ChatState -> UserId
myUserId
    Maybe ClientConfig
config <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (Maybe ClientConfig)
csClientConfig
    let restrictTeam :: Maybe TeamId
restrictTeam = case ClientConfig -> RestrictDirectMessageSetting
MM.clientConfigRestrictDirectMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ClientConfig
config of
            Just RestrictDirectMessageSetting
MM.RestrictTeam -> forall a. a -> Maybe a
Just TeamId
myTId
            Maybe RestrictDirectMessageSetting
_ -> forall a. Maybe a
Nothing
    TeamId
-> UserSearchScope -> Maybe Int -> (UserInfo -> MH Bool) -> MH ()
enterUserListMode TeamId
myTId (Maybe TeamId -> UserSearchScope
AllUsers Maybe TeamId
restrictTeam) forall a. Maybe a
Nothing
      (\UserInfo
u -> case UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId forall a. Eq a => a -> a -> Bool
/= UserId
myId of
        Bool
True -> TeamId -> UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()
createOrFocusDMChannel TeamId
myTId UserInfo
u forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      )

-- | Show the user list window 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)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState UserInfo UserSearchScope)
tsUserListWindowforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Maybe Int)
listWindowRecordCount forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Int
resultCount
    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)forall b c a. (b -> c) -> (a -> b) -> a -> c
.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 forall a b. a -> (a -> b) -> b
& Lens' UserInfo UserStatus
uiStatus 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 window by one user.
userListSelectUp :: TeamId -> MH ()
userListSelectUp :: TeamId -> MH ()
userListSelectUp TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId 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 window by one user.
userListSelectDown :: TeamId -> MH ()
userListSelectDown :: TeamId -> MH ()
userListSelectDown TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId 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 window by a page of users
-- (userListPageSize).
userListPageUp :: TeamId -> MH ()
userListPageUp :: TeamId -> MH ()
userListPageUp TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy (-Int
1 forall a. Num a => a -> a -> a
* Int
userListPageSize))

-- | Move the selection down in the user list window by a page of users
-- (userListPageSize).
userListPageDown :: TeamId -> MH ()
userListPageDown :: TeamId -> MH ()
userListPageDown TeamId
tId = TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId (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 :: TeamId -> (L.List Name UserInfo -> L.List Name UserInfo) -> MH ()
userListMove :: TeamId -> (List Name UserInfo -> List Name UserInfo) -> MH ()
userListMove TeamId
tId = forall a b.
Lens' ChatState (ListWindowState a b)
-> (List Name a -> List Name a) -> MH ()
listWindowMove (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState UserInfo UserSearchScope)
tsUserListWindow)

-- | 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 { 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
_ -> forall a. a -> Maybe a
Just ChannelId
cId
                               UserSearchScope
_                    -> forall a. Maybe a
Nothing
                           , userSearchNotInTeamId :: Maybe TeamId
userSearchNotInTeamId = forall a. Maybe a
Nothing
                           , userSearchNotInChannelId :: Maybe ChannelId
userSearchNotInChannelId = case UserSearchScope
scope of
                               ChannelNonMembers ChannelId
cId TeamId
_ -> forall a. a -> Maybe a
Just ChannelId
cId
                               UserSearchScope
_                       -> forall a. Maybe a
Nothing
                           , userSearchTeamId :: Maybe TeamId
userSearchTeamId = case UserSearchScope
scope of
                               AllUsers Maybe TeamId
tId            -> Maybe TeamId
tId
                               ChannelMembers ChannelId
_ TeamId
tId    -> forall a. a -> Maybe a
Just TeamId
tId
                               ChannelNonMembers ChannelId
_ TeamId
tId -> 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 = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq User
users
        uIds :: [UserId]
uIds = User -> UserId
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 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 (forall a. [a] -> Seq a
Seq.fromList [UserId]
uIds) Session
s
            let statusMap :: HashMap UserId Text
statusMap = 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 <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Status
statuses ]
                usersWithStatus :: [UserInfo]
usersWithStatus = [ User -> Text -> UserInfo
userInfoFromPair User
u (forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ 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
                                  ]

            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
Vec.fromList [UserInfo]
usersWithStatus
        Bool
True -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty