matterhorn 50200.18.0 → 50200.19.0

raw patch · 19 files changed

+254/−140 lines, 19 filesdep ~brickdep ~mattermost-apidep ~mtlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: brick, mattermost-api, mtl, strict, tasty, text, text-zipper, unix

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• docs/keybindings.md +1/−0
• matterhorn.cabal +9/−9
• src/Matterhorn/Config.hs +3/−1
• src/Matterhorn/Draw/MessageInterface.hs +83/−74
• src/Matterhorn/Draw/Messages.hs +2/−2
• src/Matterhorn/Draw/RichText.hs +3/−3
• src/Matterhorn/Emoji.hs +2/−1
• src/Matterhorn/Events/Main.hs +2/−0
• src/Matterhorn/Events/MessageSelect.hs +3/−0
• src/Matterhorn/FilePaths.hs +8/−0
• src/Matterhorn/State/Common.hs +6/−2
• src/Matterhorn/State/Editing.hs +29/−3
• src/Matterhorn/State/MessageSelect.hs +34/−0
• src/Matterhorn/State/Messages.hs +6/−40
• src/Matterhorn/State/Reactions.hs +2/−1
• src/Matterhorn/Types/Core.hs +2/−0
• src/Matterhorn/Types/EditState.hs +17/−0
• src/Matterhorn/Types/Posts.hs +17/−4

@@ -1,4 +1,29 @@ +50200.19.0+==========++Improvements:+* Matterhorn's network performance is now greatly improved due to a more+  efficient use of the server API. Matterhorn now makes significantly+  fewer API requests at startup and whenever the channel is changed.+  ([#804](https://github.com/matterhorn-chat/matterhorn/issues/804))+* Autocompletion now has a less surprising default behavior by+  preferring a match that has the input as its prefix.+* The message selection mode (reachable with `C-s` by default) now has+  a new keybinding (event `open-message-in-editor`, default binding `O`)+  that opens the selected message in `$EDITOR` (or `vi` if `$EDITOR` is+  not set).+* Unless specified in the configuration, Matterhorn now+  also searches XDG data directories for syntax files.+  ([#584](https://github.com/matterhorn-chat/matterhorn/issues/584))++Bug fixes:+* `ClearUnreadEvent` (`M-l`) now also refreshes the sidebar+  ([#801](https://github.com/matterhorn-chat/matterhorn/issues/801))+* Reactions with no users no longer linger in+  the reactions tab of the message view window.+  ([#802](https://github.com/matterhorn-chat/matterhorn/issues/802))+ 50200.18.0 ========== 

@@ -110,6 +110,7 @@ | `Enter` | `fetch-for-gap` | Fetch messages for the selected gap | | `a` | `react-to-message` | Post a reaction to the selected message | | `l` | `copy-post-link` | Copy a post's link to the clipboard |+| `O` | `open-message-in-editor` | Open the message's source in $EDITOR |  # User Listings | Keybinding | Event Name | Description |

@@ -1,5 +1,5 @@ name:                matterhorn-version:             50200.18.0+version:             50200.19.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,7 +170,7 @@     ghc-options: -fhide-source-paths    build-depends:       base                 >=4.8      && <5-                     , mattermost-api       == 50200.14.0+                     , mattermost-api       == 50200.15.0                      , base-compat          >= 0.9     && < 0.13                      , unordered-containers >= 0.2     && < 0.3                      , containers           >= 0.5.7   && < 0.7@@ -178,24 +178,24 @@                      , data-clist           >= 0.1.2   && < 0.2                      , semigroups           >= 0.18    && < 0.20                      , connection           >= 0.2     && < 0.4-                     , text                 >= 1.2     && < 2.1+                     , text                 >= 1.2.5.0 && < 2.0                      , 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.6     && < 1.7+                     , brick                >= 1.8     && < 1.9                      , brick-skylighting    >= 1.0     && < 1.1                      , vty                  >= 5.38    && < 5.39                      , word-wrap            >= 0.4.0   && < 0.5                      , transformers         >= 0.4     && < 0.6-                     , text-zipper          >= 0.12    && < 0.13+                     , 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-                     , strict               >= 0.3     && < 0.5+                     , strict               >= 0.3     && < 0.6                      , hashable             >= 1.2     && < 1.5                      , commonmark           >= 0.2.1   && < 0.3                      , commonmark-extensions >= 0.2.1.2 && < 0.3@@ -204,10 +204,10 @@                      , temporary            >= 1.2     && < 1.4                      , gitrev               >= 1.3     && < 1.4                      , Hclip                >= 3.0     && < 3.1-                     , mtl                  >= 2.2     && < 2.3+                     , mtl                  >= 2.2     && < 2.4                      , aspell-pipe          >= 0.6     && < 0.7                      , stm-delay            >= 0.1     && < 0.2-                     , unix                 >= 2.7.1.0 && < 2.7.3.0+                     , unix                 >= 2.7.1.0 && < 2.9                      , skylighting-core     >= 0.12    && < 0.13                      , timezone-olson       >= 0.2     && < 0.3                      , timezone-series      >= 0.1.6.1 && < 0.2@@ -249,7 +249,7 @@   build-depends:      base                 >=4.7      && <5                     , Unique               >= 0.4     && < 0.5                     , checkers             >= 0.4     && < 0.6-                    , tasty                >= 0.11    && < 1.3+                    , tasty                >= 0.11    && < 1.5                     , tasty-hunit          >= 0.9     && < 0.12                     , tasty-quickcheck     >= 0.8     && < 0.12                     , bytestring

