matterhorn 50200.19.0 → 90000.0.0

raw patch · 23 files changed

+233/−67 lines, 23 filesdep +crypton-connectiondep +unix-compatdep +vty-crossplatformdep −connectiondep −unixdep ~brickdep ~mattermost-apidep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: crypton-connection, unix-compat, vty-crossplatform

Dependencies removed: connection, unix

Dependency ranges changed: brick, mattermost-api, text, transformers, vector, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−0
• docs/commands.md +1/−0
• matterhorn.cabal +10/−9
• src/Matterhorn/App.hs +6/−8
• src/Matterhorn/Command.hs +7/−0
• src/Matterhorn/Config.hs +10/−2
• src/Matterhorn/Constants.hs +10/−0
• src/Matterhorn/Draw/Autocomplete.hs +2/−2
• src/Matterhorn/Draw/ChannelList.hs +34/−8
• src/Matterhorn/Draw/Main.hs +2/−3
• src/Matterhorn/Events.hs +11/−5
• src/Matterhorn/Events/Websocket.hs +7/−1
• src/Matterhorn/InputHistory.hs +2/−2
• src/Matterhorn/LastRunState.hs +2/−2
• src/Matterhorn/Login.hs +1/−1
• src/Matterhorn/State/Channels.hs +2/−3
• src/Matterhorn/State/Messages.hs +33/−1
• src/Matterhorn/State/Setup.hs +2/−0
• src/Matterhorn/State/Teams.hs +13/−5
• src/Matterhorn/State/Teams.hs-boot +2/−2
• src/Matterhorn/State/ThemeListWindow.hs +1/−0
• src/Matterhorn/Types.hs +30/−13
• src/Matterhorn/Types/Channels.hs +18/−0

@@ -1,4 +1,31 @@ +90000.0.0+=========++NOTE: this version of Matterhorn requires server version 9.0 or greater.++Package changes:+* Updated to use Vty 6 for crossplatform terminal support, meaning+  Matterhorn can now be built and run on Windows terminals. Please let+  us know if you try this and encounter any issues!++Enhancements:+* Added support for a new "auto" mode to determine channel list width.+  There is now a new `auto` value for the `channelListWidth`+  configuration file setting. Its default is unchanged and it can still+  take an integer value specifying the channel list width in columns.+  If set to `auto`, its value is determined by Matterhorn, bounded by+  minimum and maximum values, as a function of window width. This is+  intended to give nicer results as font size decreases, up to a point.+* Add a `/write-theme` command to write the current theme to an INI+  file.++Bug fixes:+* Updated channel viewing book-keeping to work with changes in+  Mattermost 9.0.+* Fixed an issue where terminal input provided right before the UI is+  initialized could cause the application to crash.+ 50200.19.0 ========== 

@@ -58,3 +58,4 @@ | `/topic <topic>` | Set the current channel's topic (header) | | `/user` | Show users to initiate a private DM chat channel | | `/username-attribute <@user>` | Display the attribute used to color the specified username |+| `/write-theme <path>` | Write the current theme to a theme settings file |

