content: module Matterhorn.State.ChannelList
    ( updateSidebar
    , updateWindowTitle
    , toggleChannelListVisibility
    , showChannelInSidebar
    )
  where
  
  import           Prelude ()
  import           Matterhorn.Prelude
  
  import           Brick.Main ( getVtyHandle, invalidateCache, invalidateCacheEntry )
  import qualified Data.HashMap.Strict as HM
  import qualified Data.Sequence as Seq
  import           Data.Time.Clock ( getCurrentTime )
  import           Data.Maybe ( fromJust )
  import qualified Graphics.Vty as Vty
  import           Lens.Micro.Platform
  
  import           Network.Mattermost.Types
  import           Network.Mattermost.Lenses
  import qualified Network.Mattermost.Endpoints as MM
  
  import {-# SOURCE #-} Matterhorn.State.Messages ( fetchVisibleIfNeeded )
  import           Matterhorn.Types
  import           Matterhorn.State.Async
  import qualified Matterhorn.Zipper as Z
  
  
  -- | Update the sidebar for the specified team state only, or all team
  -- states if not given a specific team ID.
  --
  -- In either case, schedule user status fetches for all users mentioned
  -- in the current team's sidebar. (This should be safe because all
  -- sidebars should contain the same user list.)
  updateSidebar :: Maybe TeamId -> MH ()
  updateSidebar mTid = do
      case mTid of
          Nothing -> do
              ts <- use csTeams
              forM_ (HM.keys ts) updateTeamSidebar
          Just tId -> do
              updateTeamSidebar tId
  
      -- Schedule the current team's sidebar for user status updates at
      -- the end of this MH action. This is okay because all team sidebars
      -- should include the same set of DM channels.
      withCurrentTeam $ \tId -> do
          z <- use (csTeam(tId).tsFocus)
          myId <- gets myUserId
          scheduleUserStatusFetches $ myId : userIdsFromZipper z
  
      updateWindowTitle
  
      -- Also refresh the team zipper since a sidebar update due to a new
      -- message arrival could cause the team ordering to change if the
      -- team ordering is set to show unread teams first.
      refreshTeamZipper
  
  updateWindowTitle :: MH ()
  updateWindowTitle = do
      -- Update the window title based on the unread status of the
      -- channels in all teams.
      ts <- use csTeams
      unreadCounts <- forM (HM.keys ts) $ \tId -> do
          z <- use (csTeam(tId).tsFocus)
          return $ sum $ (channelListGroupUnread . fst) <$> Z.toList z
  
      let title = "matterhorn" <> if unread > 0 then "(" <> show unread <> ")" else ""
          unread = sum unreadCounts
  
      vty <- mh getVtyHandle
      liftIO $ Vty.setWindowTitle vty title
  
  updateTeamSidebar :: TeamId -> MH ()
  updateTeamSidebar tId = do
      -- Invalidate the cached sidebar rendering since we are about to
      -- change the underlying state
      mh $ invalidateCacheEntry $ ChannelSidebar tId
  
      -- Get the currently-focused channel ID so we can compare after the
      -- zipper is rebuilt
      cconfig <- use csClientConfig
      oldCid <- use (csCurrentChannelId tId)
  
      -- Update the zipper
      cs <- use csChannels
      sorting <- use (csTeam(tId).tsChannelListSorting)
      us <- getUsers
      prefs <- use (csResources.crUserPreferences)
      hidden <- use csHiddenChannelGroups
      now <- liftIO getCurrentTime
      config <- use (csResources.crConfiguration)
  
      let zl = mkChannelZipperList sorting now config tId cconfig prefs hidden cs us
          compareEntries mOld new = (channelListEntryChannelId <$> mOld) == Just (channelListEntryChannelId new)
      csTeam(tId).tsFocus %= Z.updateListBy compareEntries zl
  
      -- If the zipper rebuild caused the current channel to change, such
      -- as when the previously-focused channel was removed, we need to
      -- call fetchVisibleIfNeeded on the newly-focused channel to ensure
      -- that it gets loaded.
      newCid <- use (csCurrentChannelId tId)
      when (newCid /= oldCid) $
          fetchVisibleIfNeeded tId
  
  toggleChannelListVisibility :: MH ()
  toggleChannelListVisibility = do
      mh invalidateCache
      csResources.crConfiguration.configShowChannelListL %= not
  
  showChannelInSidebar :: ChannelId -> Bool -> MH ()
  showChannelInSidebar cId setPending = do
      mChan <- preuse $ csChannel cId
      me <- gets myUser
      prefs <- use (csResources.crUserPreferences)
      session <- getSession
  
      case mChan of
          Nothing ->
            -- The requested channel doesn't actually exist yet, so no
            -- action can be taken.  It's likely that this is a
            -- pendingChannel situation and not all of the operations to
            -- locally define the channel have completed, in which case
            -- this code will be re-entered later and the mChan will be
            -- known.
            return ()
          Just ch -> do
  
              -- Able to successfully switch to a known channel.  This
              -- should clear any pending channel intention.  If the
              -- intention was for this channel, then: done.  If the
              -- intention was for a different channel, reaching this
              -- point means that the pending is still outstanding but
              -- that the user identified a new channel which *was*
              -- displayable, and the UI should always prefer to SATISFY
              -- the user's latest request over any pending/background
              -- task.
              now <- liftIO getCurrentTime
              csChannel(cId).ccInfo.cdSidebarShowOverride .= Just now
              updateSidebar (ch^.ccInfo.cdTeamId)
  
              case ch^.ccInfo.cdType of
                  Direct -> do
                      let uId = fromJust $ ch^.ccInfo.cdDMUserId
                      case dmChannelShowPreference prefs uId of
                          Just False -> do
                              let pref = showDirectChannelPref (me^.userIdL) uId True
                              when setPending $
                                  withCurrentTeam $ \tId ->
                                      csTeam(tId).tsPendingChannelChange .=
                                          Just (ChangeByChannelId tId (ch^.ccInfo.cdChannelId) Nothing)
                              doAsyncWith Preempt $ do
                                  MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
                                  return Nothing
                          _ -> return ()
  
                  Group ->
                      case groupChannelShowPreference prefs cId of
                          Just False -> do
                              let pref = showGroupChannelPref cId (me^.userIdL)
                              when setPending $
                                  withCurrentTeam $ \tId ->
                                      csTeam(tId).tsPendingChannelChange .=
                                          Just (ChangeByChannelId tId (ch^.ccInfo.cdChannelId) Nothing)
                              doAsyncWith Preempt $ do
                                  MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session
                                  return Nothing
                          _ -> return ()
  
                  _ -> return ()
  