@@ -49,9 +49,10 @@ defaultSkylightingPaths :: IO [FilePath] defaultSkylightingPaths = do     xdg <- xdgSyntaxDir+    dataDirs <- xdgDataDirs     adjacent <- getBundledSyntaxPath     cabalDataFiles <- Paths.getDataFileName syntaxDirName-    return [xdg, adjacent, cabalDataFiles]+    return $ [xdg, adjacent, cabalDataFiles] <> dataDirs  getBundledSyntaxPath :: IO FilePath getBundledSyntaxPath = do@@ -214,6 +215,7 @@     , (FlagMessageEvent                 , [ bind 'f' ])     , (OpenThreadEvent                  , [ bind 't' ])     , (PinMessageEvent                  , [ bind 'p' ])+    , (OpenMessageInExternalEditorEvent , [ bind 'O' ])     , (YankMessageEvent                 , [ bind 'y' ])     , (YankWholeMessageEvent            , [ bind 'Y' ])     , (DeleteMessageEvent               , [ bind 'd' ])

@@ -130,86 +130,95 @@             let optionList = if null usableOptions                              then txt "(no actions available for this message)"                              else hBox $ intersperse (txt " ") usableOptions-                usableOptions = catMaybes $ mkOption <$> options-                mkOption (f, k, desc) = if f postMsg-                                        then Just $ withDefAttr messageSelectStatusAttr (txt k) <+>-                                                    txt (":" <> desc)-                                        else Nothing-                numURLs = Seq.length $ msgURLs postMsg-                s = if numURLs == 1 then "" else "s"-                hasURLs = numURLs > 0-                openUrlsMsg = "open " <> (T.pack $ show numURLs) <> " URL" <> s-                hasVerb = isJust (findVerbatimChunk (postMsg^.mText))-                ev = keyEventBindings st (messageSelectKeybindings tId which)-                -- make sure these keybinding pieces are up-to-date!-                options = [ ( not . isGap-                            , ev YankWholeMessageEvent-                            , "yank-all"-                            )-                          , ( \m -> isFlaggable m && not (m^.mFlagged)-                            , ev FlagMessageEvent-                            , "flag"-                            )-                          , ( \m -> isFlaggable m && m^.mFlagged-                            , ev FlagMessageEvent-                            , "unflag"-                            )-                          , ( isReplyable-                            , ev OpenThreadEvent-                            , "thread"-                            )-                          , ( isPostMessage-                            , ev CopyPostLinkEvent-                            , "copy-link"-                            )-                          , ( \m -> isPinnable m && not (m^.mPinned)-                            , ev PinMessageEvent-                            , "pin"-                            )-                          , ( \m -> isPinnable m && m^.mPinned-                            , ev PinMessageEvent-                            , "unpin"-                            )-                          , ( isReplyable-                            , ev ReplyMessageEvent-                            , "reply"-                            )-                          , ( not . isGap-                            , ev ViewMessageEvent-                            , "view"-                            )-                          , ( isGap-                            , ev FillGapEvent-                            , "load messages"-                            )-                          , ( \m -> isMine st m && isEditable m-                            , ev EditMessageEvent-                            , "edit"-                            )-                          , ( \m -> isMine st m && isDeletable m-                            , ev DeleteMessageEvent-                            , "delete"-                            )-                          , ( const hasURLs-                            , ev OpenMessageURLEvent-                            , openUrlsMsg-                            )-                          , ( const hasVerb-                            , ev YankMessageEvent-                            , "yank-code"-                            )-                          , ( isReactable-                            , ev ReactToMessageEvent-                            , "react"-                            )-                          ]-+                usableOptions = mkOption <$> messageSelectionKeyOptions st tId which postMsg+                mkOption (k, desc) = withDefAttr messageSelectStatusAttr (txt k) <+>+                                     txt (":" <> desc)             in hBox [ hLimit 1 hBorder                     , txt "["                     , optionList                     , txt "]"                     , hBorder                     ]++messageSelectionKeyOptions :: ChatState+                           -> TeamId+                           -> Lens' ChatState (MessageInterface Name i)+                           -> Message+                           -> [(T.Text, T.Text)]+messageSelectionKeyOptions st tId which msg =+    let ev = keyEventBindings st (messageSelectKeybindings tId which)+        hasVerb = isJust (findVerbatimChunk (msg^.mText))+        hasURLs = numURLs > 0+        numURLs = Seq.length $ msgURLs msg+        s = if numURLs == 1 then "" else "s"+        openUrlsMsg = "open " <> (T.pack $ show numURLs) <> " URL" <> s+        getUsable (usable, key, label) = if usable then Just (key, label) else Nothing+        options = [ ( not $ isGap msg+                  , ev YankWholeMessageEvent+                  , "yank-all"+                  )+                , ( isFlaggable msg && not (msg^.mFlagged)+                  , ev FlagMessageEvent+                  , "flag"+                  )+                , ( isFlaggable msg && msg^.mFlagged+                  , ev FlagMessageEvent+                  , "unflag"+                  )+                , ( isReplyable msg+                  , ev OpenThreadEvent+                  , "thread"+                  )+                , ( isPostMessage msg+                  , ev CopyPostLinkEvent+                  , "copy-link"+                  )+                , ( isPinnable msg && not (msg^.mPinned)+                  , ev PinMessageEvent+                  , "pin"+                  )+                , ( isPinnable msg && msg^.mPinned+                  , ev PinMessageEvent+                  , "unpin"+                  )+                , ( isReplyable msg+                  , ev ReplyMessageEvent+                  , "reply"+                  )+                , ( not $ isGap msg+                  , ev ViewMessageEvent+                  , "view"+                  )+                , ( not $ isGap msg+                  , ev OpenMessageInExternalEditorEvent+                  , "open"+                  )+                , ( isGap msg+                  , ev FillGapEvent+                  , "load messages"+                  )+                , ( isMine st msg && isEditable msg+                  , ev EditMessageEvent+                  , "edit"+                  )+                , ( isMine st msg && isDeletable msg+                  , ev DeleteMessageEvent+                  , "delete"+                  )+                , ( hasURLs+                  , ev OpenMessageURLEvent+                  , openUrlsMsg+                  )+                , ( hasVerb+                  , ev YankMessageEvent+                  , "yank-code"+                  )+                , ( isReactable msg+                  , ev ReactToMessageEvent+                  , "react"+                  )+                ]+    in catMaybes $ getUsable <$> options  renderMessageListing :: ChatState                      -> Bool

