Teams.hs

module Matterhorn.State.Teams
  ( nextTeam
  , prevTeam
  , handleJoinTeam
  , handleLeaveTeam
  , handleUpdateTeam
  , buildTeamState
  , moveCurrentTeamLeft
  , moveCurrentTeamRight
  , setTeam
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Main ( invalidateCache, hScrollToBeginning, viewportScroll, makeVisible )
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import           Data.Time.Clock ( getCurrentTime )
import qualified Data.HashMap.Strict as HM
import           Lens.Micro.Platform ( (%=), (.=), at )

import           Network.Mattermost.Lenses ( userIdL )
import           Network.Mattermost.Types ( TeamId, Team, User, userId
                                          , getId, channelId, teamId, UserParam(..)
                                          , teamOrderPref
                                          )
import qualified Network.Mattermost.Endpoints as MM

import           Matterhorn.Types
import           Matterhorn.LastRunState
import           Matterhorn.State.Async
import           Matterhorn.State.ChannelList
import           Matterhorn.State.Channels
import           Matterhorn.State.Messages
import           Matterhorn.State.Setup.Threads ( maybeStartSpellChecker )
import qualified Matterhorn.Zipper as Z


-- | Move right in the channel list to select the next team.
nextTeam :: MH ()
nextTeam = setTeamFocusWith Z.right

-- | Move left in the channel list to select the previous team.
prevTeam :: MH ()
prevTeam = setTeamFocusWith Z.left

-- | Set the current team directly
setTeam :: TeamId -> MH ()
setTeam tId = setTeamFocusWith $ Z.findRight (== tId)

-- | Change the selected team with the specified team zipper
-- transformation. This function also takes care of book-keeping
-- necessary during team switching.
setTeamFocusWith :: (Z.Zipper () TeamId -> Z.Zipper () TeamId) -> MH ()
setTeamFocusWith f = do
    -- Before we leave this team to view another one, indicate that
    -- we've viewed the current team's currently-selected channel so
    -- that this team doesn't get left with an unread indicator once we
    -- are looking at the other team. We do this when switching channels
    -- within a team in the same way.
    updateViewed True

    csTeamZipper %= f
    withCurrentTeam postChangeTeamCommon

-- | Book-keeping common to all team selection changes.
postChangeTeamCommon :: TeamId -> MH ()
postChangeTeamCommon tId = do
    updateViewed False
    fetchVisibleIfNeeded tId
    mh $ do
        hScrollToBeginning (viewportScroll TeamList)
        makeVisible $ SelectedChannelListEntry tId

-- | Fetch the specified team and add it to the application state.
--
-- This is called in response to a server event indicating that the
-- current user was added to the team.
handleJoinTeam :: TeamId -> MH ()
handleJoinTeam tId = do
    session <- getSession
    cr <- use csResources
    me <- use csMe
    curTs <- use csTeams
    let myTIds = HM.keys curTs

    when (not $ tId `elem` myTIds) $ do
        mhLog LogGeneral $ T.pack $ "Joining team " <> show tId
        doAsyncWith Normal $ do
            t <- MM.mmGetTeam tId session
            (ts, chans) <- buildTeamState cr me t
            return $ Just $ do
                    addTeamState ts chans
                    updateSidebar $ Just tId
                    updateWindowTitle
                    refreshTeamZipper

-- | Remove the specified team to the application state.
--
-- This is called in response to a server event indicating that the
-- current user was removed from the team.
handleLeaveTeam :: TeamId -> MH ()
handleLeaveTeam tId =
    doAsyncWith Normal $ return $ Just $ do
        mhLog LogGeneral $ T.pack $ "Leaving team " <> show tId
        removeTeam tId
        updateWindowTitle
        -- Invalidating the cache here expunges any cached message
        -- renderings from the team we are leaving.
        mh invalidateCache

-- | Fetch the specified team's metadata and update it in the
-- application state.
--
-- This is called in response to a server event indicating that the
-- specified team was updated in some way.
handleUpdateTeam :: TeamId -> MH ()
handleUpdateTeam tId = do
    session <- getSession
    mhLog LogGeneral $ T.pack $ "Updating team " <> show tId
    doAsyncWith Normal $ do
        t <- MM.mmGetTeam tId session
        return $ Just $ do
            updateTeam t
            -- Invalidate the cache since we happen to know that the
            -- team name is in the cached sidebar.
            mh invalidateCache

-- | Set the team zipper ordering with the specified transformation,
-- which is expected to be either 'moveLeft' or 'moveRight'.
setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH ()
setTeamOrderWith transform = do
    session <- getSession
    me <- use csMe

    mtId <- use csCurrentTeamId
    z <- use csTeamZipper
    let tIds = teamZipperIds z
        newList = maybe tIds (\tId -> transform tId tIds) mtId

    doAsyncWith Normal $ do
        let pref = teamOrderPref (me^.userIdL) newList
        MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
        return Nothing

-- | Move the selected team left in the team list.
moveCurrentTeamLeft :: MH ()
moveCurrentTeamLeft = setTeamOrderWith moveLeft

-- | Move the selected team right in the team list.
moveCurrentTeamRight :: MH ()
moveCurrentTeamRight = setTeamOrderWith moveRight

-- | Build a new 'TeamState' for the specified team.
--
-- This function starts a new spell checker thread for the team's
-- message editor, loads the last-run state for the team (to ensure that
-- the initially-selected channel is honored), and fetches the channel
-- metadata for the team.
--
-- This returns the resulting team state as well as the channels
-- associated with the team. The caller is responsible for adding the
-- channels and the team state to the application state.
buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState cr me team = do
    let tId = teamId team
        session = getResourceSession cr
        config = cr^.crConfiguration

    -- Create a predicate to find the last selected channel by reading
    -- the run state file. If unable to read or decode or validate the
    -- file, this predicate is just `isTownSquare`.
    isLastSelectedChannel <- do
        result <- readLastRunState tId
        case result of
            Right lrs | isValidLastRunState cr me lrs -> return $ \c ->
                 Just (channelId c) == lrs^.lrsSelectedChannelId
            _ -> return isTownSquare

    -- Get all channels, but filter down to just the one we want
    -- to start in. We get all, rather than requesting by name or
    -- ID, because we don't know whether the server will give us a
    -- last-viewed preference. We first try to find a channel matching
    -- with the last selected channel ID, failing which we look for the
    -- Town Square channel by name.
    userChans <- MM.mmGetChannelsForUser UserMe tId session
    let lastSelectedChans = Seq.filter isLastSelectedChannel userChans
        chans = if Seq.null lastSelectedChans
                  then Seq.filter isTownSquare userChans
                  else lastSelectedChans

    -- Since the only channel we are dealing with is by construction the
    -- last channel, we don't have to consider other cases here:
    chanPairs <- forM (toList chans) $ \c -> do
        cChannel <- makeClientChannel (userId me) c
        return (getId c, cChannel)

    -- Start the spell checker and spell check timer, if configured
    spResult <- maybeStartSpellChecker tId config (cr^.crEventQueue)

    now <- getCurrentTime
    let chanIds = mkChannelZipperList (config^.configChannelListSortingL) now config tId
                                          Nothing (cr^.crUserPreferences)
                                          mempty clientChans noUsers
        chanZip = Z.fromList chanIds
        clientChans = foldr (uncurry addChannel) noChannels chanPairs

    return (newTeamState config team chanZip spResult, clientChans)

-- | Add a new 'TeamState' and corresponding channels to the application
-- state.
addTeamState :: TeamState -> ClientChannels -> MH ()
addTeamState ts chans = do
    let tId = teamId $ _tsTeam ts
    csTeams.at tId .= Just ts
    csChannels %= (chans <>)

-- | Update the specified team metadata in the application state (only
-- if we are already a member of that team).
updateTeam :: Team -> MH ()
updateTeam t = do
    let tId = teamId t
    ts <- use csTeams
    when (tId `elem` HM.keys ts) $ do
        csTeam(tId).tsTeam .= t

-- | Remove the specified team from the application state.
removeTeam :: TeamId -> MH ()
removeTeam tId = do
    csTeams.at tId .= Nothing
    setTeamFocusWith $ Z.filterZipper (/= tId)