@@ -1,5 +1,5 @@ name:                matterhorn-version:             50200.19.0+version:             90000.0.0 synopsis:            Terminal client for the Mattermost chat system description:         This is a terminal client for the Mattermost chat                      system. Please see the README for a list of@@ -170,31 +170,32 @@     ghc-options: -fhide-source-paths    build-depends:       base                 >=4.8      && <5-                     , mattermost-api       == 50200.15.0+                     , mattermost-api       == 90000.0.0                      , base-compat          >= 0.9     && < 0.13                      , unordered-containers >= 0.2     && < 0.3                      , containers           >= 0.5.7   && < 0.7                      , split                >= 0.2     && < 0.3                      , data-clist           >= 0.1.2   && < 0.2                      , semigroups           >= 0.18    && < 0.20-                     , connection           >= 0.2     && < 0.4-                     , text                 >= 1.2.5.0 && < 2.0+                     , crypton-connection   >= 0.3.1   && < 0.4+                     , text                 >= 1.2.5.0 && < 2.1                      , bytestring           >= 0.10    && < 0.12                      , stm                  >= 2.4     && < 2.6                      , config-ini           >= 0.2.2.0 && < 0.3                      , process              >= 1.4     && < 1.7                      , microlens-platform   >= 0.3     && < 0.5-                     , brick                >= 1.8     && < 1.9+                     , brick                >= 2.0     && < 2.1                      , brick-skylighting    >= 1.0     && < 1.1-                     , vty                  >= 5.38    && < 5.39+                     , vty                  >= 6.0     && < 6.1+                     , vty-crossplatform    >= 0.2.0.0 && < 0.3.0.0                      , word-wrap            >= 0.4.0   && < 0.5-                     , transformers         >= 0.4     && < 0.6+                     , transformers         >= 0.4     && < 0.7                      , text-zipper          >= 0.13    && < 0.14                      , time                 >= 1.6     && < 2.0                      , xdg-basedir          >= 0.2     && < 0.3                      , filepath             >= 1.4     && < 1.5                      , directory            >= 1.3     && < 1.4-                     , vector               < 0.13+                     , vector               < 0.14                      , strict               >= 0.3     && < 0.6                      , hashable             >= 1.2     && < 1.5                      , commonmark           >= 0.2.1   && < 0.3@@ -207,7 +208,7 @@                      , mtl                  >= 2.2     && < 2.4                      , aspell-pipe          >= 0.6     && < 0.7                      , stm-delay            >= 0.1     && < 0.2-                     , unix                 >= 2.7.1.0 && < 2.9+                     , unix-compat          >= 0.6     && < 0.8                      , skylighting-core     >= 0.12    && < 0.13                      , timezone-olson       >= 0.2     && < 0.3                      , timezone-series      >= 0.1.6.1 && < 0.2

@@ -10,9 +10,9 @@ import           Brick import           Control.Monad.Trans.Except ( runExceptT ) import qualified Graphics.Vty as Vty+import qualified Graphics.Vty.CrossPlatform as Vty import           Text.Aspell ( stopAspell ) import           GHC.Conc (getNumProcessors, setNumCapabilities)-import           System.Posix.IO ( stdInput )  import           Network.Mattermost @@ -32,11 +32,14 @@ app =     App { appDraw         = draw         , appHandleEvent  = Events.onEvent-        , appStartEvent   = return ()         , appAttrMap      = (^.csResources.crTheme)         , appChooseCursor = \s cs -> do             tId <- s^.csCurrentTeamId             cursorByMode cs s tId (teamMode $ s^.csTeam(tId))+        , appStartEvent = do+            vty <- getVtyHandle+            (w, h) <- liftIO $ Vty.displayBounds $ Vty.outputIface vty+            runMHEvent $ Events.setWindowSize w h         }  cursorByMode :: [CursorLocation Name] -> ChatState -> TeamId -> Mode -> Maybe (CursorLocation Name)@@ -84,12 +87,7 @@     setupCpuUsage config      let mkVty = do-          mEraseChar <- Vty.getTtyEraseChar stdInput-          let addEraseChar cfg = case mEraseChar of-                  Nothing -> cfg-                  Just ch -> cfg { Vty.inputMap = (Nothing, [ch], Vty.EvKey Vty.KBS []) : Vty.inputMap cfg }--          vty <- Vty.mkVty $ addEraseChar Vty.defaultConfig+          vty <- Vty.mkVty Vty.defaultConfig           let output = Vty.outputIface vty           Vty.setMode output Vty.BracketedPaste True           Vty.setMode output Vty.Hyperlink $ configHyperlinkingMode config

@@ -12,6 +12,7 @@ import           Matterhorn.Prelude  import           Brick.Main ( invalidateCache )+import           Brick.Themes ( saveTheme ) import qualified Control.Exception as Exn import qualified Data.Char as Char import qualified Data.Text as T@@ -132,6 +133,12 @@   , Cmd "members" "Show the current channel's members"     NoArg $ \ () -> do         withCurrentTeam enterChannelMembersUserList++  , Cmd "write-theme" "Write the current theme to a theme settings file"+    (TokenArg "path" NoArg) $ \(path, ()) -> do+        theme <- use (csResources.crThemeOriginal)+        liftIO $ saveTheme (T.unpack path) theme+        postInfoMessage $ "Current theme written to " <> path    , Cmd "leave" "Leave a normal channel or hide a DM channel" NoArg $ \ () -> do         withCurrentTeam startLeaveCurrentChannel