@@ -240,7 +240,7 @@   Widget Greedy Greedy $ do     ctx <- getContext     curMsgResult <- withReaderT relaxHeight $ render $-                    forceAttr messageSelectAttr $+                    forceAttrAllowStyle messageSelectAttr $                     padRight Max $ doMsgRender curMsg curThreadState tag      let targetHeight = ctx^.availHeightL@@ -465,7 +465,7 @@                             , mdRenderReplyParent = False                             , mdIndentBlocks      = False                             }-                      in withParent (addEllipsis $ forceAttr replyParentAttr parentMsg)+                      in withParent (addEllipsis $ forceAttrAllowStyle replyParentAttr parentMsg)      where         renderBlocks :: HighlightSet -> Maybe Int -> [Widget Name] -> Seq Block

@@ -299,7 +299,7 @@             Just u -> B.withDefAttr urlAttr . B.hyperlink (unURL u)          addClickable w = case mName of-            Nothing -> id w+            Nothing -> w             Just nm -> B.clickable nm w          widget = case val of@@ -319,12 +319,12 @@  textWithCursor :: Text -> Widget a textWithCursor t-    | T.any (== cursorSentinel) t = B.visible $ B.txt $ removeCursor t+    | cursorSentinel `T.elem` t = B.visible $ B.txt $ removeCursor t     | otherwise = B.txt t  wrappedTextWithCursor :: Text -> Widget a wrappedTextWithCursor t-    | T.any (== cursorSentinel) t = B.visible $ B.txtWrap $ removeCursor t+    | cursorSentinel `T.elem` t = B.visible $ B.txtWrap $ removeCursor t     | otherwise = B.txtWrap t  removeCursor :: Text -> Text

