diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,33 @@ +90000.1.0 +========= + +Enhancements: +* Matterhorn now provides an additional configuration file for + specifying Unicode character widths to allow users to configure + Matterhorn to avoid layout problems due to wide characters. See the + Matterhorn User Guide for details. +* Channel selection case-handling behavior is now configurable. (#840) + This change adds a new configuration setting, `channelSelectCaseInsensitive`. + This new setting is used to control channel selection input handling: + * When the setting is `False` (the default), the behavior is as before + this change: lowercase input was matched on channel names + case-insensitively and input containing any uppercase characters + resulted in a case-insensitive match. + * When the setting is `True`, channel names are matched + case-insensitively regardless of case in the input, i.e., as if the + input was all lowercase. +* Improved the layout of block quotes and bullet lists in messages. +* Messages with attachments but no text may now be sent. (#773) +* The message view window now has an Author tab with information about + the message author. (#833) + +Bug fixes: +* Matterhorn will no longer crash when its internal event queue is full + (e.g. due to pathological system conditions). (#835) +* The `notifyV2` script now has proper JSON quoting. (#836) +* Network errors due to closed sockets are now silenced. (#837) + 90000.0.1 ========= diff --git a/matterhorn.cabal b/matterhorn.cabal --- a/matterhorn.cabal +++ b/matterhorn.cabal @@ -1,5 +1,5 @@ name: matterhorn -version: 90000.0.1 +version: 90000.1.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 @@ -184,9 +184,9 @@ , config-ini >= 0.2.2.0 && < 0.3 , process >= 1.4 && < 1.7 , microlens-platform >= 0.3 && < 0.5 - , brick >= 2.4 && < 2.5 + , brick >= 2.8.3 && < 2.9 , brick-skylighting >= 1.0 && < 1.1 - , vty >= 6.0 && < 6.3 + , vty >= 6.4 && < 6.5 , vty-crossplatform >= 0.2.0.0 && < 0.5.0.0 , word-wrap >= 0.4.0 && < 0.5 , transformers >= 0.4 && < 0.7 diff --git a/programs/Main.hs b/programs/Main.hs --- a/programs/Main.hs +++ b/programs/Main.hs @@ -19,15 +19,15 @@ main = do opts <- grabOptions - configResult <- if optIgnoreConfig opts - then return $ Right defaultConfig - else fmap snd <$> findConfig (optConfLocation opts) + configResult <- findConfig $ if optIgnoreConfig opts + then Nothing + else optConfLocation opts config <- case configResult of Left err -> do putStrLn $ "Error loading config: " <> err exitFailure - Right c -> return c + Right (_, c) -> return c let keyConfig = configUserKeys config format = optPrintFormat opts diff --git a/src/Matterhorn/App.hs b/src/Matterhorn/App.hs --- a/src/Matterhorn/App.hs +++ b/src/Matterhorn/App.hs @@ -9,8 +9,10 @@ import Brick import Control.Monad.Trans.Except ( runExceptT ) +import qualified Control.Exception as E import qualified Graphics.Vty as Vty import qualified Graphics.Vty.CrossPlatform as Vty +import qualified Graphics.Vty.UnicodeWidthTable.Install as Vty import Text.Aspell ( stopAspell ) import GHC.Conc (getNumProcessors, setNumCapabilities) @@ -82,9 +84,20 @@ setNumCapabilities requestedCPUs +setupCharWidthMap :: Config -> IO () +setupCharWidthMap config = do + case configCharacterWidths config of + Nothing -> return () + Just widths -> do + let wMap = buildWidthMap widths + Vty.installUnicodeWidthTable wMap `E.catch` + (\(_::Vty.TableInstallException) -> return ()) + runMatterhorn :: Options -> Config -> IO ChatState runMatterhorn opts config = do setupCpuUsage config + + setupCharWidthMap config let mkVty = do vty <- Vty.mkVty Vty.defaultConfig diff --git a/src/Matterhorn/Config.hs b/src/Matterhorn/Config.hs --- a/src/Matterhorn/Config.hs +++ b/src/Matterhorn/Config.hs @@ -5,7 +5,6 @@ ( Config(..) , PasswordSource(..) , findConfig - , defaultConfig , configConnectionType ) where @@ -16,6 +15,7 @@ import qualified Paths_matterhorn as Paths import Brick.Keybindings +import qualified Control.Exception as E import Control.Monad.Trans.Except import Control.Monad.Trans.Class ( lift ) import Data.Char ( isDigit, isAlpha ) @@ -156,9 +156,12 @@ configDefaultAttachmentPath <- fieldMbOf "defaultAttachmentPath" filePathField configMouseMode <- fieldFlagDef "enableMouseMode" (configMouseMode defaultConfig) + configChannelSelectCaseInsensitive <- fieldFlagDef "channelSelectCaseInsensitive" + (configChannelSelectCaseInsensitive defaultConfig) let configAbsPath = Nothing configUserKeys = newKeyConfig allEvents [] [] + configCharacterWidths = Nothing return Config { .. } defaultBindings :: [(KeyEvent, [Binding])] @@ -441,22 +444,58 @@ , configMouseMode = False , configChannelListSorting = ChannelListSortDefault , configTeamListSorting = TeamListSortDefault + , configChannelSelectCaseInsensitive = False + , configCharacterWidths = Nothing } findConfig :: Maybe FilePath -> IO (Either String ([String], Config)) -findConfig Nothing = runExceptT $ do - cfg <- lift $ locateConfig configFileName - (warns, config) <- - case cfg of +findConfig mPath = runExceptT $ do + -- Load the main configuration + locatedConfig <- lift $ locateConfig configFileName + + (warns, config) <- case mPath <|> locatedConfig of Nothing -> return ([], defaultConfig) - Just path -> getConfig path + Just path -> loadConfig path + config' <- fixupPaths config - return (warns, config') -findConfig (Just path) = - runExceptT $ do (warns, config) <- getConfig path - config' <- fixupPaths config - return (warns, config') + -- If there is a char widths file, load that and add it to the + -- configuration + widthsResult <- liftIO loadCharWidths + + case widthsResult of + Nothing -> + return (warns, config') + Just (Left e) -> + return (warns <> [e], config') + Just (Right widths) -> + return (warns, config' { configCharacterWidths = Just widths }) + +loadCharWidths :: IO (Maybe (Either String CharWidths)) +loadCharWidths = do + locatedPath <- locateConfig charWidthsFileName + + case locatedPath of + Nothing -> return Nothing + Just p -> Just <$> parseCharWidthsFile p + +parseCharWidthsFile :: FilePath -> IO (Either String CharWidths) +parseCharWidthsFile path = runExceptT $ do + contents <- ExceptT $ (Right <$> T.readFile path) `E.catch` + (\(e::E.SomeException) -> return $ Left $ show e) + + let pairs = catMaybes (parseCharWidth <$> T.lines contents) + + case pairs of + [] -> throwE $ path <> ": could not read any valid character width entries" + _ -> return $ newCharWidths pairs + +parseCharWidth :: T.Text -> Maybe (Char, Int) +parseCharWidth s = + case T.words s of + [ch, widthS] | T.length ch == 1 -> (T.head ch,) <$> readMaybe (T.unpack widthS) + _ -> Nothing + -- | Fix path references in the configuration: -- -- * Rewrite the syntax directory path list with 'fixupSyntaxDirs' @@ -495,8 +534,15 @@ keybindingsSectionName :: Text keybindingsSectionName = "keybindings" -getConfig :: FilePath -> ExceptT String IO ([String], Config) -getConfig fp = do +-- | Given a file path, load a Matterhorn configuration from the +-- specified path, loading any ancillary information such as passwords +-- or tokens from external sources as specified in the configuration. +-- +-- Fails with a string error message; otherwise returns a list of +-- warnings generated during the loading process as well as the loaded +-- configuration itself. +loadConfig :: FilePath -> ExceptT String IO ([String], Config) +loadConfig fp = do absPath <- convertIOException $ makeAbsolute fp t <- (convertIOException $ T.readFile absPath) `catchE` (\e -> throwE $ "Could not read " <> show absPath <> ": " <> e) @@ -524,7 +570,7 @@ Just (PasswordCommand cmdString) -> do let (cmd, rest) = case T.unpack <$> T.words cmdString of (a:as) -> (a, as) - [] -> error $ "BUG: getConfig: got empty command string" + [] -> error $ "BUG: loadConfig: got empty command string" output <- convertIOException (readProcess cmd rest "") `catchE` (\e -> throwE $ "Could not execute password command: " <> e) return $ Just $ T.pack (takeWhile (/= '\n') output) @@ -535,22 +581,22 @@ Just (TokenCommand cmdString) -> do let (cmd, rest) = case T.unpack <$> T.words cmdString of (a:as) -> (a, as) - [] -> error $ "BUG: getConfig: got empty command string" + [] -> error $ "BUG: loadConfig: got empty command string" output <- convertIOException (readProcess cmd rest "") `catchE` (\e -> throwE $ "Could not execute token command: " <> e) return $ Just $ T.pack (takeWhile (/= '\n') output) - Just (TokenString _) -> error $ "BUG: getConfig: token in the Config was already a TokenString" + Just (TokenString _) -> error $ "BUG: loadConfig: token in the Config was already a TokenString" Nothing -> return Nothing actualOTPToken <- case configOTPToken conf of Just (OTPTokenCommand cmdString) -> do let (cmd, rest) = case T.unpack <$> T.words cmdString of (a:as) -> (a, as) - [] -> error $ "BUG: getConfig: got empty command string" + [] -> error $ "BUG: loadConfig: got empty command string" output <- convertIOException (readProcess cmd rest "") `catchE` (\e -> throwE $ "Could not execute OTP token command: " <> e) return $ Just $ T.pack (takeWhile (/= '\n') output) - Just (OTPTokenString _) -> error $ "BUG: getConfig: otptoken in the Config was already a OTPTokenString" + Just (OTPTokenString _) -> error $ "BUG: loadConfig: otptoken in the Config was already a OTPTokenString" Nothing -> return Nothing let conf' = conf diff --git a/src/Matterhorn/Draw/Messages.hs b/src/Matterhorn/Draw/Messages.hs --- a/src/Matterhorn/Draw/Messages.hs +++ b/src/Matterhorn/Draw/Messages.hs @@ -330,12 +330,10 @@ if V.imageHeight (result^.imageL) >= remainingHeight then do single <- if newMessagesAbove - then do - result' <- render $ + then render $ vBox [ withDefAttr newMessageTransitionAttr $ hBorderWithLabel (txt "New Messages ↑") , cropTopBy 1 $ resultToWidget croppedResult ] - return result' else do return croppedResult return [single] diff --git a/src/Matterhorn/Draw/RichText.hs b/src/Matterhorn/Draw/RichText.hs --- a/src/Matterhorn/Draw/RichText.hs +++ b/src/Matterhorn/Draw/RichText.hs @@ -151,13 +151,10 @@ , headerTxt ] renderBlock (Blockquote bs) = do - w <- asks drawLineWidth bws <- mapM renderBlock (unBlocks bs) - return $ maybeHLimit w $ addQuoting $ vBox bws + return $ addQuoting $ vBox bws renderBlock (List ty spacing bs) = do - w <- asks drawLineWidth - lst <- renderList ty spacing bs - return $ maybeHLimit w lst + renderList ty spacing bs renderBlock (CodeBlock ci tx) = do hSet <- asks drawHighlightSet diff --git a/src/Matterhorn/FilePaths.hs b/src/Matterhorn/FilePaths.hs --- a/src/Matterhorn/FilePaths.hs +++ b/src/Matterhorn/FilePaths.hs @@ -7,6 +7,7 @@ , lastRunStateFileName , configFileName + , charWidthsFileName , xdgName , locateConfig @@ -55,6 +56,9 @@ configFileName :: FilePath configFileName = "config.ini" + +charWidthsFileName :: FilePath +charWidthsFileName = "char_widths.txt" historyFilePath :: IO FilePath historyFilePath = getUserConfigFile xdgName historyFileName diff --git a/src/Matterhorn/State/ChannelSelect.hs b/src/Matterhorn/State/ChannelSelect.hs --- a/src/Matterhorn/State/ChannelSelect.hs +++ b/src/Matterhorn/State/ChannelSelect.hs @@ -47,12 +47,13 @@ input <- use (csTeam(tId).tsChannelSelectState.channelSelectInput) cconfig <- use csClientConfig + appConfig <- use (csResources.crConfiguration) prefs <- use (csResources.crUserPreferences) - let pat = parseChannelSelectPattern $ T.concat $ getEditContents input + let pat = parseChannelSelectPattern appConfig $ T.concat $ getEditContents input chanNameMatches e = case pat of Nothing -> const Nothing - Just p -> applySelectPattern p e + Just p -> applySelectPattern appConfig p e patTy = case pat of Nothing -> Nothing Just CSPAny -> Nothing @@ -88,10 +89,10 @@ csTeam(tId).tsChannelSelectState.channelSelectMatches %= (Z.updateListBy preserveFocus $ Z.toList $ Z.maybeMapZipper matches (st^.csTeam(tId).tsFocus)) -applySelectPattern :: ChannelSelectPattern -> ChannelListEntry -> Text -> Maybe ChannelSelectMatch -applySelectPattern CSPAny entry chanName = do +applySelectPattern :: Config -> ChannelSelectPattern -> ChannelListEntry -> Text -> Maybe ChannelSelectMatch +applySelectPattern _ CSPAny entry chanName = do return $ ChannelSelectMatch "" "" chanName chanName entry -applySelectPattern (CSP ty pat) entry chanName = do +applySelectPattern config (CSP ty pat) entry chanName = do let applyType Infix | pat `T.isInfixOf` normalizedChanName = case T.breakOn pat normalizedChanName of (pre, _) -> @@ -121,7 +122,7 @@ applyType _ = Nothing - caseSensitive = T.any isUpper pat + caseSensitive = T.any isUpper pat && not (configChannelSelectCaseInsensitive config) normalizedChanName = if caseSensitive then chanName else T.toLower chanName @@ -129,10 +130,14 @@ (pre, m, post) <- applyType ty return $ ChannelSelectMatch pre m post chanName entry -parseChannelSelectPattern :: Text -> Maybe ChannelSelectPattern -parseChannelSelectPattern "" = return CSPAny -parseChannelSelectPattern pat = do - let only = if | userSigil `T.isPrefixOf` pat -> Just $ CSP PrefixDMOnly $ T.tail pat +parseChannelSelectPattern :: Config -> Text -> Maybe ChannelSelectPattern +parseChannelSelectPattern _ "" = return CSPAny +parseChannelSelectPattern config patRaw = do + let pat = if configChannelSelectCaseInsensitive config + then T.toLower patRaw + else patRaw + + only = if | userSigil `T.isPrefixOf` pat -> Just $ CSP PrefixDMOnly $ T.tail pat | normalChannelSigil `T.isPrefixOf` pat -> Just $ CSP PrefixNonDMOnly $ T.tail pat | otherwise -> Nothing diff --git a/src/Matterhorn/State/Messages.hs b/src/Matterhorn/State/Messages.hs --- a/src/Matterhorn/State/Messages.hs +++ b/src/Matterhorn/State/Messages.hs @@ -121,8 +121,9 @@ -- | Send a message and attachments to the specified channel. sendMessage :: ChannelId -> EditMode -> Text -> [AttachmentData] -> MH () -sendMessage chanId mode msg attachments = - when (not $ shouldSkipMessage msg) $ do +sendMessage chanId mode rawMsg attachments = do + let msg = T.strip rawMsg + when (not $ shouldSkipMessage msg attachments) $ do status <- use csConnectionStatus case status of Disconnected -> do @@ -164,9 +165,10 @@ } void $ MM.mmPatchPost (postId p) update session -shouldSkipMessage :: Text -> Bool -shouldSkipMessage "" = True -shouldSkipMessage s = T.all (`elem` (" \t"::String)) s +shouldSkipMessage :: Text -> [AttachmentData] -> Bool +shouldSkipMessage "" [] = True +shouldSkipMessage s [] = T.all (`elem` (" \t"::String)) s +shouldSkipMessage _ _ = False editMessage :: Post -> MH () editMessage new = do diff --git a/src/Matterhorn/State/Setup/Threads.hs b/src/Matterhorn/State/Setup/Threads.hs --- a/src/Matterhorn/State/Setup/Threads.hs +++ b/src/Matterhorn/State/Setup/Threads.hs @@ -389,6 +389,7 @@ , "Network.Socket.recvBuf" , "Network.Socket.sendBuf" , "resource vanished" + , "HandshakeFailed Error_EOF" , "timeout" , "partial packet" , "No route to host" diff --git a/src/Matterhorn/Types.hs b/src/Matterhorn/Types.hs --- a/src/Matterhorn/Types.hs +++ b/src/Matterhorn/Types.hs @@ -43,6 +43,10 @@ , channelTopicDialogEditor , channelTopicDialogFocus + , CharWidths + , newCharWidths + , buildWidthMap + , resultToWidget , MHKeyEventHandler @@ -96,6 +100,8 @@ , configThreadOrientationL , configMouseModeL , configShowLastOpenThreadL + , configChannelSelectCaseInsensitiveL + , configCharacterWidthsL , unsafeKeyDispatcher , bindingConflictMessage @@ -400,6 +406,7 @@ import Data.UUID ( UUID ) import qualified Data.Vector as Vec import qualified Graphics.Vty as Vty +import qualified Graphics.Vty.UnicodeWidthTable.Types as Vty import Lens.Micro.Platform ( at, makeLenses, lens, (^?!), (.=) , (%=), (%~), (.~), _Just, Traversal', to , SimpleGetter, filtered, traversed, singular @@ -498,6 +505,22 @@ -- dimensions. deriving (Eq, Show, Ord) +newtype CharWidths = CharWidths [(Char, Int)] + deriving (Eq, Show) + +newCharWidths :: [(Char, Int)] -> CharWidths +newCharWidths = CharWidths + +buildWidthMap :: CharWidths -> Vty.UnicodeWidthTable +buildWidthMap (CharWidths pairs) = + Vty.UnicodeWidthTable (mkRange <$> pairs) + where + mkRange (ch, w) = + Vty.WidthTableRange { Vty.rangeStart = toEnum $ fromEnum ch + , Vty.rangeSize = 1 + , Vty.rangeColumns = toEnum w + } + -- | 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. @@ -605,6 +628,11 @@ , configShowLastOpenThread :: Bool -- ^ Whether to re-open a thread that was open the last time -- Matterhorn quit + , configChannelSelectCaseInsensitive :: Bool + -- ^ Whether channel selection input is always matched + -- case-insensitively + , configCharacterWidths :: Maybe CharWidths + -- ^ Map of Unicode characters to widths to configure Vty } deriving (Eq, Show) -- | The policy for CPU usage. @@ -674,26 +702,17 @@ case HM.lookup tId hidden of Nothing -> False Just s -> Set.member label s - in [ let unread = length $ filter channelListEntryUnread favEntries - coll = isHidden ChannelGroupFavoriteChannels - in ( ChannelListGroup ChannelGroupFavoriteChannels unread coll (length favEntries) - , if coll then mempty else sortChannelListEntries sorting favEntries - ) - , let unread = length $ filter channelListEntryUnread normEntries - coll = isHidden ChannelGroupPublicChannels - in ( ChannelListGroup ChannelGroupPublicChannels unread coll (length normEntries) - , if coll then mempty else sortChannelListEntries sorting normEntries - ) - , let unread = length $ filter channelListEntryUnread privEntries - coll = isHidden ChannelGroupPrivateChannels - in ( ChannelListGroup ChannelGroupPrivateChannels unread coll (length privEntries) - , if coll then mempty else sortChannelListEntries sorting privEntries - ) - , let unread = length $ filter channelListEntryUnread dmEntries - coll = isHidden ChannelGroupDirectMessages - in ( ChannelListGroup ChannelGroupDirectMessages unread coll (length dmEntries) - , if coll then mempty else sortDMChannelListEntries dmEntries - ) + mkGroup (ty, entries, sortEntries) = + let unread = length $ filter channelListEntryUnread entries + coll = isHidden ty + in ( ChannelListGroup ty unread coll (length entries) + , if coll then mempty else sortEntries entries + ) + in mkGroup <$> + [ (ChannelGroupFavoriteChannels, favEntries, sortChannelListEntries sorting) + , (ChannelGroupPublicChannels, normEntries, sortChannelListEntries sorting) + , (ChannelGroupPrivateChannels, privEntries, sortChannelListEntries sorting) + , (ChannelGroupDirectMessages, dmEntries, sortDMChannelListEntries) ] sortChannelListEntries :: ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry] @@ -1336,6 +1355,8 @@ -- ^ The message tab. | VMTabReactions -- ^ The reactions tab. + | VMTabAuthorInfo + -- ^ The author info tab. deriving (Eq, Show) data PendingChannelChange = @@ -1966,10 +1987,7 @@ writeBChan queue (IEvent ev) writeBChan :: (MonadIO m) => BCH.BChan MHEvent -> MHEvent -> m () -writeBChan chan e = do - written <- liftIO $ BCH.writeBChanNonBlocking chan e - when (not written) $ - error $ "mhSendEvent: BChan full, please report this as a bug!" +writeBChan chan e = void $ liftIO $ BCH.writeBChanNonBlocking chan e -- | Log and raise an error. mhError :: MHError -> MH () diff --git a/src/Matterhorn/Types/Core.hs b/src/Matterhorn/Types/Core.hs --- a/src/Matterhorn/Types/Core.hs +++ b/src/Matterhorn/Types/Core.hs @@ -86,6 +86,9 @@ | ViewMessageReactionsArea TeamId -- ^ The viewport for the specified team's single-message view -- window's reaction tab. + | ViewMessageAuthorArea TeamId + -- ^ The viewport for the specified team's single-message view + -- window's author info tab. | ChannelSidebar TeamId -- ^ The cache key for the specified team's channel list viewport -- contents. diff --git a/src/Matterhorn/Windows/ViewMessage.hs b/src/Matterhorn/Windows/ViewMessage.hs --- a/src/Matterhorn/Windows/ViewMessage.hs +++ b/src/Matterhorn/Windows/ViewMessage.hs @@ -36,6 +36,7 @@ viewMessageWindowTemplate tId = TabbedWindowTemplate { twtEntries = [ messageEntry tId , reactionsEntry tId + , authorInfoEntry tId ] , twtTitle = const $ txt "View Message" } @@ -58,9 +59,19 @@ , tweShowHandler = onShow tId } +authorInfoEntry :: TeamId -> TabbedWindowEntry ChatState MH Name ViewMessageWindowTab +authorInfoEntry tId = + TabbedWindowEntry { tweValue = VMTabAuthorInfo + , tweRender = renderTab tId + , tweHandleEvent = handleEvent tId + , tweTitle = tabTitle + , tweShowHandler = onShow tId + } + tabTitle :: ViewMessageWindowTab -> Bool -> T.Text tabTitle VMTabMessage _ = "Message" tabTitle VMTabReactions _ = "Reactions" +tabTitle VMTabAuthorInfo _ = "Author" -- When we show the tabs, we need to reset the viewport scroll position -- for viewports in that tab. This is because an older View Message @@ -69,7 +80,8 @@ -- in an existing window resets this state, too. onShow :: TeamId -> ViewMessageWindowTab -> MH () onShow tId VMTabMessage = resetVp $ ViewMessageArea tId -onShow tId VMTabReactions = resetVp $ ViewMessageArea tId +onShow tId VMTabReactions = resetVp $ ViewMessageReactionsArea tId +onShow tId VMTabAuthorInfo = resetVp $ ViewMessageAuthorArea tId resetVp :: Name -> MH () resetVp n = do @@ -89,6 +101,7 @@ case tab of VMTabMessage -> viewMessageBox cs tId latestMessage VMTabReactions -> reactionsText cs tId latestMessage + VMTabAuthorInfo -> authorInfo cs tId latestMessage getLatestMessage :: ChatState -> TeamId -> Message -> Maybe Message getLatestMessage cs tId m = @@ -104,6 +117,27 @@ void . mhHandleKeyboardEvent (viewMessageKeybindings tId) handleEvent tId VMTabReactions = void . mhHandleKeyboardEvent (viewMessageReactionsKeybindings tId) +handleEvent _ VMTabAuthorInfo = + const $ return () + +authorInfo :: ChatState -> TeamId -> Message -> Widget Name +authorInfo cs tId m = + let mkPairs u = [ ("Username:", _uiName u) + , ("Nickname:", fromMaybe "(none)" $ _uiNickName u) + , ("Full name:", _uiFirstName u <> " " <> _uiLastName u) + ] + renderPair (label, value) = + txt label <+> padBottom (Pad 1) (padLeft (Pad 1) (withDefAttr clientEmphAttr $ txt value)) + in case _mUser m of + NoUser -> txt "No author." + UserOverride _ label -> txt $ "User: " <> label + UserI _ uId -> + case userById uId cs of + Nothing -> + txt "Author info not loaded yet." + Just author -> + viewport (ViewMessageAuthorArea tId) Vertical $ + vBox $ renderPair <$> mkPairs author reactionsText :: ChatState -> TeamId -> Message -> Widget Name reactionsText st tId m = viewport vpName Vertical body