@@ -80,7 +80,7 @@     configTeam           <- fieldMbOf "team" stringField     configPort           <- fieldDefOf "port" number (configPort defaultConfig)     configUrlPath        <- fieldMbOf "urlPath" stringField-    configChannelListWidth <- fieldDefOf "channelListWidth" number+    configChannelListWidth <- fieldDefOf "channelListWidth" channelListWidthField                               (configChannelListWidth defaultConfig)     configCpuUsagePolicy <- fieldDefOf "cpuUsagePolicy" cpuUsagePolicy                             (configCpuUsagePolicy defaultConfig)@@ -260,6 +260,14 @@     , (MoveCurrentTeamRightEvent        , [ ])     ] +channelListWidthField :: Text -> Either String ChannelListWidth+channelListWidthField t =+    case T.toLower t of+        "auto" -> return ChannelListWidthAuto+        _ -> case readMaybe (T.unpack t) of+            Nothing -> Left "Invalid value for channelListWidth"+            Just w  -> Right $ ChannelListWidthFixed w+ channelListOrientationField :: Text -> Either String ChannelListOrientation channelListOrientationField t =     case T.toLower t of@@ -416,7 +424,7 @@            , configAspellDictionary            = Nothing            , configUnsafeUseHTTP               = False            , configValidateServerCertificate   = True-           , configChannelListWidth            = 22+           , configChannelListWidth            = ChannelListWidthFixed 22            , configLogMaxBufferSize            = 200            , configShowOlderEdits              = True            , configUserKeys                    = newKeyConfig allEvents [] []

@@ -8,6 +8,8 @@   , userSigil   , userSigilChar   , editMarking+  , channelListMinAutoWidth+  , channelListMaxAutoWidth   ) where @@ -16,6 +18,14 @@  import qualified Data.Text as T ++-- | The minimum channel list width when the width is set to 'auto'.+channelListMinAutoWidth :: Int+channelListMinAutoWidth = 24++-- | The maximum channel list width when the width is set to 'auto'.+channelListMaxAutoWidth :: Int+channelListMaxAutoWidth = 44  -- | The number of rows to consider a "page" when scrolling pageAmount :: Int

@@ -18,6 +18,7 @@ import           Network.Mattermost.Types ( User(..), Channel(..), TeamId )  import           Matterhorn.Constants ( normalChannelSigil )+import           Matterhorn.Draw.ChannelList ( channelListWidth ) import           Matterhorn.Draw.Util ( mkChannelName ) import           Matterhorn.Themes import           Matterhorn.Types@@ -93,10 +94,9 @@         curUser = myUsername st         cfg = st^.csResources.crConfiguration         showingChanList = configShowChannelList cfg-        chanListWidth = configChannelListWidth cfg         maybeLimit = fromMaybe id $ do             let sub = if showingChanList-                      then chanListWidth + 1+                      then channelListWidth st + 1                       else 0                 threadNarrow = threadShowing && (cfg^.configThreadOrientationL `elem` [ThreadLeft, ThreadRight])                 threadShowing = isJust $ st^.csTeam(tId).tsThreadInterface