@@ -12,7 +12,8 @@ import           Matterhorn.Prelude  import qualified Control.Exception as E-import           Control.Monad.Except+import           Control.Monad.Except ( MonadError(..), ExceptT(..), runExceptT )+import           Control.Monad.Trans ( MonadTrans(..) ) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as BSL import qualified Data.Foldable as F

@@ -16,6 +16,7 @@ import           Matterhorn.Events.ThreadWindow import           Matterhorn.State.ChannelSelect import           Matterhorn.State.Channels+import           Matterhorn.State.ChannelList ( updateSidebar ) import           Matterhorn.State.Help import           Matterhorn.State.Teams import           Matterhorn.State.PostListWindow ( enterFlaggedPostListMode )@@ -90,6 +91,7 @@     , onEvent ClearUnreadEvent "Clear the current channel's unread / edited indicators" $ do            withCurrentChannel tId $ \cId _ -> do                clearChannelUnreadStatus cId+               updateSidebar $ Just tId      , onEvent EnterFlaggedPostsEvent "View currently flagged posts" $          enterFlaggedPostListMode tId

@@ -118,4 +118,7 @@      , onEvent CopyPostLinkEvent "Copy a post's link to the clipboard" $          copyPostLink tId which++    , onEvent OpenMessageInExternalEditorEvent "Open the message's source in $EDITOR" $+         openSelectedMessageInEditor which     ]

@@ -11,6 +11,7 @@   , xdgName   , locateConfig   , xdgSyntaxDir+  , xdgDataDirs   , syntaxDirName   , userEmojiJsonPath   , bundledEmojiJsonPath@@ -38,6 +39,7 @@ import System.Environment.XDG.BaseDir ( getUserConfigFile                                       , getAllConfigFiles                                       , getUserConfigDir+                                      , getAllDataDirs                                       ) import System.FilePath ( (</>), takeBaseName, takeDirectory, splitPath, joinPath ) @@ -65,6 +67,12 @@ -- The path does not necessarily exist. xdgSyntaxDir :: IO FilePath xdgSyntaxDir = (</> syntaxDirName) <$> getUserConfigDir xdgName++-- | Get the list of syntax paths based on XDG data directory paths.+xdgDataDirs :: IO [FilePath]+xdgDataDirs = do+    dirs <- getAllDataDirs xdgName+    return $ (</> syntaxDirName) <$> dirs  -- | Get the XDG path to the user-specific emoji JSON file. The path -- does not necessarily exist.

@@ -87,10 +87,12 @@       Nothing -> return Nothing       Just tId -> Just <$> getServerBaseUrl tId +  hostname <- use (csResources.crConn.cdHostnameL)+   -- Build the ordered list of posts. Note that postsOrder lists the   -- posts most recent first, but we want most recent last.   let postsInOrder = findPost <$> (Seq.reverse $ postsOrder postCollection)-      mkClientPost p = toClientPost mBaseUrl p (postId <$> parent p)+      mkClientPost p = toClientPost hostname mBaseUrl p (postId <$> parent p)       clientPosts = mkClientPost <$> postsInOrder        addNext cp (msgs, us) =@@ -125,9 +127,11 @@       Nothing -> return Nothing       Just tId -> Just <$> getServerBaseUrl tId +  hostname <- use (csResources.crConn.cdHostnameL)+   let postMap = HM.fromList           [ ( pId-            , fst $ clientPostToMessage (toClientPost mBaseUrl x Nothing)+            , fst $ clientPostToMessage (toClientPost hostname mBaseUrl x Nothing)             )           | (pId, x) <- HM.toList (postCollection^.postsPostsL)           ]

@@ -530,13 +530,39 @@  tabComplete :: Traversal' ChatState (EditState Name) -> Direction -> MH () tabComplete which dir = do+    searchStr <- use (which.esAutocomplete._Just.acPreviousSearchString)+     let transform list =             let len = list^.L.listElementsL.to length+                prefixMatch alt =+                    T.toLower searchStr `T.isPrefixOf` (T.toLower $ autocompleteAlternativeText alt)             in case dir of                 Forwards ->-                    if (L.listSelected list == Just (len - 1)) ||-                       (L.listSelected list == Nothing && len > 0)-                    then L.listMoveTo 0 list+                    if L.listSelected list == Just (len - 1)+                       then L.listMoveTo 0 list+                       else if L.listSelected list == Nothing && len > 0+                            -- If the list has nothing selected, then+                            -- make the initial selection the best match+                            -- by prefix rather than always selecting+                            -- the first entry. If there is no match+                            -- based on prefix, then select the first+                            -- entry.+                            --+                            -- Note that we only bother with this+                            -- behavior in the Forward case because in+                            -- the Backwards case we don't want the+                            -- first selection to be based on prefix+                            -- match since that doesn't make sense.+                            then let new = L.listFindBy prefixMatch list+                                 in if L.listSelected new == Nothing+                                    -- If, after attempting to select+                                    -- by prefix, nothing matched, then+                                    -- there is still no autocomplete+                                    -- alternative selected, so move to+                                    -- the selection to the first entry+                                    -- in the list.+                                    then L.listMoveBy 1 new+                                    else new                     else L.listMoveBy 1 list                 Backwards ->                     if (L.listSelected list == Just 0) ||

@@ -6,6 +6,7 @@   , flagSelectedMessage   , pinSelectedMessage   , viewSelectedMessage+  , openSelectedMessageInEditor   , fillSelectedGap   , copyPostLink   , yankSelectedMessageVerbatim@@ -34,9 +35,14 @@ import           Brick ( invalidateCache ) import           Brick.Widgets.Edit ( applyEdit ) import           Control.Monad ( replicateM_ )+import qualified Data.Text as T import           Data.Text.Zipper ( clearZipper, insertMany ) import           Data.Maybe ( fromJust ) import           Lens.Micro.Platform+import qualified System.Environment as Sys+import           System.IO (hClose, hPutStr)+import qualified System.IO.Temp as Sys+import qualified System.Process as Sys  import qualified Network.Mattermost.Endpoints as MM import           Network.Mattermost.Types@@ -125,6 +131,12 @@     withSelectedMessage which $ \msg ->         when (not (isGap msg)) $ viewMessage tId msg +openSelectedMessageInEditor :: Lens' ChatState (MessageInterface n i)+                            -> MH ()+openSelectedMessageInEditor which =+    withSelectedMessage which $ \msg ->+        when (not (isGap msg)) $ openMessageInEditor msg which+ -- This will only work for channel message selection, not thread message -- selection, since there will never be gap entries in the thread view. -- But this is generalized enough that it looks like it should work for@@ -154,6 +166,28 @@     csTeam(tId).tsViewedMessage .= Just (m, w)     runTabShowHandlerFor (twValue w) w     pushMode tId ViewMessage++openMessageInEditor :: Message -> Lens' ChatState (MessageInterface n i) -> MH ()+openMessageInEditor m which = do+    -- If EDITOR is in the environment, write the current message to a+    -- temp file, invoke EDITOR on it, read the result, remove the temp+    -- file, and update the program state.+    --+    -- If EDITOR is not present, fall back to 'vi'.+    mEnv <- liftIO $ Sys.lookupEnv "EDITOR"+    let editorProgram = maybe "vi" id mEnv++    case m^.mOriginalPost of+        Nothing -> return ()+        Just p -> do+            mhSuspendAndResume $ \s -> do+                Sys.withSystemTempFile "matterhorn_editor.md" $ \tmpFileName tmpFileHandle -> do+                    hPutStr tmpFileHandle $ T.unpack $ unsafeUserText $ postMessage p+                    hClose tmpFileHandle+                    void $ Sys.system (editorProgram <> " " <> tmpFileName)+                    return s++    exitMessageSelect which  yankSelectedMessageVerbatim :: Lens' ChatState (MessageInterface n i)                             -> MH ()