@@ -16,7 +16,12 @@ --     channels matching the entered text (and highlighting the --     matching portion). -module Matterhorn.Draw.ChannelList (renderChannelList, renderChannelListHeader) where+module Matterhorn.Draw.ChannelList+  ( renderChannelList+  , renderChannelListHeader+  , channelListWidth+  )+where  import           Prelude () import           Matterhorn.Prelude@@ -34,6 +39,7 @@  import           Matterhorn.Draw.Util import           Matterhorn.State.Channels+import           Matterhorn.Constants ( channelListMinAutoWidth, channelListMaxAutoWidth ) import           Matterhorn.Themes import           Matterhorn.Types import           Matterhorn.Types.Common ( sanitizeUserText )@@ -54,10 +60,17 @@                          , entryUserStatus  :: Maybe UserStatus                          } -sbRenderer :: ScrollbarRenderer n+sbRenderer :: VScrollbarRenderer n sbRenderer =-    verticalScrollbarRenderer { renderScrollbarHandleBefore = str "▲"-                              , renderScrollbarHandleAfter = str "▼"+    verticalScrollbarRenderer { renderVScrollbarHandleBefore = str "▲"+                              , renderVScrollbarHandleAfter = str "▼"+                              , scrollbarWidthAllocation = 2+                              , renderVScrollbar =+                                  hLimit 1 $+                                  renderVScrollbar verticalScrollbarRenderer+                              , renderVScrollbarTrough =+                                  hLimit 1 $+                                  renderVScrollbarTrough verticalScrollbarRenderer                               }  renderChannelListHeader :: ChatState -> MM.TeamId -> Widget Name@@ -84,9 +97,9 @@ renderChannelList st tId =     header <=> vpBody     where-        (sbOrientation, sbPad) = case st^.csResources.crConfiguration.configChannelListOrientationL of-            ChannelListLeft -> (OnLeft, padLeft (Pad 1))-            ChannelListRight -> (OnRight, padRight (Pad 1))+        sbOrientation = case st^.csResources.crConfiguration.configChannelListOrientationL of+            ChannelListLeft -> OnLeft+            ChannelListRight -> OnRight         myUsername_ = myUsername st         channelName e = ClickableChannelListEntry $ channelListEntryChannelId e         renderEntry s e = clickable (channelName e) $@@ -96,7 +109,7 @@                  withVScrollBars sbOrientation $                  withVScrollBarHandles $                  withClickableVScrollBars VScrollBar $-                 viewport (ChannelListViewport tId) Vertical $ sbPad body+                 viewport (ChannelListViewport tId) Vertical body         body = case teamMode $ st^.csTeam(tId) of             ChannelSelect ->                 let zipper = st^.csTeam(tId).tsChannelSelectState.channelSelectMatches@@ -269,3 +282,16 @@  returnChannelSigil :: String returnChannelSigil = "~"++channelListWidthAutoPercent :: Double+channelListWidthAutoPercent = 0.2++channelListWidth :: ChatState -> Int+channelListWidth st =+    case configChannelListWidth $ st^.csResources.crConfiguration of+        ChannelListWidthFixed w -> w+        ChannelListWidthAuto ->+            let calcWidth = round $ channelListWidthAutoPercent * (fromIntegral width :: Double)+                width = fst $ st^.csResources.crWindowSize+            in min channelListMaxAutoWidth $+               max channelListMinAutoWidth calcWidth

@@ -20,7 +20,7 @@                                           )  -import           Matterhorn.Draw.ChannelList ( renderChannelList )+import           Matterhorn.Draw.ChannelList ( renderChannelList, channelListWidth ) import           Matterhorn.Draw.Messages import           Matterhorn.Draw.MessageInterface import           Matterhorn.Draw.Autocomplete@@ -76,10 +76,9 @@     mainDisplay = maybeSubdue messageInterface      channelList = channelListMaybeVlimit mode $-                  hLimit channelListWidth $ case mtId of+                  hLimit (channelListWidth st) $ case mtId of                       Nothing -> fill ' '                       Just tId -> renderChannelList st tId-    channelListWidth = configChannelListWidth $ st^.csResources.crConfiguration     channelListMaybeVlimit ChannelSelect w =         Widget (hSize w) (vSize w) $ do             ctx <- getContext

@@ -1,5 +1,6 @@ module Matterhorn.Events   ( onEvent+  , setWindowSize   ) where @@ -194,20 +195,25 @@                     ]  handleResizeEvent :: Vty.Event -> MH Bool-handleResizeEvent (Vty.EvResize _ _) = do+handleResizeEvent (Vty.EvResize w h) = do+    setWindowSize w h+    return True+handleResizeEvent _ =+    return False++setWindowSize :: Int -> Int -> MH ()+setWindowSize w h = do     -- On resize, invalidate the entire rendering cache since many     -- things depend on the window size.     --     -- Note: we fall through after this because it is sometimes     -- important for modes to have their own additional logic to run     -- when a resize occurs, so we don't want to stop processing here.+    csResources.crWindowSize .= (w, h)+     mh invalidateCache     withCurrentTeam $ \tId ->         mh $ makeVisible $ SelectedChannelListEntry tId--    return True-handleResizeEvent _ =-    return False  handleTeamModeEvent :: Vty.Event -> MH Bool handleTeamModeEvent e = do

@@ -166,8 +166,14 @@             | otherwise -> return ()          WMChannelViewed-            | Just cId <- wepChannelId $ weData we -> refreshChannelById cId+            | Just cId <- wepChannelId $ weData we -> mhLog LogGeneral "WMChannelViewed received" >> refreshChannelById cId             | otherwise -> return ()++        WMMultipleChannelsViewed ->+            case wepChannelTimes $ weData we of+                Nothing -> return ()+                Just m ->+                    forM_ (HM.keys m) refreshChannelById          WMChannelUpdated             | Just cId <- webChannelId $ weBroadcast we -> do

@@ -20,8 +20,8 @@ import           System.Directory ( createDirectoryIfMissing ) import           System.FilePath ( dropFileName ) import qualified System.IO.Strict as S-import qualified System.Posix.Files as P-import qualified System.Posix.Types as P+import qualified System.PosixCompat.Files as P+import qualified System.PosixCompat.Types as P  import           Network.Mattermost.Types ( ChannelId ) 

@@ -23,8 +23,8 @@ import           Lens.Micro.Platform ( makeLenses ) import           System.Directory ( createDirectoryIfMissing ) import           System.FilePath ( dropFileName )-import qualified System.Posix.Files as P-import qualified System.Posix.Types as P+import qualified System.PosixCompat.Files as P+import qualified System.PosixCompat.Types as P  import           Network.Mattermost.Lenses import           Network.Mattermost.Types