@@ -48,7 +48,6 @@ import           Matterhorn.State.Common import           Matterhorn.State.ThreadWindow import           Matterhorn.State.MessageSelect-import           Matterhorn.State.Reactions import           Matterhorn.State.Users import           Matterhorn.TimeUtils import           Matterhorn.Types@@ -177,7 +176,9 @@             Nothing -> return Nothing             Just tId -> Just <$> getServerBaseUrl tId -        let (msg, mentionedUsers) = clientPostToMessage (toClientPost mBaseUrl new (new^.postRootIdL))+        hostname <- use (csResources.crConn.cdHostnameL)++        let (msg, mentionedUsers) = clientPostToMessage (toClientPost hostname mBaseUrl new (new^.postRootIdL))             isEditedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL)          csChannel (new^.postChannelIdL) . ccMessageInterface.miMessages . traversed . filtered isEditedMessage .= msg@@ -193,8 +194,6 @@             csChannel (new^.postChannelIdL) %= adjustEditedThreshold new          csPostMap.ix(postId new) .= msg-        asyncFetchReactionsForPost (postChannelId new) new-        asyncFetchAttachments new  deleteMessage :: Post -> MH () deleteMessage new = do@@ -530,6 +529,8 @@           OldPost p      -> (p, False)           RecentPost p m -> (p, m) +    hostname <- use (csResources.crConn.cdHostnameL)+     st <- use id     case st ^? csChannel(postChannelId new) of         Nothing -> do@@ -566,7 +567,7 @@                 Nothing -> return Nothing                 Just tId -> Just <$> getServerBaseUrl tId -            let cp = toClientPost mBaseUrl new (new^.postRootIdL)+            let cp = toClientPost hostname mBaseUrl new (new^.postRootIdL)                 fromMe = (cp^.cpUser == (Just $ myUserId st)) &&                          (isNothing $ cp^.cpUserOverride)                 userPrefs = st^.csResources.crUserPreferences@@ -627,8 +628,6 @@                     -- since all DM channels appear in all teams.                     addPostToOpenThread (mTId <|> mcurTId) new msg' -                    asyncFetchReactionsForPost cId new-                    asyncFetchAttachments new                     postedChanMessage                  doHandleAddedMessage = do@@ -1053,39 +1052,6 @@                        (\c p -> Just $ do                            csChannel(c).ccInfo.cdFetchPending .= False                            addObtainedMessages c (-numToRequest) addTrailingGap p >>= postProcessMessageAdd)--asyncFetchAttachments :: Post -> MH ()-asyncFetchAttachments p = do-    let cId = p^.postChannelIdL-        pId = p^.postIdL-    session <- getSession-    host <- use (csResources.crConn.cdHostnameL)-    F.forM_ (p^.postFileIdsL) $ \fId -> doAsyncWith Normal $ do-        info <- MM.mmGetMetadataForFile fId session-        let scheme = "https://"-            attUrl = scheme <> host <> urlForFile fId-            attachment = mkAttachment (fileInfoName info) attUrl fId-            addIfMissing a as =-                if isNothing $ Seq.elemIndexL a as-                then a Seq.<| as-                else as-            addAttachment m-                | m^.mMessageId == Just (MessagePostId pId) =-                    m & mAttachments %~ (addIfMissing attachment)-                | otherwise =-                    m-        return $ Just $ do-            csChannelMessages(cId).traversed %= addAttachment--            curTId <- use csCurrentTeamId-            withChannel cId $ \chan -> do-                let mTId = chan^.ccInfo.cdTeamId <|> curTId-                case mTId of-                    Nothing -> return ()-                    Just tId -> modifyEachThreadMessage tId cId addAttachment--            invalidateChannelRenderingCache cId-            invalidateMessageRenderingCacheByPostId pId  -- | Given a post ID, switch to that post's channel and select the post -- in message selection mode.