@@ -69,7 +69,7 @@ import           Data.List (tails, inits) import           System.IO.Error ( catchIOError ) import qualified Data.Text as T-import           Graphics.Vty hiding (mkVty)+import           Graphics.Vty import           Lens.Micro.Platform ( (.~), (.=), Lens', makeLenses ) import qualified System.IO.Error as Err import           Network.URI ( URI(..), URIAuth(..), parseURI )

@@ -334,7 +334,7 @@              -- Create a new ClientChannel structure             cChannel <- (ccInfo %~ channelInfoFromChannelWithData nc member) <$>-                       makeClientChannel eventQueue spellChecker (me^.userIdL) (channelTeamId nc) nc+                       makeClientChannel eventQueue spellChecker (me^.userIdL) (channelTeamId nc) nc member              st <- use id @@ -506,8 +506,6 @@  postChangeChannelCommon :: TeamId -> MH () postChangeChannelCommon tId = do-    -- resetEditorState cId-    -- loadLastEdit tId     fetchVisibleIfNeeded tId  loadLastChannelInput :: Lens' ChatState (MessageInterface n i) -> MH ()@@ -524,6 +522,7 @@ preChangeChannelCommon tId = do     withCurrentChannel tId $ \cId _ -> do         csTeam(tId).tsRecentChannel .= Just cId+        csChannel(cId) %= clearEditedThreshold  saveEditorInput :: Lens' ChatState (MessageInterface n i) -> MH () saveEditorInput which = do

@@ -34,7 +34,7 @@ import qualified Data.Sequence as Seq import qualified Data.Text as T import           Graphics.Vty ( outputIface )-import           Graphics.Vty.Output.Interface ( ringTerminalBell )+import           Graphics.Vty.Output ( ringTerminalBell ) import           Lens.Micro.Platform ( Traversal', (.=), (%=), (%~), (.~)                                      , to, at, traversed, filtered, ix, _1, _Just ) @@ -45,6 +45,7 @@  import           Matterhorn.Constants import           Matterhorn.State.Channels+import           Matterhorn.State.ChannelList ( updateSidebar ) import           Matterhorn.State.Common import           Matterhorn.State.ThreadWindow import           Matterhorn.State.MessageSelect@@ -579,6 +580,34 @@                   not (userPrefs^.userPrefShowJoinLeave) && isJoinOrLeave                 cId = postChannelId new +                -- TODO: match server-side logic to determine whether+                -- this message counts as a post, for post-counting+                -- purposes, to decide whether this should trigger an+                -- increment of the total/viewed post counts+                maybeIncrementTotalMessageCount =+                    let shouldIncrement = case newPostData of+                                              RecentPost {} ->+                                                  True+                                              _ ->+                                                  False+                    in if shouldIncrement+                       then incrementTotalMessageCount+                       else id++                maybeIncrementViewedMessageCount currCId =+                    let shouldIncrement = case newPostData of+                                              RecentPost {} ->+                                                  currCId == Just cId+                                              _ ->+                                                  False+                    in if shouldIncrement+                       then incrementViewedMessageCount+                       else id++                maybeIncrementMessageCounts currCId =+                    maybeIncrementTotalMessageCount .+                    maybeIncrementViewedMessageCount currCId+                 doAddMessage = do                     -- Do we have the user data for the post author?                     case cp^.cpUser of@@ -606,6 +635,7 @@                     csChannels %= modifyChannelById cId                       ((ccMessageInterface.miMessages %~ addMessage msg') .                        (if not ignoredJoinLeaveMessage then adjustUpdated new else id) .+                       maybeIncrementMessageCounts currCId .                        (\c -> if currCId == Just cId                               then c                               else case newPostData of@@ -627,6 +657,8 @@                     -- channel, the currently-selected team (mcurTId)                     -- since all DM channels appear in all teams.                     addPostToOpenThread (mTId <|> mcurTId) new msg'++                    updateSidebar mTId                      postedChanMessage 

@@ -161,6 +161,7 @@                            , _crSubprocessLog       = slc                            , _crWebsocketActionChan = wac                            , _crTheme               = themeToAttrMap custTheme+                           , _crThemeOriginal       = custTheme                            , _crStatusUpdateChan    = userStatusChan                            , _crConfiguration       = config                            , _crFlaggedPosts        = mempty@@ -169,6 +170,7 @@                            , _crLogManager          = logMgr                            , _crEmoji               = emoji                            , _crSpellChecker        = spResult+                           , _crWindowSize          = (0, 0)                            }      st <- initializeState cr initialTeamId teams me

@@ -43,6 +43,10 @@                                           , teamOrderPref, Post, ChannelId, postId                                           , emptyChannelNotifyProps, UserId                                           , channelName, Type(..), channelDisplayName+                                          , Channel, ChannelMember+                                          , channelMemberMsgCount+                                          , channelTotalMsgCount+                                          , UserParam(UserById)                                           ) import qualified Network.Mattermost.Endpoints as MM @@ -216,7 +220,8 @@     -- 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 eventQueue (cr^.crSpellChecker) (userId me) (Just tId) c+        m <- MM.mmGetChannelMember (getId c) (UserById $ userId me) session+        cChannel <- makeClientChannel eventQueue (cr^.crSpellChecker) (userId me) (Just tId) c m         return (getId c, cChannel)      now <- getCurrentTime@@ -434,16 +439,17 @@                   -> UserId                   -> Maybe TeamId                   -> Channel+                  -> ChannelMember                   -> m ClientChannel-makeClientChannel eventQueue spellChecker myId tId nc = do+makeClientChannel eventQueue spellChecker myId tId nc member = do     msgs <- emptyChannelMessages     mi <- liftIO $ newChannelMessageInterface spellChecker eventQueue tId (getId nc) msgs-    return ClientChannel { _ccInfo = initialChannelInfo myId nc+    return ClientChannel { _ccInfo = initialChannelInfo myId nc member                          , _ccMessageInterface = mi                          } -initialChannelInfo :: UserId -> Channel -> ChannelInfo-initialChannelInfo myId chan =+initialChannelInfo :: UserId -> Channel -> ChannelMember -> ChannelInfo+initialChannelInfo myId chan member =     let updated  = chan ^. channelLastPostAtL     in ChannelInfo { _cdChannelId              = chan^.channelIdL                    , _cdTeamId                 = chan^.channelTeamIdL@@ -464,4 +470,6 @@                                                  else Nothing                    , _cdSidebarShowOverride    = Nothing                    , _cdFetchPending           = False+                   , _cdTotalMessageCount      = channelTotalMsgCount chan+                   , _cdViewedMessageCount     = channelMemberMsgCount member                    }

@@ -6,9 +6,9 @@ import qualified Brick.BChan as BCH import           Text.Aspell ( Aspell ) -import           Network.Mattermost.Types ( Channel, UserId, TeamId )+import           Network.Mattermost.Types ( Channel, ChannelMember, UserId, TeamId )  import           Matterhorn.Types ( MHEvent ) import           Matterhorn.Types.Channels ( ClientChannel ) -makeClientChannel :: (MonadIO m) => BCH.BChan MHEvent -> Maybe Aspell -> UserId -> Maybe TeamId -> Channel -> m ClientChannel+makeClientChannel :: (MonadIO m) => BCH.BChan MHEvent -> Maybe Aspell -> UserId -> Maybe TeamId -> Channel -> ChannelMember -> m ClientChannel

@@ -85,3 +85,4 @@         Just it -> do             mh invalidateCache             csResources.crTheme .= (themeToAttrMap $ internalTheme it)+            csResources.crThemeOriginal .= internalTheme it

@@ -99,6 +99,7 @@   , unsafeKeyDispatcher   , bindingConflictMessage +  , ChannelListWidth(..)   , NotificationVersion(..)   , PasswordSource(..)   , TokenSource(..)@@ -235,6 +236,7 @@   , crUserPreferences   , crEventQueue   , crTheme+  , crThemeOriginal   , crStatusUpdateChan   , crSubprocessLog   , crWebsocketActionChan@@ -246,6 +248,7 @@   , crSyntaxMap   , crLogManager   , crSpellChecker+  , crWindowSize   , crEmoji   , getSession   , getResourceSession@@ -485,6 +488,14 @@     | TeamListSortUnreadFirst     deriving (Eq, Show, Ord) +data ChannelListWidth =+    ChannelListWidthFixed Int+    -- ^ A fixed width in columns.+    | ChannelListWidthAuto+    -- ^ Automatically determine a reasonable width based on the window+    -- dimensions.+    deriving (Eq, Show, Ord)+ -- | This is how we represent the user's configuration. Most fields -- correspond to configuration file settings (see Config.hs) but some -- are for internal book-keeping purposes only.@@ -549,7 +560,7 @@            -- ^ Whether to permit an insecure HTTP connection.            , configValidateServerCertificate :: Bool            -- ^ Whether to validate TLS certificates.-           , configChannelListWidth :: Int+           , configChannelListWidth :: ChannelListWidth            -- ^ The width, in columns, of the channel list sidebar.            , configLogMaxBufferSize :: Int            -- ^ The maximum size, in log entries, of the internal log@@ -629,14 +640,18 @@                     , _userPrefTeamOrder :: Maybe [TeamId]                     } -hasUnread' :: ClientChannel -> Bool-hasUnread' chan = fromMaybe False $ do+hasUnread :: ClientChannel -> Type -> Bool+hasUnread chan ty =     let info = _ccInfo chan-    lastViewTime <- _cdViewed info-    return $ _cdMentionCount info > 0 ||-             (not (isMuted chan) &&-              (((_cdUpdated info) > lastViewTime) ||-               (isJust $ _cdEditedMessageThreshold info)))+        hasMentions = countMentions && _cdMentionCount info > 0+        hasNewMessages = _cdTotalMessageCount info > _cdViewedMessageCount info+        hasEditThreshold = isJust $ _cdEditedMessageThreshold info+        countMentions = case ty of+            Direct -> False+            Group -> False+            _ -> True+    in hasMentions ||+       (not (isMuted chan) && (hasNewMessages || hasEditThreshold))  mkChannelZipperList :: ChannelListSorting                     -> UTCTime@@ -701,7 +716,7 @@         mkEntry (cId, ch) = ChannelListEntry { channelListEntryChannelId = cId                                              , channelListEntryType = CLChannel                                              , channelListEntryMuted = isMuted ch-                                             , channelListEntryUnread = hasUnread' ch+                                             , channelListEntryUnread = hasUnread ch ty                                              , channelListEntrySortValue = ch^.ccInfo.cdDisplayName.to T.toLower                                              , channelListEntryFavorite = isFavorite prefs cId                                              }@@ -759,7 +774,7 @@     in fmap (\(cId, ch) -> ChannelListEntry { channelListEntryChannelId = cId                                             , channelListEntryType = CLGroupDM                                             , channelListEntryMuted = isMuted ch-                                            , channelListEntryUnread = hasUnread' ch+                                            , channelListEntryUnread = hasUnread ch Group                                             , channelListEntrySortValue = ch^.ccInfo.cdDisplayName                                             , channelListEntryFavorite = isFavorite prefs cId                                             }) $@@ -785,7 +800,7 @@                     then return (ChannelListEntry { channelListEntryChannelId = cId                                                   , channelListEntryType = CLUserDM uId                                                   , channelListEntryMuted = isMuted c-                                                  , channelListEntryUnread = hasUnread' c+                                                  , channelListEntryUnread = hasUnread c Direct                                                   , channelListEntrySortValue = displayNameForUser u cconfig prefs                                                   , channelListEntryFavorite = isFavorite prefs cId                                                   })@@ -815,7 +830,7 @@         cId = c^.ccInfo.cdChannelId     in if isFavorite prefs cId        then True-       else (if hasUnread' c || maybe False (>= localCutoff) (c^.ccInfo.cdSidebarShowOverride)+       else (if hasUnread c Direct || maybe False (>= localCutoff) (c^.ccInfo.cdSidebarShowOverride)              then True              else case dmChannelShowPreference prefs uId of                     Just False -> False@@ -841,7 +856,7 @@         cId = c^.ccInfo.cdChannelId     in if isFavorite prefs cId        then True-       else (if hasUnread' c || maybe False (>= localCutoff) (c^.ccInfo.cdSidebarShowOverride)+       else (if hasUnread c Group || maybe False (>= localCutoff) (c^.ccInfo.cdSidebarShowOverride)              then True              else case groupChannelShowPreference prefs cId of                     Just False -> False@@ -1070,6 +1085,7 @@                   , _crSubprocessLog       :: STM.TChan ProgramOutput                   , _crWebsocketActionChan :: STM.TChan WebsocketAction                   , _crTheme               :: AttrMap+                  , _crThemeOriginal       :: Theme                   , _crStatusUpdateChan    :: STM.TChan [UserId]                   , _crConfiguration       :: Config                   , _crFlaggedPosts        :: Set PostId@@ -1078,6 +1094,7 @@                   , _crLogManager          :: LogManager                   , _crEmoji               :: EmojiCollection                   , _crSpellChecker        :: Maybe Aspell+                  , _crWindowSize          :: (Int, Int)                   }  -- | The 'GlobalEditState' value contains state not specific to any

@@ -19,6 +19,7 @@   , cdName, cdDisplayName, cdHeader, cdPurpose, cdType   , cdMentionCount, cdDMUserId, cdChannelId   , cdSidebarShowOverride, cdNotifyProps, cdTeamId, cdFetchPending+  , cdTotalMessageCount, cdViewedMessageCount   -- * Managing ClientChannel collections   , noChannels, addChannel, removeChannel, findChannelById, modifyChannelById   , channelByIdL, maybeChannelByIdL@@ -33,6 +34,8 @@   , adjustUpdated   , adjustEditedThreshold   , updateNewMessageIndicator+  , incrementTotalMessageCount+  , incrementViewedMessageCount   -- * Notification settings   , notifyPreference   , isMuted@@ -72,6 +75,7 @@                                           , WithDefault(..)                                           , ServerTime                                           , TeamId+                                          , channelTotalMsgCount                                           )  import           Matterhorn.Types.Messages ( Messages, noMessages, addMessage@@ -121,6 +125,8 @@           , _cdPurpose          = (sanitizeUserText $ chan^.channelPurposeL)           , _cdType             = (chan^.channelTypeL)           , _cdMentionCount     = chanMember^.to channelMemberMentionCount+          , _cdTotalMessageCount = channelTotalMsgCount chan+          , _cdViewedMessageCount = chanMember^.to channelMemberMsgCount           , _cdNotifyProps      = chanMember^.to channelMemberNotifyProps           } @@ -174,6 +180,10 @@     -- whether to show the channel.   , _cdFetchPending :: Bool     -- ^ Whether a fetch in this channel is pending+  , _cdTotalMessageCount :: Int+    -- ^ Total message count+  , _cdViewedMessageCount :: Int+    -- ^ Viewed message count, for tracking unread status   }  -- ** Channel-related Lenses@@ -328,6 +338,14 @@  maxPostTimestamp :: Post -> ServerTime maxPostTimestamp m = max (m^.postDeleteAtL . non (m^.postUpdateAtL)) (m^.postCreateAtL)++incrementTotalMessageCount :: ClientChannel -> ClientChannel+incrementTotalMessageCount =+    ccInfo.cdTotalMessageCount %~ succ++incrementViewedMessageCount :: ClientChannel -> ClientChannel+incrementViewedMessageCount =+    ccInfo.cdViewedMessageCount %~ succ  updateNewMessageIndicator :: Post -> ClientChannel -> ClientChannel updateNewMessageIndicator m =