@@ -80,9 +80,10 @@      invalidateRenderCache   where upd m | m^.mMessageId == Just (MessagePostId $ r^.reactionPostIdL) =-                  m & mReactions %~ (Map.alter delReaction (r^.reactionEmojiNameL))+                  m & mReactions %~ (removeEmptySets . Map.alter delReaction (r^.reactionEmojiNameL))               | otherwise = m         delReaction mUs = S.delete (r^.reactionUserIdL) <$> mUs+        removeEmptySets = Map.filter (not . S.null)         invalidateRenderCache =             invalidateMessageRenderingCacheByPostId $ r^.reactionPostIdL 

@@ -360,6 +360,7 @@   | EditMessageEvent   | ReplyMessageEvent   | ReactToMessageEvent+  | OpenMessageInExternalEditorEvent    -- Attachments   | AttachmentListAddEvent@@ -462,6 +463,7 @@     , ("activate-list-item", ActivateListItemEvent)     , ("open-thread", OpenThreadEvent)     , ("flag-message", FlagMessageEvent)+    , ("open-message-in-editor", OpenMessageInExternalEditorEvent)     , ("pin-message", PinMessageEvent)     , ("view-message", ViewMessageEvent)     , ("fetch-for-gap", FillGapEvent)

@@ -43,6 +43,7 @@    , AutocompleteAlternative(..)   , autocompleteAlternativeReplacement+  , autocompleteAlternativeText   ) where @@ -88,6 +89,22 @@     -- ^ Source, name of a slash command, argspec, and description     | EmojiCompletion Text     -- ^ The text of an emoji completion++autocompleteAlternativeText :: AutocompleteAlternative -> Text+autocompleteAlternativeText (UserCompletion u _) =+    userUsername u+autocompleteAlternativeText (SpecialMention MentionChannel) =+    "channel"+autocompleteAlternativeText (SpecialMention MentionAll) =+    "all"+autocompleteAlternativeText (ChannelCompletion _ c) =+    unsafeUserText $ channelName c+autocompleteAlternativeText (SyntaxCompletion n) =+    n+autocompleteAlternativeText (CommandCompletion _ t _ _) =+    t+autocompleteAlternativeText (EmojiCompletion t) =+    t  -- | The source of an autocompletion alternative. data CompletionSource = Server | Client

@@ -48,6 +48,7 @@ import           Prelude () import           Matterhorn.Prelude +import qualified Data.Foldable as F import qualified Data.Map.Strict as Map import qualified Data.Sequence as Seq import qualified Data.Text as T@@ -193,10 +194,17 @@                   else t unEmote _ t = t +attachmentFromFileInfo :: T.Text -> FileInfo -> Attachment+attachmentFromFileInfo hostname info =+    let scheme = "https://"+        attUrl = scheme <> hostname <> urlForFile fId+        fId = fileInfoId info+    in mkAttachment (fileInfoName info) attUrl fId+ -- | Convert a Mattermost 'Post' to a 'ClientPost', passing in a --   'ParentId' if it has a known one.-toClientPost :: Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost-toClientPost baseUrl p parentId =+toClientPost :: T.Text -> Maybe TeamBaseURL -> Post -> Maybe PostId -> ClientPost+toClientPost hostname baseUrl p parentId =   let src = unEmote (postClientPostType p) $ sanitizeUserText $ postMessage p   in ClientPost { _cpText          = parseMarkdown baseUrl src <> getAttachmentText p                 , _cpMarkdownSource = src@@ -207,14 +215,19 @@                 , _cpPending       = False                 , _cpDeleted       = False                 , _cpPinned        = fromMaybe False $ postPinned p-                , _cpAttachments   = Seq.empty+                , _cpAttachments   = attachmentFromFileInfo hostname <$> postMetadataFiles (postMetadata p)                 , _cpInReplyToPost = parentId                 , _cpPostId        = p^.postIdL                 , _cpChannelId     = p^.postChannelIdL-                , _cpReactions     = Map.empty+                , _cpReactions     = mkReactionMap $ postMetadataReactions (postMetadata p)                 , _cpOriginalPost  = p                 , _cpFromWebhook   = fromMaybe False $ p^.postPropsL.postPropsFromWebhookL                 }++mkReactionMap :: Seq Reaction -> Map.Map T.Text (S.Set UserId)+mkReactionMap rs =+    let inserter r m = Map.insertWith S.union (reactionEmojiName r) (S.singleton $ reactionUserId r) m+    in F.foldr inserter mempty rs  -- | Right now, instead of treating 'attachment' properties specially, we're --   just going to roll them directly into the message text