matterhorn 50200.11.0 → 50200.12.0

raw patch · 208 files changed

+18163/−6949 lines, 208 filesdep +commonmarkdep +commonmark-extensionsdep +parsecdep −cheapskatedep ~aspell-pipedep ~brickdep ~mattermost-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: commonmark, commonmark-extensions, parsec

Dependencies removed: cheapskate

Dependency ranges changed: aspell-pipe, brick, mattermost-api, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +51/−1
• README.md +1/−0
• docs/commands.md +3/−0
• docs/keybindings.md +5/−1
• matterhorn.cabal +15/−9
• src/Matterhorn/App.hs +11/−8
• src/Matterhorn/Command.hs +42/−28
• src/Matterhorn/Constants.hs +16/−2
• src/Matterhorn/Draw.hs +2/−2
• src/Matterhorn/Draw/Autocomplete.hs +2/−2
• src/Matterhorn/Draw/ChannelList.hs +8/−7
• src/Matterhorn/Draw/ChannelListOverlay.hs +1/−1
• src/Matterhorn/Draw/ChannelTopicWindow.hs +7/−6
• src/Matterhorn/Draw/Main.hs +122/−43
• src/Matterhorn/Draw/ManageAttachments.hs +3/−3
• src/Matterhorn/Draw/Messages.hs +246/−28
• src/Matterhorn/Draw/NotifyPrefs.hs +1/−1
• src/Matterhorn/Draw/PostListOverlay.hs +2/−2
• src/Matterhorn/Draw/ReactionEmojiListOverlay.hs +1/−1
• src/Matterhorn/Draw/RichText.hs +98/−450
• src/Matterhorn/Draw/RichText/Flatten.hs +302/−0
• src/Matterhorn/Draw/RichText/Wrap.hs +116/−0
• src/Matterhorn/Draw/ShowHelp.hs +31/−25
• src/Matterhorn/Draw/TabbedWindow.hs +8/−4
• src/Matterhorn/Draw/ThemeListOverlay.hs +1/−1
• src/Matterhorn/Draw/URLList.hs +10/−3
• src/Matterhorn/Draw/UserListOverlay.hs +1/−1
• src/Matterhorn/Draw/Util.hs +2/−3
• src/Matterhorn/Events.hs +30/−190
• src/Matterhorn/Events/ChannelListOverlay.hs +3/−3
• src/Matterhorn/Events/ChannelSelect.hs +3/−3
• src/Matterhorn/Events/ChannelTopicWindow.hs +11/−11
• src/Matterhorn/Events/EditNotifyPrefs.hs +4/−4
• src/Matterhorn/Events/Keybindings.hs +4/−0
• src/Matterhorn/Events/Main.hs +25/−9
• src/Matterhorn/Events/ManageAttachments.hs +19/−18
• src/Matterhorn/Events/ReactionEmojiListOverlay.hs +14/−7
• src/Matterhorn/Events/ShowHelp.hs +1/−1
• src/Matterhorn/Events/ThemeListOverlay.hs +14/−7
• src/Matterhorn/Events/UrlSelect.hs +3/−3
• src/Matterhorn/Events/UserListOverlay.hs +3/−3
• src/Matterhorn/Events/Websocket.hs +236/−0
• src/Matterhorn/LastRunState.hs +16/−11
• src/Matterhorn/Scripts.hs +5/−2
• src/Matterhorn/State/Attachments.hs +8/−5
• src/Matterhorn/State/Autocomplete.hs +36/−32
• src/Matterhorn/State/ChannelList.hs +164/−0
• src/Matterhorn/State/ChannelListOverlay.hs +3/−3
• src/Matterhorn/State/ChannelSelect.hs +8/−6
• src/Matterhorn/State/ChannelTopicWindow.hs +5/−1
• src/Matterhorn/State/Channels.hs +171/−238
• src/Matterhorn/State/Common.hs +19/−12
• src/Matterhorn/State/Editing.hs +78/−72
• src/Matterhorn/State/Flagging.hs +36/−22
• src/Matterhorn/State/Help.hs +1/−1
• src/Matterhorn/State/MessageSelect.hs +23/−20
• src/Matterhorn/State/Messages.hs +115/−95
• src/Matterhorn/State/NotifyPrefs.hs +9/−7
• src/Matterhorn/State/PostListOverlay.hs +24/−21
• src/Matterhorn/State/ReactionEmojiListOverlay.hs +3/−2
• src/Matterhorn/State/Setup.hs +31/−72
• src/Matterhorn/State/Teams.hs +217/−0
• src/Matterhorn/State/ThemeListOverlay.hs +3/−2
• src/Matterhorn/State/UrlSelect.hs +3/−2
• src/Matterhorn/State/UserListOverlay.hs +13/−13
• src/Matterhorn/TeamSelect.hs +0/−90
• src/Matterhorn/Themes.hs +9/−0
• src/Matterhorn/Types.hs +397/−234
• src/Matterhorn/Types/Channels.hs +31/−7
• src/Matterhorn/Types/Common.hs +3/−2
• src/Matterhorn/Types/KeyEvents.hs +16/−0
• src/Matterhorn/Types/Messages.hs +8/−12
• src/Matterhorn/Types/Posts.hs +7/−7
• src/Matterhorn/Types/RichText.hs +308/−316
• src/Matterhorn/Windows/ViewMessage.hs +71/−51
• syntax/abc.xml +7/−3
• syntax/actionscript.xml +18/−12
• syntax/ada.xml +6/−3
• syntax/agda.xml +18/−12
• syntax/apache.xml +3/−1
• syntax/asn1.xml +8/−1
• syntax/asp.xml +70/−57
• syntax/ats.xml +161/−166
• syntax/awk.xml +107/−105
• syntax/bash.xml +35/−9
• syntax/boo.xml +21/−9
• syntax/c.xml +30/−28
• syntax/clojure.xml +10/−9
• syntax/cmake.xml +250/−79
• syntax/coffee.xml +43/−23
• syntax/coldfusion.xml +90/−92
• syntax/commonlisp.xml +14/−6
• syntax/cs.xml +22/−11
• syntax/css.xml +4/−2
• syntax/curry.xml +9/−3
• syntax/d.xml +27/−23
• syntax/diff.xml +36/−25
• syntax/djangotemplate.xml +6/−1
• syntax/dot.xml +7/−2
• syntax/doxygen.xml +269/−127
• syntax/doxygenlua.xml +133/−182
• syntax/dtd.xml +4/−4
• syntax/eiffel.xml +8/−3
• syntax/elixir.xml +5/−1
• syntax/elm.xml +16/−9
• syntax/erlang.xml +3/−2
• syntax/fasm.xml +1746/−893
• syntax/fortran-fixed.xml +592/−0
• syntax/fortran-free.xml +311/−0
• syntax/fsharp.xml +10/−4
• syntax/glsl.xml +11/−12
• syntax/gnuassembler.xml +10/−7
• syntax/go.xml +5/−2
• syntax/graphql.xml +91/−0
• syntax/groovy.xml +3894/−0
• syntax/hamlet.xml +2/−4
• syntax/haskell.xml +14/−9
• syntax/haxe.xml +11/−3
• syntax/html.xml +40/−37
• syntax/idris.xml +99/−92
• syntax/ini.xml +3/−2
• syntax/isocpp.xml +25/−26
• syntax/j.xml +7/−2
• syntax/java.xml +9/−4
• syntax/javascript-react.xml +5/−4
• syntax/javascript.xml +41/−20
• syntax/json.xml +1/−1
• syntax/jsp.xml +47/−40
• syntax/julia.xml +2/−2
• syntax/kotlin.xml +9/−4
• syntax/latex.xml +43/−40
• syntax/lex.xml +7/−3
• syntax/lilypond.xml +7/−1
• syntax/literate-curry.xml +10/−3
• syntax/literate-haskell.xml +10/−3
• syntax/llvm.xml +160/−162
• syntax/lua.xml +59/−13
• syntax/m4.xml +9/−3
• syntax/makefile.xml +23/−6
• syntax/markdown.xml +6/−4
• syntax/mathematica.xml +122/−31
• syntax/matlab.xml +14/−5
• syntax/maxima.xml +5/−9
• syntax/mediawiki.xml +24/−12
• syntax/metafont.xml +6/−4
• syntax/mips.xml +9/−3
• syntax/modelines.xml +3/−9
• syntax/modula-2.xml +10/−4
• syntax/modula-3.xml +246/−242
• syntax/monobasic.xml +6/−2
• syntax/mustache.xml +16/−7
• syntax/nasm.xml +2778/−888
• syntax/nim.xml +356/−0
• syntax/noweb.xml +6/−1
• syntax/objectivec.xml +24/−13
• syntax/objectivecpp.xml +26/−23
• syntax/ocaml.xml +5/−1
• syntax/octave.xml +12/−5
• syntax/opencl.xml +25/−21
• syntax/pascal.xml +13/−13
• syntax/perl.xml +22/−15
• syntax/php.xml +13/−5
• syntax/pike.xml +10/−8
• syntax/postscript.xml +8/−3
• syntax/povray.xml +30/−25
• syntax/powershell.xml +12/−5
• syntax/prolog.xml +4/−1
• syntax/protobuf.xml +7/−2
• syntax/pure.xml +64/−58
• syntax/purebasic.xml +3/−2
• syntax/python.xml +2/−1
• syntax/qml.xml +5/−8
• syntax/r.xml +47/−29
• syntax/relaxng.xml +4/−2
• syntax/relaxngcompact.xml +7/−1
• syntax/rest.xml +3/−1
• syntax/rhtml.xml +119/−106
• syntax/roff.xml +4/−1
• syntax/ruby.xml +22/−19
• syntax/rust.xml +15/−14
• syntax/scala.xml +13/−5
• syntax/scheme.xml +1392/−393
• syntax/sci.xml +8/−3
• syntax/sed.xml +7/−2
• syntax/sgml.xml +7/−4
• syntax/sml.xml +8/−4
• syntax/sql-mysql.xml +13/−5
• syntax/sql-postgresql.xml +16/−8
• syntax/sql.xml +15/−6
• syntax/stata.xml +8/−3
• syntax/tcl.xml +7/−2
• syntax/tcsh.xml +5/−2
• syntax/texinfo.xml +12/−7
• syntax/toml.xml +137/−0
• syntax/typescript.xml +94/−50
• syntax/verilog.xml +12/−5
• syntax/vhdl.xml +28/−25
• syntax/xml.xml +8/−7
• syntax/xorg.xml +3/−1
• syntax/xslt.xml +26/−25
• syntax/xul.xml +9/−8
• syntax/yacc.xml +15/−13
• syntax/yaml.xml +54/−52
• syntax/zsh.xml +6/−2
• test/Cheapskate_QCA.hs +0/−47
• test/Message_QCA.hs +4/−5
• test/RichText_QCA.hs +70/−0
• test/test_messages.hs +1/−1

@@ -1,4 +1,54 @@ +50200.12.0+==========++New features:+ * Matterhorn now supports multiple teams! This includes a number of UI+   changes:+   * Matterhorn no longer prompts for a team on startup.+   * If the configuration file sets `team`, Matterhorn will attempt to+     honor that by selecting that as the active team on startup.+     If the configuration does not specify the `team` setting, the+     initially-selected team is chosen as the first team after sorting+     the team list alphabetically.+   * The window title now reflects the sum of all unread channels in all+     teams, rather than the number of unread channels in the current+     team.+   * If the user is a member of more than one team, the list of teams+     will be displayed at the top of the window with the active team+     highlighted. Each team with unread channels will display the count+     of unread channels next to the team name and teams with unread+     channels will be highlighted. This change comes with a new theme+     attribute, `currentTeam`, to style the selected team in the list.+   * The current team selection can be changed with new keybindings:+     * `next-team` (default binding: `C-Right`)+     * `prev-team` (default binding: `C-Left`)+   * The team list can be reordered manually. In the official web+     client, the team list can be reordered by dragging and dropping+     the team icons; in Matterhorn, this can be done by using two new+     commands, `/move-team-left` and `/move-team-right`, respectively.+     New keybindings to do the same thing were also added:+     * `move-current-team-left` (unbound by default)+     * `move-current-team-right` (unbound by default)+ * The new `/rename-channel-url` command renames the current channel's+   URL name. This differs from the server command `/rename`, which+   renames the current channel's display name. Renaming the URL name+   with this command is equivalent to changing the value of the "URL"+   field in the "Rename Channel" dialog box in the official web client.+   (thanks to Ajay Eeralla for this work)++Other improvements:+ * The channel list now takes up the full window height. Previously+   the message editor and input preview were displayed across the entire+   screen; now those areas stop at the channel list, so the channel list+   gets a few more rows of space to display channels.+ * Matterhorn now parses all incoming Markdown text with the Haskell+   `commonmark` library. Migrating to `commonmark` improved our support+   for many Markdown extensions and improved how Matterhorn handles some+   Markdown syntax.+ * The syntax highlighting XML files in `syntax/` were updated from+   version 0.10.0.3 of the `skylighting` package.+ 50200.11.0 ========== @@ -60,7 +110,7 @@      (`~`)    * Channel mute status (`(m)`)    * Unread status and visual style- * When composing replies, Mattehorn now displays the threat root+ * When composing replies, Mattehorn now displays the thread root    message of the thread being replied to, rather than the message    the user selected for reply (#670). This is intended to be less    surprising than the old behavior since showing the root post in the

@@ -49,6 +49,7 @@ # Features  * Channel creation, deletion, and membership management commands+* Support for multiple teams * Optimized channel-switching modes: `M-a`, `M-s`, and `C-g` * Message posting, editing, replying, and deletion * Markdown rendering

@@ -25,6 +25,8 @@ | `/log-stop` | Stop logging | | `/members` | Show the current channel's members | | `/message-preview` | Toggle preview of the current message |+| `/move-team-left` | Move the currently-selected team to the left in the team list |+| `/move-team-right` | Move the currently-selected team to the right in the team list | | `/msg` | Search for a user to enter a private chat | | `/msg <@user>` | Chat with the specified user | | `/msg <@user> <message or command>` | Go to a user's channel and send the specified message or command |@@ -33,6 +35,7 @@ | `/quit` | Exit Matterhorn | | `/reconnect` | Force a reconnection attempt to the server | | `/remove-user <@user>` | Remove a user from the current channel |+| `/rename-channel-url <channel name>` | Rename the current channel's URL name | | `/right` | Focus on the next channel | | `/search <terms>` | Search for posts with given terms | | `/sh` | List the available shell scripts |

@@ -24,6 +24,10 @@ | `M-p` | `toggle-message-preview` | Toggle message preview | | `F2` | `toggle-channel-list-visibility` | Toggle channel list visibility | | `F3` | `toggle-expanded-channel-topics` | Toggle display of expanded channel topics |+| `C-Right` | `next-team` | Switch to the next available team |+| `C-Left` | `prev-team` | Switch to the previous available team |+| (unbound) | `move-current-team-left` | Move the current team to the left in the team list |+| (unbound) | `move-current-team-right` | Move the current team to the right in the team list | | `M-k` | `invoke-editor` | Invoke `$EDITOR` to edit the current message | | `C-g` | `enter-fast-select` | Enter fast channel selection mode | | `C-q` | `quit` | Quit |@@ -37,7 +41,7 @@ | `C-p` | `focus-prev-channel` | Change to the previous channel in the channel list | | `M-a` | `focus-next-unread` | Change to the next channel with unread messages or return to the channel marked '~' | | `C-x` | `show-attachment-list` | Show the attachment list |-| `(unbound)` | focus-next-unread-user-or-channel | Change to the next channel with unread messages preferring direct messages |+| (unbound) | `focus-next-unread-user-or-channel` | Change to the next channel with unread messages preferring direct messages | | `M-s` | `focus-last-channel` | Change to the most recently-focused channel | | `Enter` | (non-customizable key) | Send the current message | | `C-o` | `enter-url-open` | Select and open a URL posted to the current channel |

@@ -1,5 +1,5 @@ name:                matterhorn-version:             50200.11.0+version:             50200.12.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@@ -63,6 +63,8 @@                        Matterhorn.Draw.PostListOverlay                        Matterhorn.Draw.ReactionEmojiListOverlay                        Matterhorn.Draw.RichText+                       Matterhorn.Draw.RichText.Wrap+                       Matterhorn.Draw.RichText.Flatten                        Matterhorn.Draw.ShowHelp                        Matterhorn.Draw.TabbedWindow                        Matterhorn.Draw.ThemeListOverlay@@ -88,6 +90,7 @@                        Matterhorn.Events.ThemeListOverlay                        Matterhorn.Events.UrlSelect                        Matterhorn.Events.UserListOverlay+                       Matterhorn.Events.Websocket                        Matterhorn.FilePaths                        Matterhorn.HelpTopics                        Matterhorn.IOUtil@@ -101,6 +104,7 @@                        Matterhorn.State.Async                        Matterhorn.State.Attachments                        Matterhorn.State.Autocomplete+                       Matterhorn.State.ChannelList                        Matterhorn.State.ChannelListOverlay                        Matterhorn.State.ChannelSelect                        Matterhorn.State.Channels@@ -121,11 +125,11 @@                        Matterhorn.State.Setup                        Matterhorn.State.Setup.Threads                        Matterhorn.State.Setup.Threads.Logging+                       Matterhorn.State.Teams                        Matterhorn.State.ThemeListOverlay                        Matterhorn.State.UrlSelect                        Matterhorn.State.UserListOverlay                        Matterhorn.State.Users-                       Matterhorn.TeamSelect                        Matterhorn.Themes                        Matterhorn.TimeUtils                        Matterhorn.Types@@ -150,7 +154,7 @@     ghc-options: -fhide-source-paths    build-depends:       base                 >=4.8      && <5-                     , mattermost-api       == 50200.9.0+                     , mattermost-api       == 50200.10.0                      , base-compat          >= 0.9     && < 0.12                      , unordered-containers >= 0.2     && < 0.3                      , containers           >= 0.5.7   && < 0.7@@ -164,9 +168,9 @@                      , config-ini           >= 0.2.2.0 && < 0.3                      , process              >= 1.4     && < 1.7                      , microlens-platform   >= 0.3     && < 0.5-                     , brick                >= 0.57    && < 0.58+                     , brick                >= 0.59    && < 0.60                      , brick-skylighting    >= 0.2     && < 0.4-                     , vty                  >= 5.31    && < 5.32+                     , vty                  >= 5.32    && < 5.33                      , word-wrap            >= 0.4.0   && < 0.5                      , transformers         >= 0.4     && < 0.6                      , text-zipper          >= 0.10    && < 0.11@@ -177,13 +181,15 @@                      , vector               < 0.13                      , strict               >= 0.3     && < 0.4                      , hashable             >= 1.2     && < 1.4-                     , cheapskate           >= 0.1     && < 0.2+                     , commonmark           >= 0.1.1.3 && < 0.2+                     , commonmark-extensions >= 0.2.0.4 && < 0.3+                     , parsec               >= 3.1     && < 3.2                      , utf8-string          >= 1.0     && < 1.1                      , temporary            >= 1.2     && < 1.4                      , gitrev               >= 1.3     && < 1.4                      , Hclip                >= 3.0     && < 3.1                      , mtl                  >= 2.2     && < 2.3-                     , aspell-pipe          >= 0.4     && < 0.5+                     , aspell-pipe          >= 0.6     && < 0.7                      , stm-delay            >= 0.1     && < 0.2                      , unix                 >= 2.7.1.0 && < 2.7.3.0                      , skylighting-core     >= 0.8     && < 0.9@@ -212,7 +218,7 @@ test-suite test_messages   type:               exitcode-stdio-1.0   main-is:            test_messages.hs-  other-modules:      Cheapskate_QCA+  other-modules:      RichText_QCA                     , Message_QCA   default-language:   Haskell2010   default-extensions: OverloadedStrings@@ -229,7 +235,7 @@                     , tasty-hunit          >= 0.9     && < 0.12                     , tasty-quickcheck     >= 0.8     && < 0.12                     , bytestring-                    , cheapskate+                    , commonmark                     , containers                     , matterhorn                     , mattermost-api

@@ -9,6 +9,7 @@  import           Brick import           Control.Monad.Trans.Except ( runExceptT )+import qualified Data.HashMap.Strict as HM import qualified Graphics.Vty as Vty import           Text.Aspell ( stopAspell ) import           GHC.Conc (getNumProcessors, setNumCapabilities)@@ -31,7 +32,7 @@ app :: App ChatState MHEvent Name app = App   { appDraw         = draw-  , appChooseCursor = \s cs -> case appMode s of+  , appChooseCursor = \s cs -> case s^.csCurrentTeam.tsMode of       Main                          -> showFirstCursor s cs       ChannelSelect                 -> showFirstCursor s cs       UserListOverlay               -> showFirstCursor s cs@@ -39,7 +40,8 @@       ChannelListOverlay            -> showFirstCursor s cs       ManageAttachmentsBrowseFiles  -> showFirstCursor s cs       ThemeListOverlay              -> showFirstCursor s cs-      ChannelTopicWindow            -> showCursorNamed ChannelTopicEditor cs+      ChannelTopicWindow            -> let tId = s^.csCurrentTeamId+                                       in showCursorNamed (ChannelTopicEditor tId) cs       LeaveChannelConfirm           -> Nothing       DeleteChannelConfirm          -> Nothing       MessageSelect                 -> Nothing@@ -87,9 +89,10 @@     (st, vty) <- setupState mkVty (optLogLocation opts) config     finalSt <- customMain vty mkVty (Just $ st^.csResources.crEventQueue) app st -    case finalSt^.csEditState.cedSpellChecker of-        Nothing -> return ()-        Just (s, _) -> stopAspell s+    forM_ (HM.elems $ finalSt^.csTeams) $ \ts ->+        case ts^.tsEditState.cedSpellChecker of+            Nothing -> return ()+            Just (s, _) -> stopAspell s      return finalSt @@ -99,11 +102,11 @@   logIfError (mmCloseSession $ getResourceSession $ finalSt^.csResources)       "Error in closing session" -  logIfError (writeHistory (finalSt^.csEditState.cedInputHistory))+  logIfError (writeHistory (finalSt^.csInputHistory))       "Error in writing history" -  logIfError (writeLastRunState finalSt)-      "Error in writing last run state"+  logIfError (writeLastRunStates finalSt)+      "Error in writing last run states"    shutdownLogManager $ finalSt^.csResources.crLogManager 

@@ -27,6 +27,7 @@ import           Matterhorn.Scripts import           Matterhorn.State.Help import           Matterhorn.State.Editing+import           Matterhorn.State.ChannelList import           Matterhorn.State.Channels import           Matterhorn.State.ChannelTopicWindow import           Matterhorn.State.ChannelSelect@@ -38,6 +39,7 @@ import           Matterhorn.State.Messages import           Matterhorn.State.NotifyPrefs import           Matterhorn.State.Common ( postInfoMessage )+import           Matterhorn.State.Teams import           Matterhorn.State.Users import           Matterhorn.Themes ( attrForUsername ) import           Matterhorn.Types@@ -97,58 +99,59 @@   [ Cmd "quit" "Exit Matterhorn" NoArg $ \ () -> requestQuit    , Cmd "right" "Focus on the next channel" NoArg $ \ () ->-      nextChannel+        nextChannel    , Cmd "left" "Focus on the previous channel" NoArg $ \ () ->-      prevChannel+        prevChannel    , Cmd "create-channel" "Create a new public channel"     (LineArg "channel name") $ \ name ->-      createOrdinaryChannel True name+        createOrdinaryChannel True name    , Cmd "create-private-channel" "Create a new private channel"     (LineArg "channel name") $ \ name ->-      createOrdinaryChannel False name+        createOrdinaryChannel False name    , Cmd "delete-channel" "Delete the current channel"     NoArg $ \ () ->-      beginCurrentChannelDeleteConfirm+        beginCurrentChannelDeleteConfirm    , Cmd "hide" "Hide the current DM or group channel from the channel list"     NoArg $ \ () -> do-      hideDMChannel =<< use csCurrentChannelId+        tId <- use csCurrentTeamId+        hideDMChannel =<< use (csCurrentChannelId tId)    , Cmd "reconnect" "Force a reconnection attempt to the server"     NoArg $ \ () ->-      connectWebsockets+        connectWebsockets    , Cmd "members" "Show the current channel's members"     NoArg $ \ () ->-      enterChannelMembersUserList+        enterChannelMembersUserList    , Cmd "leave" "Leave a normal channel or hide a DM channel" NoArg $ \ () ->-      startLeaveCurrentChannel+        startLeaveCurrentChannel    , Cmd "join" "Find a channel to join" NoArg $ \ () ->-      enterChannelListOverlayMode+        enterChannelListOverlayMode    , Cmd "join" "Join the specified channel" (ChannelArg NoArg) $ \(n, ()) ->-      joinChannelByName n+        joinChannelByName n    , Cmd "theme" "List the available themes" NoArg $ \ () ->-      enterThemeListMode+        enterThemeListMode    , Cmd "theme" "Set the color theme"     (TokenArg "theme" NoArg) $ \ (themeName, ()) ->-      setTheme themeName+        setTheme themeName    , Cmd "topic" "Set the current channel's topic (header) interactively"     NoArg $ \ () ->-      openChannelTopicWindow+        openChannelTopicWindow    , Cmd "topic" "Set the current channel's topic (header)"     (LineArg "topic") $ \ p ->-      if not (T.null p) then setChannelTopic p else return ()+        if not (T.null p) then setChannelTopic p else return ()    , Cmd "add-user" "Search for a user to add to the current channel"     NoArg $ \ () ->@@ -170,8 +173,9 @@     (UserArg $ LineArg "message or command") $ \ (name, msg) -> do         withFetchedUserMaybe (UserFetchByUsername name) $ \foundUser -> do             case foundUser of-                Just user -> createOrFocusDMChannel user $ Just $ \cId ->-                    handleInputSubmission cId msg+                Just user -> createOrFocusDMChannel user $ Just $ \cId -> do+                    tId <- use csCurrentTeamId+                    handleInputSubmission tId cId msg                 Nothing -> mhError $ NoSuchUser name    , Cmd "log-start" "Begin logging debug information to the specified path"@@ -240,28 +244,38 @@               Just topic -> showHelpScreen topic    , Cmd "sh" "List the available shell scripts" NoArg $ \ () ->-      listScripts+        listScripts    , Cmd "group-msg" "Create a group chat"-    (LineArg (userSigil <> "user [" <> userSigil <> "user ...]")) createGroupChannel+    (LineArg (userSigil <> "user [" <> userSigil <> "user ...]"))+        createGroupChannel    , Cmd "sh" "Run a prewritten shell script"     (TokenArg "script" (LineArg "message")) $ \ (script, text) -> do-        cId <- use csCurrentChannelId+        tId <- use csCurrentTeamId+        cId <- use (csCurrentChannelId tId)         findAndRunScript cId script text    , Cmd "flags" "Open a window of your flagged posts" NoArg $ \ () ->-      enterFlaggedPostListMode+        enterFlaggedPostListMode    , Cmd "pinned-posts" "Open a window of this channel's pinned posts" NoArg $ \ () ->-      enterPinnedPostListMode+        enterPinnedPostListMode    , Cmd "search" "Search for posts with given terms" (LineArg "terms") $-      enterSearchResultPostListMode+        enterSearchResultPostListMode    , Cmd "notify-prefs" "Edit the current channel's notification preferences" NoArg $ \_ ->-          enterEditNotifyPrefsMode+        enterEditNotifyPrefsMode +  , Cmd "rename-channel-url" "Rename the current channel's URL name" (TokenArg "channel name" NoArg) $ \ (name, _) ->+        renameChannelUrl name++  , Cmd "move-team-left" "Move the currently-selected team to the left in the team list" NoArg $ \_ ->+        moveCurrentTeamLeft++  , Cmd "move-team-right" "Move the currently-selected team to the right in the team list" NoArg $ \_ ->+        moveCurrentTeamRight   ]  displayUsernameAttribute :: Text -> MH ()@@ -273,10 +287,10 @@  execMMCommand :: Text -> Text -> MH () execMMCommand name rest = do-  cId      <- use csCurrentChannelId+  tId      <- use csCurrentTeamId+  cId      <- use (csCurrentChannelId tId)   session  <- getSession-  em       <- use (csEditState.cedEditMode)-  tId      <- gets myTeamId+  em       <- use (csCurrentTeam.tsEditState.cedEditMode)   let mc = MM.MinCommand              { MM.minComChannelId = cId              , MM.minComCommand   = "/" <> name <> " " <> rest@@ -335,4 +349,4 @@ toggleMessagePreview :: MH () toggleMessagePreview = do     mh invalidateCache-    csShowMessagePreview %= not+    csResources.crConfiguration.configShowMessagePreviewL %= not

@@ -4,14 +4,19 @@   , numScrollbackPosts   , previewMaxHeight   , normalChannelSigil+  , normalChannelSigilChar   , userSigil+  , userSigilChar+  , editMarking   ) where  import Prelude () import Matterhorn.Prelude +import qualified Data.Text as T + -- | The number of rows to consider a "page" when scrolling pageAmount :: Int pageAmount = 15@@ -29,7 +34,16 @@  -- Sigils normalChannelSigil :: Text-normalChannelSigil = "~"+normalChannelSigil = T.singleton normalChannelSigilChar +normalChannelSigilChar :: Char+normalChannelSigilChar = '~'+ userSigil :: Text-userSigil = "@"+userSigil = T.singleton userSigilChar++userSigilChar :: Char+userSigilChar = '@'++editMarking :: Text+editMarking = "(edited)"

@@ -27,7 +27,7 @@  draw :: ChatState -> [Widget Name] draw st =-    case appMode st of+    case st^.csCurrentTeam.tsMode of         Main                         -> mainLayers         UrlSelect                    -> mainLayers         ChannelSelect                -> mainLayers@@ -49,4 +49,4 @@     where         mainLayers = drawMain True st         mainLayersMonochrome = drawMain False st-        messageViewWindow = st^.csViewedMessage.singular _Just._2+        messageViewWindow = st^.csCurrentTeam.tsViewedMessage.singular _Just._2

@@ -24,7 +24,7 @@  autocompleteLayer :: ChatState -> Widget Name autocompleteLayer st =-    case st^.csEditState.cedAutocomplete of+    case st^.csCurrentTeam.tsEditState.cedAutocomplete of         Nothing ->             emptyWidget         Just ac ->@@ -64,7 +64,7 @@        else Widget Greedy Greedy $ do            ctx <- getContext            let rowOffset = ctx^.availHeightL - 3 - editorOffset - visibleHeight-               editorOffset = if st^.csEditState.cedEphemeral.eesMultiline+               editorOffset = if st^.csCurrentTeam.tsEditState.cedEphemeral.eesMultiline                               then multilineHeightLimit                               else 0            render $ translateBy (Location (0, rowOffset)) $

@@ -66,21 +66,22 @@         selfHeader = hCenter $                      colorUsername myUsername_ myUsername_                          (T.singleton statusSigil <> " " <> userSigil <> myUsername_)-        teamNameStr = sanitizeUserText $ MM.teamDisplayName $ st^.csMyTeam+        teamNameStr = T.strip $ sanitizeUserText $ MM.teamDisplayName $ st^.csCurrentTeam.tsTeam         statusSigil = maybe ' ' userSigilFromInfo me         me = userById (myUserId st) st         unreadCountHeader = hCenter $ txt $ "Unread: " <> (T.pack $ show unreadCount)-        unreadCount = sum $ (channelListGroupUnread . fst) <$> Z.toList (st^.csFocus)+        unreadCount = sum $ (channelListGroupUnread . fst) <$> Z.toList (st^.csCurrentTeam.tsFocus)  renderChannelList :: ChatState -> Widget Name renderChannelList st =-    viewport ChannelList Vertical body+    viewport (ChannelList tId) Vertical body     where         myUsername_ = myUsername st         renderEntry s e = renderChannelListEntry myUsername_ $ mkChannelEntryData s e-        body = case appMode st of+        tId = st^.csCurrentTeamId+        body = case st^.csCurrentTeam.tsMode of             ChannelSelect ->-                let zipper = st^.csChannelSelectState.channelSelectMatches+                let zipper = st^.csCurrentTeam.tsChannelSelectState.channelSelectMatches                     matches = if Z.isEmpty zipper                               then [hCenter $ txt "No matches"]                               else (renderChannelListGroup st@@ -90,10 +91,10 @@                    renderChannelListHeader st :                    matches             _ ->-                cached ChannelSidebar $+                cached (ChannelSidebar tId) $                 vBox $                 renderChannelListHeader st :-                (renderChannelListGroup st renderEntry <$> Z.toList (st^.csFocus))+                (renderChannelListGroup st renderEntry <$> Z.toList (st^.csCurrentTeam.tsFocus))  renderChannelListGroupHeading :: ChannelListGroup -> Widget Name renderChannelListGroupHeading g =

@@ -21,7 +21,7 @@  drawChannelListOverlay :: ChatState -> Widget Name drawChannelListOverlay st =-    let overlay = drawListOverlay (st^.csChannelListOverlay) channelSearchScopeHeader+    let overlay = drawListOverlay (st^.csCurrentTeam.tsChannelListOverlay) channelSearchScopeHeader                                   channelSearchScopeNoResults channelSearchScopePrompt                                   renderChannel                                   Nothing

@@ -32,23 +32,24 @@            withFocusRing foc (renderEditor drawTopicEditorTxt) ed          , hBorderWithLabel (withDefAttr clientEmphAttr $ txt "Preview")          , vLimit previewHeight $-           viewport ChannelTopicEditorPreview Vertical $+           viewport (ChannelTopicEditorPreview tId) Vertical $            renderText' (Just baseUrl) "" hSet topicTxtWithCursor          , hBorder          , hBox [ padRight Max $                   padLeft (Pad 1) $-                  drawButton foc ChannelTopicSaveButton "Save"+                  drawButton foc (ChannelTopicSaveButton tId) "Save"                 , padRight (Pad 1) $-                  drawButton foc ChannelTopicCancelButton "Cancel"+                  drawButton foc (ChannelTopicCancelButton tId) "Cancel"                 ]          ]     where-        baseUrl = serverBaseUrl st+        baseUrl = serverBaseUrl st tId+        tId = st^.csCurrentTeamId         editorHeight = 5         previewHeight = 5         maxWindowWidth = 70-        foc = st^.csChannelTopicDialog.channelTopicDialogFocus-        ed = st^.csChannelTopicDialog.channelTopicDialogEditor+        foc = st^.csCurrentTeam.tsChannelTopicDialog.channelTopicDialogFocus+        ed = st^.csCurrentTeam.tsChannelTopicDialog.channelTopicDialogEditor         hSet = getHighlightSet st         topicTxtWithCursor = T.unlines $                              getEditContents $

@@ -12,6 +12,7 @@ import           Brick.Widgets.Edit ( editContentsL, renderEditor, getEditContents ) import           Control.Arrow ( (>>>) ) import           Data.Char ( isSpace, isPunctuation )+import qualified Data.Foldable as F import           Data.List ( intersperse ) import qualified Data.Map as M import qualified Data.Sequence as Seq@@ -24,7 +25,8 @@ import           Lens.Micro.Platform ( (.~), (^?!), to, view, folding )  import           Network.Mattermost.Types ( ChannelId, Type(Direct, Private, Group)-                                          , ServerTime(..), UserId+                                          , ServerTime(..), UserId, TeamId, teamDisplayName+                                          , teamId                                           )  @@ -41,8 +43,11 @@ import           Matterhorn.Themes import           Matterhorn.TimeUtils ( justAfter, justBefore ) import           Matterhorn.Types+import           Matterhorn.Types.Common ( sanitizeUserText )+import           Matterhorn.Types.DirectionalSeq ( emptyDirSeq ) import           Matterhorn.Types.RichText ( parseMarkdown, TeamBaseURL ) import           Matterhorn.Types.KeyEvents+import qualified Matterhorn.Zipper as Z   previewFromInput :: TeamBaseURL -> Maybe MessageType -> UserId -> Text -> Maybe Message@@ -93,14 +98,14 @@ drawEditorContents :: ChatState -> HighlightSet -> [Text] -> Widget Name drawEditorContents st hs =     let noHighlight = txt . T.unlines-    in case st^.csEditState.cedSpellChecker of+    in case st^.csCurrentTeam.tsEditState.cedSpellChecker of         Nothing -> noHighlight         Just _ ->-            case S.null (st^.csEditState.cedMisspellings) of+            case S.null (st^.csCurrentTeam.tsEditState.cedMisspellings) of                 True -> noHighlight                 False -> doHighlightMisspellings                            hs-                           (st^.csEditState.cedMisspellings)+                           (st^.csCurrentTeam.tsEditState.cedMisspellings)  -- | This function takes a set of misspellings from the spell -- checker, the editor lines, and builds a rendering of the text with@@ -224,24 +229,25 @@  renderUserCommandBox :: ChatState -> HighlightSet -> Widget Name renderUserCommandBox st hs =-    let prompt = txt $ case st^.csEditState.cedEditMode of+    let prompt = txt $ case st^.csCurrentTeam.tsEditState.cedEditMode of             Replying _ _ -> "reply> "             Editing _ _  ->  "edit> "             NewPost      ->      "> "-        inputBox = renderEditor (drawEditorContents st hs) True (st^.csEditState.cedEditor)-        curContents = getEditContents $ st^.csEditState.cedEditor+        tId = st^.csCurrentTeamId+        inputBox = renderEditor (drawEditorContents st hs) True (st^.csCurrentTeam.tsEditState.cedEditor)+        curContents = getEditContents $ st^.csCurrentTeam.tsEditState.cedEditor         multilineContent = length curContents > 1         multilineHints =             hBox [ borderElem bsHorizontal                  , str $ "[" <> (show $ (+1) $ fst $ cursorPosition $-                                        st^.csEditState.cedEditor.editContentsL) <>+                                        st^.csCurrentTeam.tsEditState.cedEditor.editContentsL) <>                          "/" <> (show $ length curContents) <> "]"                  , hBorderWithLabel $ withDefAttr clientEmphAttr $                    txt $ "In multi-line mode. Press " <> multiLineToggleKey <>                          " to finish."                  ] -        replyDisplay = case st^.csEditState.cedEditMode of+        replyDisplay = case st^.csCurrentTeam.tsEditState.cedEditMode of             Replying msg _ ->                 let msgWithoutParent = msg & mInReplyToMsg .~ NotAReply                 in hBox [ replyArrow@@ -266,7 +272,7 @@          multiLineToggleKey = ppBinding $ getFirstDefaultBinding ToggleMultiLineEvent -        commandBox = case st^.csEditState.cedEphemeral.eesMultiline of+        commandBox = case st^.csCurrentTeam.tsEditState.cedEphemeral.eesMultiline of             False ->                 let linesStr = "line" <> if numLines == 1 then "" else "s"                     numLines = length curContents@@ -277,7 +283,7 @@                                          "; Enter: send, " <> T.unpack multiLineToggleKey <>                                          ": edit, Backspace: cancel] "                                  , txt $ head curContents-                                 , showCursor MessageInput (Location (0,0)) $ str " "+                                 , showCursor (MessageInput tId) (Location (0,0)) $ str " "                                  ]                             else [inputBox]             True -> vLimit multilineHeightLimit inputBox <=> multilineHints@@ -310,7 +316,7 @@             _ -> ""         maybeTopic = if T.null topicStr                      then ""-                     else " - " <> if st^.csShowExpandedChannelTopics+                     else " - " <> if st^.csResources.crConfiguration.configShowExpandedChannelTopicsL                                    then topicStr                                    else firstTopicLine         channelNameString = case chnType of@@ -326,7 +332,8 @@                 channelNamePair         channelNamePair = chanName <> " - " <> (chan^.ccInfo.cdDisplayName)         chanName = mkChannelName st (chan^.ccInfo)-        baseUrl = serverBaseUrl st+        tId = st^.csCurrentTeamId+        baseUrl = serverBaseUrl st tId      in renderText' (Just baseUrl) (myUsername st)          hs@@ -336,7 +343,7 @@ renderCurrentChannelDisplay st hs = header <=> hBorder <=> messages     where     header =-        if st^.csShowChannelList+        if st^.csResources.crConfiguration.configShowChannelListL         then channelHeader         else headerWithStatus @@ -366,7 +373,7 @@                 headerWidget = Widget Fixed Fixed $ return channelHeaderResult                 borderWidget = vLimit maxHeight vBorder -            render $ if appMode st == ChannelSelect+            render $ if st^.csCurrentTeam.tsMode == ChannelSelect                         then headerWidget                         else hBox $ case st^.csChannelListOrientation of                             ChannelListLeft ->@@ -387,11 +394,11 @@      messages = padTop Max chatText -    chatText = case appMode st of+    chatText = case st^.csCurrentTeam.tsMode of         MessageSelect ->-            renderMessagesWithSelect (st^.csMessageSelect) channelMessages+            renderMessagesWithSelect (st^.csCurrentTeam.tsMessageSelect) channelMessages         MessageSelectDeleteConfirm ->-            renderMessagesWithSelect (st^.csMessageSelect) channelMessages+            renderMessagesWithSelect (st^.csCurrentTeam.tsMessageSelect) channelMessages         _ ->             cached (ChannelMessages cId) $             renderLastMessages st hs editCutoff $@@ -422,15 +429,51 @@      cutoff = getNewMessageCutoff cId st     editCutoff = getEditedMessageCutoff cId st+    messageListing = getMessageListing cId st     channelMessages =-        insertTransitions (getMessageListing cId st)-                          cutoff-                          (getDateFormat st)-                          (st ^. timeZone)+        -- If the channel is empty, add an informative message to the+        -- message listing to make it explicit that this channel does+        -- not yet have any messages.+        if F.null messageListing+        then addMessage (emptyChannelFillerMessage st cId) emptyDirSeq+        else insertTransitions messageListing+                               cutoff+                               (getDateFormat st)+                               (st ^. timeZone) -    cId = st^.csCurrentChannelId+    tId = st^.csCurrentTeamId+    cId = st^.(csCurrentChannelId tId)     chan = st^.csCurrentChannel +-- | Construct a single message to be displayed in the specified channel+-- when it does not yet have any user messages posted to it.+emptyChannelFillerMessage :: ChatState -> ChannelId -> Message+emptyChannelFillerMessage st cId =+    newMessageOfType msg (C Informative) ts+    where+        -- This is a bogus timestamp, but its value does not matter+        -- because it is only used to create a message that will be+        -- shown in a channel with no date transitions (which would+        -- otherwise include this bogus date) or other messages (which+        -- would make for a broken message sorting).+        ts = ServerTime $ UTCTime (toEnum 0) 0+        Just chan = findChannelById cId (st^.csChannels)+        chanName = mkChannelName st (chan^.ccInfo)+        msg = case chan^.ccInfo.cdType of+            Direct ->+                let u = chan^.ccInfo.cdDMUserId >>= flip userById st+                in case u of+                    Nothing -> userMsg Nothing+                    Just _ -> userMsg (Just chanName)+            Group ->+                groupMsg (chan^.ccInfo.cdDisplayName)+            _ ->+                chanMsg chanName+        userMsg (Just cn) = "You have not yet sent any direct messages to " <> cn <> "."+        userMsg Nothing   = "You have not yet sent any direct messages to this user."+        groupMsg us = "There are not yet any direct messages in the group " <> us <> "."+        chanMsg cn = "There are not yet any messages in the " <> cn <> " channel."+ getMessageListing :: ChannelId -> ChatState -> Messages getMessageListing cId st =     st ^?! csChannels.folding (findChannelById cId) . ccContents . cdMessages . to (filterMessages isShown)@@ -456,7 +499,7 @@  renderChannelSelectPrompt :: ChatState -> Widget Name renderChannelSelectPrompt st =-    let e = st^.csChannelSelectState.channelSelectInput+    let e = st^.csCurrentTeam.tsChannelSelectState.channelSelectInput     in withDefAttr channelSelectPromptAttr $        (txt "Switch to channel [use ^ and $ to anchor]: ") <+>        (renderEditor (txt . T.concat) True e)@@ -470,6 +513,35 @@            , joinBorders $ mainInterface st            ] +teamList :: ChatState -> Widget Name+teamList st =+    let curTid = st^.csCurrentTeamId+        z = st^.csTeamZipper+        teams = (\tId -> st^.csTeam(tId)) <$> (concat $ snd <$> Z.toList z)+        entries = mkEntry <$> teams+        mkEntry ts =+            let tId = teamId $ _tsTeam ts+                unread = uCount > 0+                uCount = unreadCount tId+            in (if tId == curTid+                   then visible . withDefAttr currentTeamAttr+                   else if unread+                        then withDefAttr unreadChannelAttr+                        else id) $+               txt $+               (T.strip $ sanitizeUserText $ teamDisplayName $ _tsTeam ts)+        unreadCount tId = sum $ fmap (nonDMChannelListGroupUnread . fst) $+                          Z.toList $ st^.csTeam(tId).tsFocus+    in if length teams == 1+       then emptyWidget+       else vBox [ hBox [ padRight (Pad 1) $ txt "Teams:"+                        , vLimit 1 $ viewport TeamList Horizontal $+                          hBox $+                          intersperse (txt " ") entries+                        ]+                 , hBorder+                 ]+ connectionLayer :: ChatState -> Widget Name connectionLayer st =     case st^.csConnectionStatus of@@ -504,7 +576,7 @@                 hasVerb = isJust (findVerbatimChunk (postMsg^.mText))                 -- make sure these keybinding pieces are up-to-date!                 ev e =-                  let keyconf = st^.csResources.crConfiguration.to configUserKeys+                  let keyconf = st^.csResources.crConfiguration.configUserKeysL                       KeyHandlerMap keymap = messageSelectKeybindings keyconf                   in T.intercalate ","                        [ ppBinding (eventToBinding k)@@ -575,21 +647,22 @@                     , hBorder                     ] -maybePreviewViewport :: Widget Name -> Widget Name-maybePreviewViewport w =+maybePreviewViewport :: TeamId -> Widget Name -> Widget Name+maybePreviewViewport tId w =     Widget Greedy Fixed $ do         result <- render w         case (Vty.imageHeight $ result^.imageL) > previewMaxHeight of             False -> return result             True ->-                render $ vLimit previewMaxHeight $ viewport MessagePreviewViewport Vertical $+                render $ vLimit previewMaxHeight $ viewport (MessagePreviewViewport tId) Vertical $                          (Widget Fixed Fixed $ return result)  inputPreview :: ChatState -> HighlightSet -> Widget Name-inputPreview st hs | not $ st^.csShowMessagePreview = emptyWidget+inputPreview st hs | not $ st^.csResources.crConfiguration.configShowMessagePreviewL = emptyWidget                    | otherwise = thePreview     where     uId = myUserId st+    tId = st^.csCurrentTeamId     -- Insert a cursor sentinel into the input text just before     -- rendering the preview. We use the inserted sentinel (which is     -- not rendered) to get brick to ensure that the line the cursor is@@ -600,12 +673,12 @@     -- end of whatever line the user is editing, that is very unlikely     -- to be a problem.     curContents = getText $ (gotoEOL >>> insertChar cursorSentinel) $-                  st^.csEditState.cedEditor.editContentsL+                  st^.csCurrentTeam.tsEditState.cedEditor.editContentsL     curStr = T.intercalate "\n" curContents-    overrideTy = case st^.csEditState.cedEditMode of+    overrideTy = case st^.csCurrentTeam.tsEditState.cedEditMode of         Editing _ ty -> Just ty         _ -> Nothing-    baseUrl = serverBaseUrl st+    baseUrl = serverBaseUrl st tId     previewMsg = previewFromInput baseUrl overrideTy uId curStr     thePreview = let noPreview = str "(No preview)"                      msgPreview = case previewMsg of@@ -629,12 +702,12 @@                                   , mdMyUsername        = myUsername st                                   , mdWrapNonhighlightedCodeBlocks = True                                   }-                 in (maybePreviewViewport msgPreview) <=>+                 in (maybePreviewViewport tId msgPreview) <=>                     hBorderWithLabel (withDefAttr clientEmphAttr $ str "[Preview ↑]")  userInputArea :: ChatState -> HighlightSet -> Widget Name userInputArea st hs =-    case appMode st of+    case st^.csCurrentTeam.tsMode of         ChannelSelect -> renderChannelSelectPrompt st         UrlSelect     -> hCenter $ hBox [ txt "Press "                                         , withDefAttr clientEmphAttr $ txt "Enter"@@ -651,13 +724,13 @@  mainInterface :: ChatState -> Widget Name mainInterface st =-    vBox [ body-         , bottomBorder-         , inputPreview st hs-         , userInputArea st hs+    vBox [ teamList st+         , body          ]     where-    body = if st^.csShowChannelList || appMode st == ChannelSelect+    showChannelList = st^.csResources.crConfiguration.configShowChannelListL ||+                      st^.csCurrentTeam.tsMode == ChannelSelect+    body = if showChannelList            then case st^.csChannelListOrientation of                ChannelListLeft ->                    hBox [channelList, vBorder, mainDisplay]@@ -667,11 +740,17 @@     channelList = hLimit channelListWidth (renderChannelList st)     hs = getHighlightSet st     channelListWidth = configChannelListWidth $ st^.csResources.crConfiguration-    mainDisplay = case appMode st of+    mainDisplay =+        vBox [ channelContents+             , bottomBorder+             , inputPreview st hs+             , userInputArea st hs+             ]+    channelContents = case st^.csCurrentTeam.tsMode of         UrlSelect -> renderUrlList st         _         -> maybeSubdue $ renderCurrentChannelDisplay st hs -    bottomBorder = case appMode st of+    bottomBorder = case st^.csCurrentTeam.tsMode of         MessageSelect -> messageSelectBottomBar st         _ -> maybeSubdue $ hBox              [ showAttachmentCount@@ -681,7 +760,7 @@              ]      showAttachmentCount =-        let count = length $ listElements $ st^.csEditState.cedAttachmentList+        let count = length $ listElements $ st^.csCurrentTeam.tsEditState.cedAttachmentList         in if count == 0            then emptyWidget            else hBox [ borderElem bsHorizontal@@ -709,7 +788,7 @@                  Just Nothing -> hLimit 2 hBorder <+> txt "*"                  Nothing -> emptyWidget -    maybeSubdue = if appMode st == ChannelSelect+    maybeSubdue = if st^.csCurrentTeam.tsMode == ChannelSelect                   then forceAttr ""                   else id 

@@ -23,7 +23,7 @@ drawManageAttachments st =     topLayer     where-        topLayer = case appMode st of+        topLayer = case st^.csCurrentTeam.tsMode of             ManageAttachments -> drawAttachmentList st             ManageAttachmentsBrowseFiles -> drawFileBrowser st             _ -> error "BUG: drawManageAttachments called in invalid mode"@@ -39,7 +39,7 @@        vLimit 15 $        joinBorders $        borderWithLabel (withDefAttr clientEmphAttr $ txt "Attachments") $-       vBox [ renderList renderAttachmentItem True (st^.csEditState.cedAttachmentList)+       vBox [ renderList renderAttachmentItem True (st^.csCurrentTeam.tsEditState.cedAttachmentList)             , hBorder             , hCenter $ withDefAttr clientMessageAttr $                         txt $ addBinding <> ":add " <>@@ -61,4 +61,4 @@     -- invariant: cedFileBrowser is not Nothing if appMode is     -- ManageAttachmentsBrowseFiles, and that is the only way to reach     -- this code, ergo the fromJust.-    FB.renderFileBrowser True $ fromJust (st^.csEditState.cedFileBrowser)+    FB.renderFileBrowser True $ fromJust (st^.csCurrentTeam.tsEditState.cedFileBrowser)

@@ -1,9 +1,14 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} module Matterhorn.Draw.Messages-  ( nameForUserRef+  ( MessageData(..)+  , renderMessage+  , nameForUserRef   , renderSingleMessage   , unsafeRenderMessageSelection   , renderLastMessages+  , addEllipsis   ) where @@ -11,8 +16,18 @@ import           Brick.Widgets.Border import           Control.Monad.Trans.Reader ( withReaderT ) import qualified Data.Foldable as F-import qualified Graphics.Vty as Vty+import qualified Data.Map.Strict as Map+import qualified Data.Sequence as S+import           Data.Sequence ( ViewL(..)+                               , ViewR(..)+                               , (|>)+                               , viewl+                               , viewr)+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Graphics.Vty as V import           Lens.Micro.Platform ( (.~), to )+import           Network.Mattermost.Lenses ( postEditAtL, postCreateAtL ) import           Network.Mattermost.Types ( ServerTime(..), userUsername ) import           Prelude () import           Matterhorn.Prelude@@ -21,6 +36,7 @@ import           Matterhorn.Draw.RichText import           Matterhorn.Themes import           Matterhorn.Types+import           Matterhorn.Types.RichText import           Matterhorn.Types.DirectionalSeq  maxMessageHeight :: Int@@ -124,23 +140,23 @@         upperHeight = targetHeight `div` 2         lowerHeight = targetHeight - upperHeight -        lowerRender img (m, tState) = render1HLimit doMsgRender Vty.vertJoin targetHeight img tState m-        upperRender img (m, tState) = render1HLimit doMsgRender (flip Vty.vertJoin) targetHeight img tState m+        lowerRender img (m, tState) = render1HLimit doMsgRender V.vertJoin targetHeight img tState m+        upperRender img (m, tState) = render1HLimit doMsgRender (flip V.vertJoin) targetHeight img tState m -    lowerHalf <- foldM lowerRender Vty.emptyImage after-    upperHalf <- foldM upperRender Vty.emptyImage before+    lowerHalf <- foldM lowerRender V.emptyImage after+    upperHalf <- foldM upperRender V.emptyImage before -    let curHeight = Vty.imageHeight $ curMsgResult^.imageL-        uncropped = upperHalf Vty.<-> curMsgResult^.imageL Vty.<-> lowerHalf-        img = if | Vty.imageHeight lowerHalf < (lowerHeight - curHeight) ->-                     Vty.cropTop targetHeight uncropped-                 | Vty.imageHeight upperHalf < upperHeight ->-                     Vty.cropBottom targetHeight uncropped+    let curHeight = V.imageHeight $ curMsgResult^.imageL+        uncropped = upperHalf V.<-> curMsgResult^.imageL V.<-> lowerHalf+        img = if | V.imageHeight lowerHalf < (lowerHeight - curHeight) ->+                     V.cropTop targetHeight uncropped+                 | V.imageHeight upperHalf < upperHeight ->+                     V.cropBottom targetHeight uncropped                  | otherwise ->-                     Vty.cropTop upperHeight upperHalf Vty.<-> curMsgResult^.imageL Vty.<->+                     V.cropTop upperHeight upperHalf V.<-> curMsgResult^.imageL V.<->                         (if curHeight < lowerHeight-                          then Vty.cropBottom (lowerHeight - curHeight) lowerHalf-                          else Vty.cropBottom lowerHeight lowerHalf)+                          then V.cropBottom (lowerHeight - curHeight) lowerHalf+                          else V.cropBottom lowerHeight lowerHalf)     return $ emptyResult & imageL .~ img  renderLastMessages :: ChatState@@ -159,51 +175,253 @@              isBelow m transition = m^.mDate > transition^.mDate -            go :: Vty.Image -> DirectionalSeq Retrograde (Message, ThreadState) -> RenderM Name Vty.Image+            go :: V.Image -> DirectionalSeq Retrograde (Message, ThreadState) -> RenderM Name V.Image             go img ms | messagesLength ms == 0 = return img             go img ms = do                 let Just (m, threadState) = messagesHead ms                     newMessagesAbove = maybe False (isBelow m) newMessageTransition-                newImg <- render1HLimit doMsgRender (flip Vty.vertJoin) targetHeight img threadState m+                newImg <- render1HLimit doMsgRender (flip V.vertJoin) targetHeight img threadState m                 -- If the new message fills the window, check whether                 -- there is still a "New Messages" transition that is                 -- not displayed. If there is, then we need to replace                 -- the top line of the new image with a "New Messages"                 -- indicator.-                if Vty.imageHeight newImg >= targetHeight && newMessagesAbove+                if V.imageHeight newImg >= targetHeight && newMessagesAbove                 then do                     transitionResult <- render $ withDefAttr newMessageTransitionAttr $                                                  hBorderWithLabel (txt "New Messages ↑")-                    let newImg2 = Vty.vertJoin (transitionResult^.imageL)-                                               (Vty.cropTop (targetHeight - 1) newImg)+                    let newImg2 = V.vertJoin (transitionResult^.imageL)+                                               (V.cropTop (targetHeight - 1) newImg)                     return newImg2                 else go newImg $ messagesDrop 1 ms -        img <- go Vty.emptyImage msgs-        return $ emptyResult & imageL .~ (Vty.cropTop targetHeight img)+        img <- go V.emptyImage msgs+        return $ emptyResult & imageL .~ (V.cropTop targetHeight img)  relaxHeight :: Context -> Context relaxHeight c = c & availHeightL .~ (max maxMessageHeight (c^.availHeightL))  render1HLimit :: (Message -> ThreadState -> Widget Name)-              -> (Vty.Image -> Vty.Image -> Vty.Image)+              -> (V.Image -> V.Image -> V.Image)               -> Int-              -> Vty.Image+              -> V.Image               -> ThreadState               -> Message-              -> RenderM Name Vty.Image+              -> RenderM Name V.Image render1HLimit doMsgRender fjoin lim img threadState msg-  | Vty.imageHeight img >= lim = return img+  | V.imageHeight img >= lim = return img   | otherwise = fjoin img <$> render1 doMsgRender threadState msg  render1 :: (Message -> ThreadState -> Widget Name)         -> ThreadState         -> Message-        -> RenderM Name Vty.Image+        -> RenderM Name V.Image render1 doMsgRender threadState msg = case msg^.mDeleted of-    True -> return Vty.emptyImage+    True -> return V.emptyImage     False -> do         r <- withReaderT relaxHeight $              render $ padRight Max $              doMsgRender msg threadState         return $ r^.imageL++-- | A bundled structure that includes all the information necessary+-- to render a given message+data MessageData =+    MessageData { mdEditThreshold :: Maybe ServerTime+                -- ^ If specified, any messages edited before this point+                -- in time are not indicated as edited.+                , mdShowOlderEdits :: Bool+                -- ^ Indicates whether "edited" markers should be shown+                -- for old messages (i.e., ignore the mdEditThreshold+                -- value).+                , mdShowReactions :: Bool+                -- ^ Whether to render reactions.+                , mdMessage :: Message+                -- ^ The message to render.+                , mdUserName :: Maybe Text+                -- ^ The username of the message's author, if any. This+                -- is passed here rather than obtaining from the message+                -- because we need to do lookups in the ChatState to+                -- compute this, and we don't pass the ChatState into+                -- renderMessage.+                , mdParentMessage :: Maybe Message+                -- ^ The parent message of this message, if any.+                , mdParentUserName :: Maybe Text+                -- ^ The author of the parent message, if any.+                , mdThreadState :: ThreadState+                -- ^ The thread state of this message.+                , mdRenderReplyParent :: Bool+                -- ^ Whether to render the parent message.+                , mdHighlightSet :: HighlightSet+                -- ^ The highlight set to use to highlight usernames,+                -- channel names, etc.+                , mdIndentBlocks :: Bool+                -- ^ Whether to indent the message underneath the+                -- author's name (True) or just display it to the right+                -- of the author's name (False).+                , mdMessageWidthLimit :: Maybe Int+                -- ^ A width override to use to wrap non-code blocks+                -- and code blocks without syntax highlighting. If+                -- unspecified, all blocks in the message will be+                -- wrapped and truncated at the width specified by the+                -- rendering context. If specified, all non-code blocks+                -- will be wrapped at this width and highlighted code+                -- blocks will be rendered using the context's width.+                , mdMyUsername :: Text+                -- ^ The username of the user running Matterhorn.+                , mdWrapNonhighlightedCodeBlocks :: Bool+                -- ^ Whether to wrap text in non-highlighted code+                -- blocks.+                }++-- | renderMessage performs markdown rendering of the specified message.+renderMessage :: MessageData -> Widget Name+renderMessage md@MessageData { mdMessage = msg, .. } =+    let msgUsr = case mdUserName of+          Just u -> if omittedUsernameType (msg^.mType) then Nothing else Just u+          Nothing -> Nothing+        botElem = if isBotMessage msg then txt "[BOT]" else emptyWidget+        nameElems = case msgUsr of+          Just un+            | isEmote msg ->+                [ withDefAttr pinnedMessageIndicatorAttr $ txt $ if msg^.mPinned then "[PIN]" else ""+                , txt $ (if msg^.mFlagged then "[!] " else "") <> "*"+                , colorUsername mdMyUsername un un+                , botElem+                , txt " "+                ]+            | otherwise ->+                [ withDefAttr pinnedMessageIndicatorAttr $ txt $ if msg^.mPinned then "[PIN] " else ""+                , colorUsername mdMyUsername un un+                , botElem+                , txt $ (if msg^.mFlagged then "[!]" else "") <> ": "+                ]+          Nothing -> []++        -- Use the editing threshold to determine whether to append an+        -- editing indication to this message.+        maybeAugment bs = case msg^.mOriginalPost of+            Nothing -> bs+            Just p ->+                if p^.postEditAtL > p^.postCreateAtL+                then case mdEditThreshold of+                    Just cutoff | p^.postEditAtL >= cutoff ->+                        addEditSentinel (EEditSentinel True) bs+                    _ -> if mdShowOlderEdits+                         then addEditSentinel (EEditSentinel False) bs+                         else bs+                else bs++        augmentedText = unBlocks $ maybeAugment $ msg^.mText+        msgWidget =+            vBox $ (layout mdHighlightSet mdMessageWidthLimit nameElems augmentedText . viewl) augmentedText :+                   catMaybes [msgAtch, msgReac]+        replyIndent = Widget Fixed Fixed $ do+            ctx <- getContext+            -- NB: The amount subtracted here must be the total padding+            -- added below (pad 1 + vBorder)+            w <- render $ hLimit (ctx^.availWidthL - 2) msgWidget+            render $ vLimit (V.imageHeight $ w^.imageL) $+                padRight (Pad 1) vBorder <+> (Widget Fixed Fixed $ return w)+        msgAtch = if S.null (msg^.mAttachments)+          then Nothing+          else Just $ withDefAttr clientMessageAttr $ vBox+                 [ txt ("  [attached: `" <> a^.attachmentName <> "`]")+                 | a <- toList (msg^.mAttachments)+                 ]+        msgReac = if Map.null (msg^.mReactions) || (not mdShowReactions)+          then Nothing+          else let renderR e us =+                       let n = Set.size us+                       in if | n == 1    -> " [" <> e <> "]"+                             | n > 1     -> " [" <> e <> " " <> T.pack (show n) <> "]"+                             | otherwise -> ""+                   reactionMsg = Map.foldMapWithKey renderR (msg^.mReactions)+               in Just $ withDefAttr emojiAttr $ txt ("   " <> reactionMsg)+        withParent p =+            case mdThreadState of+                NoThread -> msgWidget+                InThreadShowParent -> p <=> replyIndent+                InThread -> replyIndent+    in if not mdRenderReplyParent+       then msgWidget+       else case msg^.mInReplyToMsg of+          NotAReply -> msgWidget+          InReplyTo _ ->+              case mdParentMessage of+                  Nothing -> withParent (str "[loading...]")+                  Just pm ->+                      let parentMsg = renderMessage md+                            { mdShowOlderEdits    = False+                            , mdMessage           = pm+                            , mdUserName          = mdParentUserName+                            , mdParentMessage     = Nothing+                            , mdRenderReplyParent = False+                            , mdIndentBlocks      = False+                            }+                      in withParent (addEllipsis $ forceAttr replyParentAttr parentMsg)++    where+        layout :: HighlightSet -> Maybe Int -> [Widget Name] -> Seq Block+               -> ViewL Block -> Widget Name+        layout hs w nameElems bs xs | length xs > 1     = multiLnLayout hs w nameElems bs+        layout hs w nameElems bs (Blockquote {} :< _) = multiLnLayout hs w nameElems bs+        layout hs w nameElems bs (CodeBlock {} :< _)  = multiLnLayout hs w nameElems bs+        layout hs w nameElems bs (HTMLBlock {} :< _)  = multiLnLayout hs w nameElems bs+        layout hs w nameElems bs (List {} :< _)       = multiLnLayout hs w nameElems bs+        layout hs w nameElems bs (Para inlns :< _)+            | F.any breakCheck (unInlines inlns)      = multiLnLayout hs w nameElems bs+        layout hs w nameElems bs _                    = nameNextToMessage hs w nameElems bs++        multiLnLayout hs w nameElems bs =+            if mdIndentBlocks+               then vBox [ hBox nameElems+                         , hBox [txt "  ", renderRichText mdMyUsername hs ((subtract 2) <$> w)+                                                 mdWrapNonhighlightedCodeBlocks (Blocks bs)]+                         ]+               else nameNextToMessage hs w nameElems bs++        nameNextToMessage hs w nameElems bs =+            Widget Fixed Fixed $ do+                nameResult <- render $ hBox nameElems+                let newW = subtract (V.imageWidth (nameResult^.imageL)) <$> w+                render $ hBox [ raw (nameResult^.imageL)+                              , renderRichText mdMyUsername hs newW mdWrapNonhighlightedCodeBlocks (Blocks bs)+                              ]++        breakCheck i = i `elem` [ELineBreak, ESoftBreak]++-- Add the edit sentinel to the end of the last block in the sequence.+-- If the last block is a paragraph, append it to that paragraph.+-- Otherwise, append a new block so it appears beneath the last+-- block-level element.+addEditSentinel :: Inline -> Blocks -> Blocks+addEditSentinel d (Blocks bs) =+    case viewr bs of+        EmptyR -> Blocks bs+        (rest :> b) -> Blocks rest <> appendEditSentinel d b++appendEditSentinel :: Inline -> Block -> Blocks+appendEditSentinel sentinel b =+    let s = Para (Inlines $ S.singleton sentinel)+    in Blocks $ case b of+        Para is -> S.singleton $ Para (Inlines $ unInlines is |> ESpace |> sentinel)+        _ -> S.fromList [b, s]++omittedUsernameType :: MessageType -> Bool+omittedUsernameType = \case+    CP Join -> True+    CP Leave -> True+    CP TopicChange -> True+    _ -> False++addEllipsis :: Widget a -> Widget a+addEllipsis w = Widget (hSize w) (vSize w) $ do+    ctx <- getContext+    let aw = ctx^.availWidthL+    result <- render w+    let withEllipsis = (hLimit (aw - 3) $ vLimit 1 $ (Widget Fixed Fixed $ return result)) <+>+                       str "..."+    if (V.imageHeight (result^.imageL) > 1) || (V.imageWidth (result^.imageL) == aw) then+        render withEllipsis else+        return result

@@ -19,7 +19,7 @@  drawNotifyPrefs :: ChatState -> Widget Name drawNotifyPrefs st =-    let Just form = st^.csNotifyPrefs+    let Just form = st^.csCurrentTeam.tsNotifyPrefs         label = forceAttr clientEmphAttr $ str "Notification Preferences"         formKeys = withDefAttr clientEmphAttr <$> txt <$> ["Tab", "BackTab"]         bindings = vBox $ hCenter <$> [ renderKeybindingHelp "Save" [FormSubmitEvent] <+> txt "  " <+>

@@ -54,7 +54,7 @@             else " (" <> (T.pack . show . length) messages <> "): " <> terms          messages = insertDateMarkers-                     (filterMessages knownChannel $ st^.csPostListOverlay.postListPosts)+                     (filterMessages knownChannel $ st^.csCurrentTeam.tsPostListOverlay.postListPosts)                      (getDateFormat st)                      (st^.timeZone) @@ -100,7 +100,7 @@         -- The full message list, rendered with the current selection         renderedMessageList =           let (s, (before, after)) = splitDirSeqOn matchesMessage messagesWithStates-              matchesMessage (m, _) = m^.mMessageId == (MessagePostId <$> st^.csPostListOverlay.postListSelected)+              matchesMessage (m, _) = m^.mMessageId == (MessagePostId <$> st^.csCurrentTeam.tsPostListOverlay.postListSelected)               messagesWithStates = (, InThreadShowParent) <$> messages           in case s of             Nothing ->

@@ -17,7 +17,7 @@  drawReactionEmojiListOverlay :: ChatState -> Widget Name drawReactionEmojiListOverlay st =-    let overlay = drawListOverlay (st^.csReactionEmojiListOverlay)+    let overlay = drawListOverlay (st^.csCurrentTeam.tsReactionEmojiListOverlay)                                   (const $ txt "Search Emoji")                                   (const $ txt "No matching emoji found.")                                   (const $ txt "Search emoji:")

@@ -1,17 +1,11 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ParallelListComp #-}-{-# LANGUAGE RecordWildCards #-} module Matterhorn.Draw.RichText-  ( MessageData(..)-  , renderRichText-  , renderMessage+  ( renderRichText   , renderText   , renderText'-  , renderElementSeq   , cursorSentinel-  , addEllipsis   , findVerbatimChunk   ) where@@ -20,286 +14,67 @@ import           Matterhorn.Prelude  import           Brick ( (<+>), Widget, hLimit, imageL-                       , raw, render, Size(..), Widget(..)+                       , render, Size(..), Widget(..)                        ) import qualified Brick as B import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Skylighting as BS import           Control.Monad.Reader import qualified Data.Foldable as F-import qualified Data.Map.Strict as Map-import qualified Data.Sequence as Seq+import qualified Data.Sequence as S import           Data.Sequence ( ViewL(..)-                               , ViewR(..)                                , (<|)-                               , (|>)                                , viewl-                               , viewr)-import qualified Data.Sequence as S-import qualified Data.Set as Set+                               ) import qualified Data.Text as T import qualified Graphics.Vty as V import qualified Skylighting.Core as Sky -import           Network.Mattermost.Lenses ( postEditAtL, postCreateAtL )-import           Network.Mattermost.Types ( ServerTime(..), PostId )--import           Matterhorn.Constants ( normalChannelSigil, userSigil )+import           Matterhorn.Constants ( normalChannelSigil, userSigil, editMarking )+import           Matterhorn.Draw.RichText.Flatten+import           Matterhorn.Draw.RichText.Wrap import           Matterhorn.Themes-import           Matterhorn.Types ( Name, HighlightSet(..) )-import           Matterhorn.Types.Messages-import           Matterhorn.Types.Posts+import           Matterhorn.Types ( HighlightSet(..), emptyHSet ) import           Matterhorn.Types.RichText  -emptyHSet :: HighlightSet-emptyHSet = HighlightSet Set.empty Set.empty mempty--omittedUsernameType :: MessageType -> Bool-omittedUsernameType = \case-  CP Join -> True-  CP Leave -> True-  CP TopicChange -> True-  _ -> False---- Add the edit sentinel to the end of the last block in the sequence.--- If the last block is a paragraph, append it to that paragraph.--- Otherwise, append a new block so it appears beneath the last--- block-level element.-addEditSentinel :: ElementData -> Seq RichTextBlock -> Seq RichTextBlock-addEditSentinel d bs =-    case viewr bs of-        EmptyR -> bs-        (rest :> b) -> rest <> appendEditSentinel d b--appendEditSentinel :: ElementData -> RichTextBlock -> Seq RichTextBlock-appendEditSentinel sentinel b =-    let s = Para (S.singleton m)-        m = Element Normal sentinel-    in case b of-        Para is -> S.singleton $ Para (is |> Element Normal ESpace |> m)-        _ -> S.fromList [b, s]---- | A bundled structure that includes all the information necessary--- to render a given message-data MessageData =-    MessageData { mdEditThreshold :: Maybe ServerTime-                -- ^ If specified, any messages edited before this point-                -- in time are not indicated as edited.-                , mdShowOlderEdits :: Bool-                -- ^ Indicates whether "edited" markers should be shown-                -- for old messages (i.e., ignore the mdEditThreshold-                -- value).-                , mdShowReactions :: Bool-                -- ^ Whether to render reactions.-                , mdMessage :: Message-                -- ^ The message to render.-                , mdUserName :: Maybe Text-                -- ^ The username of the message's author, if any. This-                -- is passed here rather than obtaining from the message-                -- because we need to do lookups in the ChatState to-                -- compute this, and we don't pass the ChatState into-                -- renderMessage.-                , mdParentMessage :: Maybe Message-                -- ^ The parent message of this message, if any.-                , mdParentUserName :: Maybe Text-                -- ^ The author of the parent message, if any.-                , mdThreadState :: ThreadState-                -- ^ The thread state of this message.-                , mdRenderReplyParent :: Bool-                -- ^ Whether to render the parent message.-                , mdHighlightSet :: HighlightSet-                -- ^ The highlight set to use to highlight usernames,-                -- channel names, etc.-                , mdIndentBlocks :: Bool-                -- ^ Whether to indent the message underneath the-                -- author's name (True) or just display it to the right-                -- of the author's name (False).-                , mdMessageWidthLimit :: Maybe Int-                -- ^ A width override to use to wrap non-code blocks-                -- and code blocks without syntax highlighting. If-                -- unspecified, all blocks in the message will be-                -- wrapped and truncated at the width specified by the-                -- rendering context. If specified, all non-code blocks-                -- will be wrapped at this width and highlighted code-                -- blocks will be rendered using the context's width.-                , mdMyUsername :: Text-                -- ^ The username of the user running Matterhorn.-                , mdWrapNonhighlightedCodeBlocks :: Bool-                -- ^ Whether to wrap text in non-highlighted code-                -- blocks.-                }---- | renderMessage performs markdown rendering of the specified message.-renderMessage :: MessageData -> Widget Name-renderMessage md@MessageData { mdMessage = msg, .. } =-    let msgUsr = case mdUserName of-          Just u -> if omittedUsernameType (msg^.mType) then Nothing else Just u-          Nothing -> Nothing-        botElem = if isBotMessage msg then B.txt "[BOT]" else B.emptyWidget-        nameElems = case msgUsr of-          Just un-            | isEmote msg ->-                [ B.withDefAttr pinnedMessageIndicatorAttr $ B.txt $ if msg^.mPinned then "[PIN]" else ""-                , B.txt $ (if msg^.mFlagged then "[!] " else "") <> "*"-                , colorUsername mdMyUsername un un-                , botElem-                , B.txt " "-                ]-            | otherwise ->-                [ B.withDefAttr pinnedMessageIndicatorAttr $ B.txt $ if msg^.mPinned then "[PIN] " else ""-                , colorUsername mdMyUsername un un-                , botElem-                , B.txt $ (if msg^.mFlagged then "[!]" else "") <> ": "-                ]-          Nothing -> []--        -- Use the editing threshold to determine whether to append an-        -- editing indication to this message.-        maybeAugment bs = case msg^.mOriginalPost of-            Nothing -> bs-            Just p ->-                if p^.postEditAtL > p^.postCreateAtL-                then case mdEditThreshold of-                    Just cutoff | p^.postEditAtL >= cutoff ->-                        addEditSentinel (EEditSentinel True) bs-                    _ -> if mdShowOlderEdits-                         then addEditSentinel (EEditSentinel False) bs-                         else bs-                else bs--        augmentedText = maybeAugment $ msg^.mText-        msgWidget =-            vBox $ (layout mdHighlightSet mdMessageWidthLimit nameElems augmentedText . viewl) augmentedText :-                   catMaybes [msgAtch, msgReac]-        replyIndent = B.Widget B.Fixed B.Fixed $ do-            ctx <- B.getContext-            -- NB: The amount subtracted here must be the total padding-            -- added below (pad 1 + vBorder)-            w <- B.render $ B.hLimit (ctx^.B.availWidthL - 2) msgWidget-            B.render $ B.vLimit (V.imageHeight $ w^.B.imageL) $-                B.padRight (B.Pad 1) B.vBorder B.<+> (B.Widget B.Fixed B.Fixed $ return w)-        msgAtch = if Seq.null (msg^.mAttachments)-          then Nothing-          else Just $ B.withDefAttr clientMessageAttr $ vBox-                 [ B.txt ("  [attached: `" <> a^.attachmentName <> "`]")-                 | a <- toList (msg^.mAttachments)-                 ]-        msgReac = if Map.null (msg^.mReactions) || (not mdShowReactions)-          then Nothing-          else let renderR e us =-                       let n = Set.size us-                       in if | n == 1    -> " [" <> e <> "]"-                             | n > 1     -> " [" <> e <> " " <> T.pack (show n) <> "]"-                             | otherwise -> ""-                   reactionMsg = Map.foldMapWithKey renderR (msg^.mReactions)-               in Just $ B.withDefAttr emojiAttr $ B.txt ("   " <> reactionMsg)-        withParent p =-            case mdThreadState of-                NoThread -> msgWidget-                InThreadShowParent -> p B.<=> replyIndent-                InThread -> replyIndent-    in if not mdRenderReplyParent-       then msgWidget-       else case msg^.mInReplyToMsg of-          NotAReply -> msgWidget-          InReplyTo _ ->-              case mdParentMessage of-                  Nothing -> withParent (B.str "[loading...]")-                  Just pm ->-                      let parentMsg = renderMessage md-                            { mdShowOlderEdits    = False-                            , mdMessage           = pm-                            , mdUserName          = mdParentUserName-                            , mdParentMessage     = Nothing-                            , mdRenderReplyParent = False-                            , mdIndentBlocks      = False-                            }-                      in withParent (addEllipsis $ B.forceAttr replyParentAttr parentMsg)--    where-        layout :: HighlightSet -> Maybe Int -> [Widget Name] -> Seq RichTextBlock-               -> ViewL RichTextBlock -> Widget Name-        layout hs w nameElems bs xs | length xs > 1     = multiLnLayout hs w nameElems bs-        layout hs w nameElems bs (Blockquote {} :< _) = multiLnLayout hs w nameElems bs-        layout hs w nameElems bs (CodeBlock {} :< _)  = multiLnLayout hs w nameElems bs-        layout hs w nameElems bs (HTMLBlock {} :< _)  = multiLnLayout hs w nameElems bs-        layout hs w nameElems bs (List {} :< _)       = multiLnLayout hs w nameElems bs-        layout hs w nameElems bs (Para inlns :< _)-            | F.any breakCheck inlns                    = multiLnLayout hs w nameElems bs-        layout hs w nameElems bs _                      = nameNextToMessage hs w nameElems bs--        multiLnLayout hs w nameElems bs =-            if mdIndentBlocks-               then vBox [ hBox nameElems-                         , hBox [B.txt "  ", renderRichText mdMyUsername hs ((subtract 2) <$> w) mdWrapNonhighlightedCodeBlocks bs]-                         ]-               else nameNextToMessage hs w nameElems bs--        nameNextToMessage hs w nameElems bs =-            Widget Fixed Fixed $ do-                nameResult <- render $ hBox nameElems-                let newW = subtract (V.imageWidth (nameResult^.imageL)) <$> w-                render $ hBox [raw (nameResult^.imageL), renderRichText mdMyUsername hs newW mdWrapNonhighlightedCodeBlocks bs]--        breakCheck e = eData e `elem` [ELineBreak, ESoftBreak]--addEllipsis :: Widget a -> Widget a-addEllipsis w = B.Widget (B.hSize w) (B.vSize w) $ do-    ctx <- B.getContext-    let aw = ctx^.B.availWidthL-    result <- B.render w-    let withEllipsis = (B.hLimit (aw - 3) $ B.vLimit 1 $ (B.Widget B.Fixed B.Fixed $ return result)) <+>-                       B.str "..."-    if (V.imageHeight (result^.B.imageL) > 1) || (V.imageWidth (result^.B.imageL) == aw) then-        B.render withEllipsis else-        return result- -- Cursor sentinel for tracking the user's cursor position in previews. cursorSentinel :: Char cursorSentinel = '‸'  -- Render markdown with username highlighting-renderRichText :: Text -> HighlightSet -> Maybe Int -> Bool -> Seq RichTextBlock -> Widget a-renderRichText curUser hSet w wrap bs =+renderRichText :: Text -> HighlightSet -> Maybe Int -> Bool -> Blocks -> Widget a+renderRichText curUser hSet w doWrap (Blocks bs) =     runReader (do-              blocks <- mapM blockToWidget (addBlankLines bs)+              blocks <- mapM renderBlock (addBlankLines bs)               return $ B.vBox $ toList blocks)               (DrawCfg { drawCurUser = curUser                        , drawHighlightSet = hSet                        , drawLineWidth = w-                       , drawDoLineWrapping = wrap+                       , drawDoLineWrapping = doWrap                        })  -- Add blank lines only between adjacent elements of the same type, to -- save space-addBlankLines :: Seq RichTextBlock -> Seq RichTextBlock+addBlankLines :: Seq Block -> Seq Block addBlankLines = go' . viewl   where go' EmptyL = S.empty         go' (x :< xs) = go x (viewl xs)-        go a@Para {} (b@Para {} :< rs) =-             a <| blank <| go b (viewl rs)-        go a@Header {} (b@Header {} :< rs) =-             a <| blank <| go b (viewl rs)-        go a@Blockquote {} (b@Blockquote {} :< rs) =-             a <| blank <| go b (viewl rs)-        go a@List {} (b@List {} :< rs) =-             a <| blank <| go b (viewl rs)-        go a@CodeBlock {} (b@CodeBlock {} :< rs) =-             a <| blank <| go b (viewl rs)-        go a@HTMLBlock {} (b@HTMLBlock {} :< rs) =-             a <| blank <| go b (viewl rs)-        go x (y :< rs) = x <| go y (viewl rs)-        go x (EmptyL) = S.singleton x-        blank = Para (S.singleton (Element Normal ESpace))+        go a (b :< rs)+            | sameBlockType a b = a <| blank <| go b (viewl rs)+            | otherwise         = a <| go b (viewl rs)+        go x EmptyL = S.singleton x+        blank = Para (Inlines $ S.singleton ESpace) --- Render text to markdown without username highlighting or permalink detection+-- Render text to markdown without username highlighting or permalink+-- detection renderText :: Text -> Widget a renderText txt = renderText' Nothing "" emptyHSet txt  renderText' :: Maybe TeamBaseURL -> Text -> HighlightSet -> Text -> Widget a-renderText' baseUrl curUser hSet t = renderRichText curUser hSet Nothing True rtBs-  where rtBs = parseMarkdown baseUrl t+renderText' baseUrl curUser hSet t =+    renderRichText curUser hSet Nothing True $+        parseMarkdown baseUrl t  vBox :: F.Foldable f => f (Widget a) -> Widget a vBox = B.vBox . toList@@ -323,38 +98,38 @@             , drawDoLineWrapping :: Bool             } -blockToWidget :: RichTextBlock -> M (Widget a)-blockToWidget (Para is) =-    toElementChunk is-blockToWidget (Header n is) = do+renderBlock :: Block -> M (Widget a)+renderBlock (Para is) =+    renderInlines is+renderBlock (Header n is) = do     headerTxt <- withReader (\c -> c { drawLineWidth = subtract 1 <$> drawLineWidth c }) $-                 toElementChunk is+                 renderInlines is     return $ B.withDefAttr clientHeaderAttr $         hBox [ B.padRight (B.Pad 1) $ header n              , headerTxt              ]-blockToWidget (Blockquote is) = do+renderBlock (Blockquote bs) = do     w <- asks drawLineWidth-    bs <- mapM blockToWidget is-    return $ maybeHLimit w $ addQuoting $ vBox bs-blockToWidget (List _ l bs) = do+    bws <- mapM renderBlock (unBlocks bs)+    return $ maybeHLimit w $ addQuoting $ vBox bws+renderBlock (List ty spacing bs) = do     w <- asks drawLineWidth-    lst <- blocksToList l bs+    lst <- renderList ty spacing bs     return $ maybeHLimit w lst-blockToWidget (CodeBlock ci tx) = do+renderBlock (CodeBlock ci tx) = do     hSet <- asks drawHighlightSet -    let f = maybe rawCodeBlockToWidget-                  (codeBlockToWidget (hSyntaxMap hSet))+    let f = maybe renderRawCodeBlock+                  (renderCodeBlock (hSyntaxMap hSet))                   mSyntax         mSyntax = do             lang <- codeBlockLanguage ci             Sky.lookupSyntax lang (hSyntaxMap hSet)     f tx-blockToWidget (HTMLBlock t) = do+renderBlock (HTMLBlock t) = do     w <- asks drawLineWidth     return $ maybeHLimit w $ textWithCursor t-blockToWidget (HRule) = do+renderBlock (HRule) = do     w <- asks drawLineWidth     return $ maybeHLimit w $ B.vLimit 1 (B.fill '*') @@ -374,30 +149,30 @@                           , B.Widget B.Fixed B.Fixed $ return childResult                           ] -codeBlockToWidget :: Sky.SyntaxMap -> Sky.Syntax -> Text -> M (Widget a)-codeBlockToWidget syntaxMap syntax tx = do+renderCodeBlock :: Sky.SyntaxMap -> Sky.Syntax -> Text -> M (Widget a)+renderCodeBlock syntaxMap syntax tx = do     let result = Sky.tokenize cfg syntax tx         cfg = Sky.TokenizerConfig syntaxMap False     case result of-        Left _ -> rawCodeBlockToWidget tx+        Left _ -> renderRawCodeBlock tx         Right tokLines -> do             let padding = B.padLeftRight 1 (B.vLimit (length tokLines) B.vBorder)             return $ (B.txt $ "[" <> Sky.sName syntax <> "]") B.<=>                      (padding <+> BS.renderRawSource textWithCursor tokLines) -rawCodeBlockToWidget :: Text -> M (Widget a)-rawCodeBlockToWidget tx = do-    wrap <- asks drawDoLineWrapping+renderRawCodeBlock :: Text -> M (Widget a)+renderRawCodeBlock tx = do+    doWrap <- asks drawDoLineWrapping -    let hPolicy = if wrap then Greedy else Fixed+    let hPolicy = if doWrap then Greedy else Fixed     return $ B.withDefAttr codeAttr $         Widget hPolicy Fixed $ do             c <- B.getContext             let theLines = expandEmpty <$> T.lines tx                 expandEmpty "" = " "                 expandEmpty s  = s-                wrapFunc = if wrap then wrappedTextWithCursor-                                   else textWithCursor+                wrapFunc = if doWrap then wrappedTextWithCursor+                                     else textWithCursor             renderedText <- render (B.hLimit (c^.B.availWidthL - 3) $ B.vBox $                                     wrapFunc <$> theLines) @@ -406,8 +181,8 @@              render $ padding <+> (Widget Fixed Fixed $ return renderedText) -toElementChunk :: Seq Element -> M (Widget a)-toElementChunk es = do+renderInlines :: Inlines -> M (Widget a)+renderInlines es = do     w <- asks drawLineWidth     hSet <- asks drawHighlightSet     curUser <- asks drawCurUser@@ -415,172 +190,68 @@     return $ B.Widget B.Fixed B.Fixed $ do         ctx <- B.getContext         let width = fromMaybe (ctx^.B.availWidthL) w-            ws    = fmap (renderElementSeq curUser) (wrapLine width hSet es)-        B.render (vBox (fmap hBox ws))+            ws    = fmap (renderWrappedLine curUser) $+                    mconcat $+                    (doLineWrapping width <$> (F.toList $ flattenInlineSeq hSet es))+        B.render (vBox ws) -blocksToList :: ListType -> Seq (Seq RichTextBlock) -> M (Widget a)-blocksToList lt bs = do-    let is = case lt of-          Bullet _ -> repeat ("• ")-          Numbered Period s ->+renderList :: ListType -> ListSpacing -> Seq Blocks -> M (Widget a)+renderList ty _spacing bs = do+    let is = case ty of+          BulletList _ -> repeat ("• ")+          OrderedList s _ Period ->             [ T.pack (show (n :: Int)) <> ". " | n <- [s..] ]-          Numbered Paren s ->+          OrderedList s _ OneParen ->             [ T.pack (show (n :: Int)) <> ") " | n <- [s..] ]+          OrderedList s _ TwoParens ->+            [ T.pack (show (n :: Int)) <> ")) " | n <- [s..] ] -    results <- forM (zip is $ F.toList bs) $ \(i, b) -> do-        blocks <- mapM blockToWidget b+    results <- forM (zip is $ unBlocks <$> (F.toList bs)) $ \(i, b) -> do+        blocks <- mapM renderBlock b         return $ B.txt i <+> vBox blocks      return $ vBox results -data SplitState = SplitState-  { splitChunks  :: Seq (Seq Element)-  , splitCurrCol :: Int-  }--wrapLine :: Int -> HighlightSet -> Seq Element -> Seq (Seq Element)-wrapLine maxCols hSet = splitChunks . go (SplitState (S.singleton S.empty) 0)-  where go st (viewl-> e :< es) = go st' es-          where-              HighlightSet { hUserSet = uSet, hChannelSet = cSet } = hSet--              -- Right before we check the width of the token, we see-              -- if the token is a user or channel reference. If so, we-              -- check if it is valid. If it is valid, we leave it in-              -- place; otherwise we translate it into an ordinary text-              -- element so that it does not render highlighted as a-              -- valid user or channel reference.-              newElement = e { eData = newEData }-              newEData = case eData e of-                  EUser u ->-                      if u `Set.member` uSet-                      then EUser u-                      else EText $ userSigil <> u-                  EChannel c ->-                      if c `Set.member` cSet-                      then EChannel c-                      else EText $ normalChannelSigil <> c-                  d -> d--              addHyperlink url el = setElementStyle (Hyperlink url (eStyle el)) el--              linkOpenBracket = Element Normal (EText "<")-              linkCloseBracket = Element Normal (EText ">")-              addOpenBracket l =-                  case Seq.viewl l of-                      EmptyL -> l-                      h :< t ->-                          let h' = Element Normal-                                           (ENonBreaking $ Seq.fromList [linkOpenBracket, h])-                          in h' <| t-              addCloseBracket l =-                  case Seq.viewr l of-                      EmptyR -> l-                      h :> t ->-                          let t' = Element Normal-                                           (ENonBreaking $ Seq.fromList [t, linkCloseBracket])-                          in h |> t'-              decorateLinkLabel = addOpenBracket .  addCloseBracket--              st' =-                  case newEData of-                      EHyperlink url (Just labelEs) ->-                          go st $ addHyperlink url <$> decorateLinkLabel labelEs-                      EHyperlink url Nothing ->-                          go st $ addHyperlink url <$> decorateLinkLabel (Seq.fromList [Element Normal $ EText $ unURL url])-                      EPermalink _tName _pId (Just labelEs) ->-                          go st $ setElementStyle Permalink <$> decorateLinkLabel labelEs-                      EImage url (Just labelEs) ->-                          go st $ addHyperlink url <$> decorateLinkLabel labelEs-                      _ ->-                          if | newEData == ESoftBreak || newEData == ELineBreak ->-                                 st { splitChunks = splitChunks st |> S.empty-                                    , splitCurrCol = 0-                                    }-                             | available >= eWidth ->-                                 st { splitChunks  = addElement newElement (splitChunks st)-                                    , splitCurrCol = splitCurrCol st + eWidth-                                    }-                             | newEData == ESpace ->-                                 st { splitChunks = splitChunks st |> S.empty-                                    , splitCurrCol = 0-                                    }-                             | otherwise ->-                                 st { splitChunks  = splitChunks st |> S.singleton newElement-                                    , splitCurrCol = eWidth-                                    }-              available = maxCols - splitCurrCol st-              eWidth = elementWidth newElement-              addElement x (viewr-> ls :> l) = ( ls |> (l |> x))-              addElement _ _ = error "[unreachable]"-        go st _                 = st--renderElementSeq :: Text -> Seq Element -> Seq (Widget a)-renderElementSeq curUser es = renderElement curUser <$> es+renderWrappedLine :: Text -> WrappedLine -> Widget a+renderWrappedLine curUser l = hBox $ F.toList $ renderFlattenedValue curUser <$> l -renderElement :: Text -> Element -> Widget a-renderElement curUser e = addStyle sty widget+renderFlattenedValue :: Text -> FlattenedValue -> Widget a+renderFlattenedValue curUser (NonBreaking rs) =+    let renderLine = hBox . F.toList . fmap (renderFlattenedValue curUser)+    in vBox (F.toList $ renderLine <$> F.toList rs)+renderFlattenedValue curUser (SingleInline fi) = addHyperlink $ addStyles widget     where-        sty = eStyle e-        dat = eData e-        addStyle s = case s of-                Normal                  -> id-                Emph                    -> B.withDefAttr clientEmphAttr-                Strikethrough           -> B.withDefAttr strikeThroughAttr-                Strong                  -> B.withDefAttr clientStrongAttr-                Code                    -> B.withDefAttr codeAttr-                Permalink               -> B.withDefAttr permalinkAttr-                Hyperlink (URL url) innerSty ->-                    B.hyperlink url . B.withDefAttr urlAttr .  addStyle innerSty-        rawText = B.txt . removeCursor-        widget = case dat of-            -- Cursor sentinels get parsed as individual text nodes by-            -- Cheapskate, meaning that we get a text node with exactly-            -- one character in it. That's why we compare accordingly-            -- above. In addition, since that character has no width, we-            -- have to replace it with something that has a size (such-            -- as a space) to get Brick's visibility logic to scroll the-            -- viewport to get it into view.-            EText t                      -> if t == T.singleton (cursorSentinel)-                                            then B.visible $ B.txt " "-                                            else textWithCursor t--            ESpace                       -> B.txt " "-            EPermalink _ pId mLabel      -> drawPermalink curUser pId mLabel-            ENonBreaking es              -> hBox $ renderElement curUser <$> es-            ERawHtml t                   -> textWithCursor t-            EEditSentinel recent         -> let attr = if recent-                                                       then editedRecentlyMarkingAttr-                                                       else editedMarkingAttr-                                            in B.withDefAttr attr $ B.txt editMarking-            EUser u                      -> colorUsername curUser u $ userSigil <> u-            EChannel c                   -> B.withDefAttr channelNameAttr $-                                            B.txt $ normalChannelSigil <> c-            EHyperlink (URL url) Nothing -> rawText url-            EImage (URL url) Nothing     -> rawText url-            EEmoji em                    -> B.withDefAttr emojiAttr $-                                            B.txt $ ":" <> em <> ":"--            -- Hyperlink and image nodes with labels should not appear-            -- at this point because line-wrapping should break them up-            -- into normal text node sequences with hyperlink styles-            -- attached.-            EHyperlink {}                -> rawText "(Report renderElement bug #1)"-            EImage {}                    -> rawText "(Report renderElement bug #2)"+        val = fiValue fi+        mUrl = fiURL fi+        styles = fiStyles fi -            -- Line breaks should never need to get rendered since the-            -- line-wrapping algorithm removes them.-            ESoftBreak                   -> B.emptyWidget-            ELineBreak                   -> B.emptyWidget+        addStyles w = foldr addStyle w styles+        addStyle s =+            B.withDefAttr $ case s of+                Strong        -> clientStrongAttr+                Code          -> codeAttr+                Permalink     -> permalinkAttr+                Strikethrough -> strikeThroughAttr+                Emph          -> clientEmphAttr -drawPermalink :: Text -> PostId -> Maybe (Seq Element) -> Widget a-drawPermalink _ _ Nothing =-    B.txt permalinkPlaceholder-drawPermalink curUser _ (Just label) =-    hBox $ F.toList $ B.txt "<" <| (renderElementSeq curUser label |> B.txt ">")+        addHyperlink = case mUrl of+            Nothing -> id+            Just u -> B.withDefAttr urlAttr . B.hyperlink (unURL u) -permalinkPlaceholder :: Text-permalinkPlaceholder = "<post link>"+        widget = case val of+            FSpace               -> B.txt " "+            FUser u              -> colorUsername curUser u $ userSigil <> u+            FChannel c           -> B.withDefAttr channelNameAttr $+                                    B.txt $ normalChannelSigil <> c+            FEmoji em            -> B.withDefAttr emojiAttr $+                                    B.txt $ ":" <> em <> ":"+            FText t              -> if t == T.singleton (cursorSentinel)+                                    then B.visible $ B.txt " "+                                    else textWithCursor t+            FEditSentinel recent -> let attr = if recent+                                               then editedRecentlyMarkingAttr+                                               else editedMarkingAttr+                                    in B.withDefAttr attr $ B.txt editMarking  textWithCursor :: Text -> Widget a textWithCursor t@@ -594,26 +265,3 @@  removeCursor :: Text -> Text removeCursor = T.filter (/= cursorSentinel)--editMarking :: Text-editMarking = "(edited)"--elementWidth :: Element -> Int-elementWidth e =-    case eData e of-        ENonBreaking es              -> sum $ elementWidth <$> es-        EText t                      -> B.textWidth t-        ERawHtml t                   -> B.textWidth t-        EUser t                      -> T.length userSigil + B.textWidth t-        EChannel t                   -> T.length normalChannelSigil + B.textWidth t-        EEditSentinel _              -> B.textWidth editMarking-        EImage (URL url) Nothing     -> B.textWidth url-        EImage _ (Just is)           -> sum $ elementWidth <$> is-        EHyperlink (URL url) Nothing -> B.textWidth url-        EHyperlink _ (Just is)       -> sum $ elementWidth <$> is-        EEmoji t                     -> B.textWidth t + 2-        EPermalink _ _ Nothing       -> T.length permalinkPlaceholder-        EPermalink _ _ (Just label)  -> 2 + (sum $ elementWidth <$> label)-        ESpace                       -> 1-        ELineBreak                   -> 0-        ESoftBreak                   -> 0

@@ -0,0 +1,302 @@+-- | This module implements a "flattening" pass over RichText 'Inline'+-- values. This means that a tree structure such as+--+-- @+--   EStrong+--     [ EStrikethrough+--       [ EText "inside"+--       ]+--     , EText "outside"+--     ]+-- @+--+-- will be converted into a "flat" representation without a tree+-- structure so that the style information encoded in the tree is+-- available at each node:+--+-- @+--   [+--     [ SingleInline (FlattenedInline (FText "inside") [Strong, Strikethrough] Nothing+--     , SingleInline (FlattenedInline (FText "outside") [Strong] Nothing+--     ]+--   ]+-- @+--+-- The outer sequence is a sequence of lines (since inline lists can+-- introduce line breaks). Each inner sequence is a single line.+-- Each 'SingleInline' can be rendered as-is; if a 'NonBreaking' is+-- encountered, that group of inlines should be treated as a unit for+-- the purposes of line-wrapping (to happen in the Wrap module). The+-- above representation example shows how the tree path including the+-- 'EStrong' and 'EStrikethrough' nodes is flattened into a list of+-- styles to accompany each inline value. This makes it trivial to carry+-- that style information along with each node during line-wrapping+-- rather than needing to deal with the tree structure.+module Matterhorn.Draw.RichText.Flatten+  ( FlattenedContent(..)+  , FlattenedInline(..)+  , InlineStyle(..)+  , FlattenedValue(..)+  , flattenInlineSeq+  )+where++import           Prelude ()+import           Matterhorn.Prelude++import           Control.Monad.Reader+import           Control.Monad.State+import           Data.List ( nub )+import qualified Data.Sequence as Seq+import           Data.Sequence ( ViewL(..)+                               , ViewR(..)+                               , (<|)+                               , (|>)+                               )+import qualified Data.Set as Set+import qualified Data.Text as T++import           Matterhorn.Constants ( normalChannelSigil, userSigil )+import           Matterhorn.Types ( HighlightSet(..) )+import           Matterhorn.Types.RichText+++-- | A piece of text in a sequence of flattened RichText elements. This+-- type represents the lowest-level kind of data that we can get from a+-- rich text document.+data FlattenedContent =+    FText Text+    -- ^ Some text+    | FSpace+    -- ^ A space+    | FUser Text+    -- ^ A user reference+    | FChannel Text+    -- ^ A channel reference+    | FEmoji Text+    -- ^ An emoji+    | FEditSentinel Bool+    -- ^ An "edited" marking+    deriving (Eq, Show)++-- | A flattened inline value.+data FlattenedInline =+    FlattenedInline { fiValue :: FlattenedContent+                    -- ^ The content of the value.+                    , fiStyles :: [InlineStyle]+                    -- ^ The styles that should be applied to this+                    -- value.+                    , fiURL :: Maybe URL+                    -- ^ If present, the URL to which we should+                    -- hyperlink this value.+                    }+                    deriving (Show)++-- | A flattened value.+data FlattenedValue =+    SingleInline FlattenedInline+    -- ^ A single flattened value+    | NonBreaking (Seq (Seq FlattenedValue))+    -- ^ A sequence of flattened values that MUST be kept together and+    -- never broken up by line-wrapping+    deriving (Show)++-- | The visual styles of inline values.+data InlineStyle =+    Strong+    | Emph+    | Strikethrough+    | Code+    | Permalink+    deriving (Eq, Show)++type FlattenM a = ReaderT FlattenEnv (State FlattenState) a++-- | The flatten monad state+data FlattenState =+    FlattenState { fsCompletedLines :: Seq (Seq FlattenedValue)+                 -- ^ The lines that we have accumulated so far in the+                 -- flattening process+                 , fsCurLine :: Seq FlattenedValue+                 -- ^ The current line we are accumulating in the+                 -- flattening process+                 }++-- | The flatten monad environment+data FlattenEnv =+    FlattenEnv { flattenStyles :: [InlineStyle]+               -- ^ The styles that should apply to the current value+               -- being flattened+               , flattenURL :: Maybe URL+               -- ^ The hyperlink URL, if any, that should be applied to+               -- the current value being flattened+               , flattenHighlightSet :: HighlightSet+               -- ^ The highlight set to use to check for valid user or+               -- channel references+               }++-- | Given a sequence of inlines, flatten it into a list of lines of+-- flattened values.+--+-- The flattening process also validates user and channel references+-- against a 'HighlightSet'. For example, if an 'EUser' node is found,+-- its username argument is looked up in the 'HighlightSet'. If the+-- username is found, the 'EUser' node is preserved as an 'FUser' node.+-- Otherwise it is rewritten as an 'FText' node so that the username+-- does not get highlighted. Channel references ('EChannel') are handled+-- similarly.+flattenInlineSeq :: HighlightSet -> Inlines -> Seq (Seq FlattenedValue)+flattenInlineSeq hs is =+    flattenInlineSeq' initialEnv is+    where+        initialEnv = FlattenEnv { flattenStyles = []+                                , flattenURL = Nothing+                                , flattenHighlightSet = hs+                                }++flattenInlineSeq' :: FlattenEnv -> Inlines -> Seq (Seq FlattenedValue)+flattenInlineSeq' env is =+    fsCompletedLines $ execState stBody initialState+    where+        initialState = FlattenState mempty mempty+        stBody = runReaderT body env+        body = do+            mapM_ flatten $ unInlines is+            pushFLine++withInlineStyle :: InlineStyle -> FlattenM () -> FlattenM ()+withInlineStyle s =+    withReaderT (\e -> e { flattenStyles = nub (s : flattenStyles e) })++withHyperlink :: URL -> FlattenM () -> FlattenM ()+withHyperlink u = withReaderT (\e -> e { flattenURL = Just u })++-- | Push a FlattenedContent value onto the current line.+pushFC :: FlattenedContent -> FlattenM ()+pushFC v = do+    env <- ask+    let styles = flattenStyles env+        mUrl = flattenURL env+        fi = FlattenedInline { fiValue = v+                             , fiStyles = styles+                             , fiURL = mUrl+                             }+    pushFV $ SingleInline fi++-- | Push a FlattenedValue onto the current line.+pushFV :: FlattenedValue -> FlattenM ()+pushFV fv = lift $ modify $ \s -> s { fsCurLine = appendFV fv (fsCurLine s) }++-- | Append the value to the sequence.+--+-- If the both the value to append AND the sequence's last value are+-- both text nodes, AND if those nodes both have the same style and URL+-- metadata, then merge them into one text node. This keeps adjacent+-- non-whitespace text together as one logical token (e.g. "(foo" rather+-- than "(" followed by "foo") to avoid undesirable line break points in+-- the wrapping process.+appendFV :: FlattenedValue -> Seq FlattenedValue -> Seq FlattenedValue+appendFV v line =+    case (Seq.viewr line, v) of+        (h :> SingleInline a, SingleInline b) ->+            case (fiValue a, fiValue b) of+                (FText aT, FText bT) ->+                    if fiStyles a == fiStyles b && fiURL a == fiURL b+                    then h |> SingleInline (FlattenedInline (FText $ aT <> bT)+                                                            (fiStyles a)+                                                            (fiURL a))+                    else line |> v+                _ -> line |> v+        _ -> line |> v++-- | Push the current line onto the finished lines list and start a new+-- line.+pushFLine :: FlattenM ()+pushFLine =+    lift $ modify $ \s -> s { fsCompletedLines = fsCompletedLines s |> fsCurLine s+                            , fsCurLine = mempty+                            }++isKnownUser :: T.Text -> FlattenM Bool+isKnownUser u = do+    hSet <- asks flattenHighlightSet+    let uSet = hUserSet hSet+    return $ u `Set.member` uSet++isKnownChannel :: T.Text -> FlattenM Bool+isKnownChannel c = do+    hSet <- asks flattenHighlightSet+    let cSet = hChannelSet hSet+    return $ c `Set.member` cSet++flatten :: Inline -> FlattenM ()+flatten i =+    case i of+        EUser u -> do+            known <- isKnownUser u+            if known then pushFC (FUser u)+                     else pushFC (FText $ userSigil <> u)+        EChannel c -> do+            known <- isKnownChannel c+            if known then pushFC (FChannel c)+                     else pushFC (FText $ normalChannelSigil <> c)++        ENonBreaking is -> do+            env <- ask+            pushFV $ (NonBreaking $ flattenInlineSeq' env is)++        ESoftBreak                  -> pushFLine+        ELineBreak                  -> pushFLine++        EText t                     -> pushFC $ FText t+        ESpace                      -> pushFC FSpace+        ERawHtml h                  -> pushFC $ FText h+        EEmoji e                    -> pushFC $ FEmoji e+        EEditSentinel r             -> pushFC $ FEditSentinel r++        EEmph es                    -> withInlineStyle Emph $ mapM_ flatten $ unInlines es+        EStrikethrough es           -> withInlineStyle Strikethrough $ mapM_ flatten $ unInlines es+        EStrong es                  -> withInlineStyle Strong $ mapM_ flatten $ unInlines es+        ECode es                    -> withInlineStyle Code $ mapM_ flatten $ unInlines es++        EPermalink _ _ mLabel ->+            let label' = fromMaybe (Inlines $ Seq.fromList [EText "post", ESpace, EText "link"])+                                   mLabel+            in withInlineStyle Permalink $ mapM_ flatten $ unInlines $ decorateLinkLabel label'++        EHyperlink u label@(Inlines ls) ->+            let label' = if Seq.null ls+                         then Inlines $ Seq.singleton $ EText $ unURL u+                         else label+            in withHyperlink u $ mapM_ flatten $ unInlines $ decorateLinkLabel label'++        EImage u label@(Inlines ls) ->+            let label' = if Seq.null ls+                         then Inlines $ Seq.singleton $ EText $ unURL u+                         else label+            in withHyperlink u $ mapM_ flatten $ unInlines $ decorateLinkLabel label'++linkOpenBracket :: Inline+linkOpenBracket = EText "<"++linkCloseBracket :: Inline+linkCloseBracket = EText ">"++addOpenBracket :: Inlines -> Inlines+addOpenBracket (Inlines l) =+    case Seq.viewl l of+        EmptyL -> Inlines l+        h :< t ->+            let h' = ENonBreaking $ Inlines $ Seq.fromList [linkOpenBracket, h]+            in Inlines $ h' <| t++addCloseBracket :: Inlines -> Inlines+addCloseBracket (Inlines l) =+    case Seq.viewr l of+        EmptyR -> Inlines l+        h :> t ->+            let t' = ENonBreaking $ Inlines $ Seq.fromList [t, linkCloseBracket]+            in Inlines $ h |> t'++decorateLinkLabel :: Inlines -> Inlines+decorateLinkLabel = addOpenBracket .  addCloseBracket

@@ -0,0 +1,116 @@+-- | This module performs line-wrapping of sequences of flattend inline+-- values produced by 'flattenInlineSeq'.+--+-- This process works by maintaining a 'WrapState' in the 'WrapM'+-- monad, where inline values are pushed onto the current line, and+-- line breaks are introduced as inlines exceed the available width.+-- The most important caveat of this module is that wrapping depends+-- on knowing the width of each 'FlattenedValue', which is provided+-- by the 'fvWidth' function. But 'fvWidth' must return values that+-- are consistent with the how the inlines actually get rendered by+-- 'renderFlattenedValue'. This is because there are visual aspects to+-- how some inlines get rendered that are implicit, such as user or+-- channel sigils that get added at drawing time, that have an impact on+-- their visible width.+module Matterhorn.Draw.RichText.Wrap+  ( WrappedLine+  , doLineWrapping+  )+where++import           Prelude ()+import           Matterhorn.Prelude++import qualified Brick as B+import           Control.Monad.State+import qualified Data.Sequence as Seq+import           Data.Sequence ( ViewL(..)+                               , (|>)+                               )+import qualified Data.Text as T++import           Matterhorn.Constants ( normalChannelSigil, userSigil )+import           Matterhorn.Draw.RichText.Flatten+import           Matterhorn.Constants ( editMarking )+++type WrappedLine = Seq FlattenedValue++data WrapState =+    WrapState { wrapCompletedLines :: Seq WrappedLine+              -- ^ The completed lines so far+              , wrapCurLine :: WrappedLine+              -- ^ The current line we are accumulating+              , wrapCurCol :: Int+              -- ^ The width of wrapCurLine, in columns+              , wrapWidth :: Int+              -- ^ The maximum allowable width+              }++type WrapM a = State WrapState a++-- | Push a flattened value onto the current line if possible, or add a+-- line break and add the inline value to a new line if it would cause+-- the current line width to exceed the maximum.+pushValue :: FlattenedValue -> WrapM ()+pushValue i = do+    let iw = fvWidth i+        pushThisInline =+            modify $ \st -> st { wrapCurLine = wrapCurLine st |> i+                               , wrapCurCol = wrapCurCol st + iw+                               }+    maxWidth <- gets wrapWidth+    curWidth <- gets wrapCurCol+    let remaining = maxWidth - curWidth++    when (iw > remaining) pushLine++    pushThisInline++-- | Insert a new line break by moving the current accumulating line+-- onto the completed lines list and resetting it to empty.+pushLine :: WrapM ()+pushLine = do+    let trimLeadingWhitespace s =+            case Seq.viewl s of+                SingleInline i :< t | fiValue i == FSpace -> trimLeadingWhitespace t+                _ -> s++    modify $ \st ->+        st { wrapCurLine = mempty+           , wrapCompletedLines = wrapCompletedLines st |> trimLeadingWhitespace (wrapCurLine st)+           , wrapCurCol = 0+           }++-- | Given a maximum width and an inline sequence, produce a sequence of+-- lines wrapped at the specified column. This only returns lines longer+-- than the maximum width when those lines have a single inline value+-- that cannot be broken down further (such as a long URL).+doLineWrapping :: Int -> Seq FlattenedValue -> Seq WrappedLine+doLineWrapping maxCols i =+    result+    where+        result = wrapCompletedLines $ execState (mapM_ pushValue i >> pushLine) initialState+        initialState = WrapState { wrapCurLine = mempty+                                 , wrapCompletedLines = mempty+                                 , wrapCurCol = 0+                                 , wrapWidth = maxCols+                                 }++-- The widths returned by this function must match the content widths+-- rendered by renderFlattenedValue.+fvWidth :: FlattenedValue -> Int+fvWidth (SingleInline fi) = fiWidth fi+fvWidth (NonBreaking rs) = sum $ (sum . fmap fvWidth) <$> rs++-- The widths returned by this function must match the content widths+-- rendered by renderFlattenedValue.+fiWidth :: FlattenedInline -> Int+fiWidth fi =+    case fiValue fi of+        FText t                      -> B.textWidth t+        FSpace                       -> 1+        FUser t                      -> T.length userSigil + B.textWidth t+        FChannel t                   -> T.length normalChannelSigil + B.textWidth t+        FEmoji t                     -> B.textWidth t + 2+        FEditSentinel _              -> B.textWidth editMarking

@@ -443,14 +443,14 @@     [ ("Global Keybindings", globalKeyHandlers)     , ("Help Page", helpKeyHandlers)     , ("Main Interface", mainKeyHandlers)-    , ("Text Editing", editingKeyHandlers (csEditState.cedEditor))+    , ("Text Editing", editingKeyHandlers (csCurrentTeam.tsEditState.cedEditor))     , ("Channel Select Mode", channelSelectKeyHandlers)     , ("Message Select Mode", messageSelectKeyHandlers)     , ("User Listings", userListOverlayKeyHandlers)     , ("URL Select Mode", urlSelectKeyHandlers)     , ("Theme List Window", themeListOverlayKeyHandlers)     , ("Channel Search Window", channelListOverlayKeyHandlers)-    , ("Message Viewer: Common", tabbedWindowKeyHandlers (csViewedMessage.singular _Just._2))+    , ("Message Viewer: Common", tabbedWindowKeyHandlers (csCurrentTeam.tsViewedMessage.singular _Just._2))     , ("Message Viewer: Message tab", viewMessageKeyHandlers)     , ("Message Viewer: Reactions tab", viewMessageReactionsKeyHandlers)     , ("Attachment List", attachmentListKeyHandlers)@@ -502,7 +502,7 @@     in (label, rendering)  mkKeybindEventSectionHelp :: KeyConfig-                          -> ((Either Text Text, Text, [Text]) -> a)+                          -> ((TextHunk, Text, [TextHunk]) -> a)                           -> ([a] -> a)                           -> (Text -> a)                           -> (Text, [KeyEventHandler])@@ -511,53 +511,59 @@   vertCat $ (mkHeading sectionName) :             (mkKeybindHelpFunc <$> (mkKeybindEventHelp kc <$> kbs)) -keybindEventHelpWidget :: (Either Text Text, Text, [Text]) -> Widget Name+data TextHunk = Verbatim Text+              | Comment Text++keybindEventHelpWidget :: (TextHunk, Text, [TextHunk]) -> Widget Name keybindEventHelpWidget (evName, desc, evs) =-    let evText = T.intercalate ", " evs+    let evText = T.intercalate ", " (getText <$> evs)+        getText (Comment s) = s+        getText (Verbatim s) = s         label = case evName of-            Left s -> txt $ "; " <> s-            Right s -> emph $ txt s+            Comment s -> txt $ "; " <> s+            Verbatim s -> emph $ txt s     in padBottom (Pad 1) $        vBox [ txtWrap ("; " <> desc)             , label <+> txt (" = " <> evText)             ] -keybindEventHelpMarkdown :: (Either Text Text, Text, [Text]) -> Text+keybindEventHelpMarkdown :: (TextHunk, Text, [TextHunk]) -> Text keybindEventHelpMarkdown (evName, desc, evs) =     let quote s = "`" <> s <> "`"+        format (Comment s) = s+        format (Verbatim s) = quote s         name = case evName of-            Left s -> s-            Right s -> quote s-    in "| " <> (T.intercalate ", " $ quote <$> evs) <>+            Comment s -> s+            Verbatim s -> quote s+    in "| " <> (T.intercalate ", " $ format <$> evs) <>        " | " <> name <>        " | " <> desc <>        " |" -keybindEventHelpText :: Int -> Int -> (Either Text Text, Text, [Text]) -> Text+keybindEventHelpText :: Int -> Int -> (TextHunk, Text, [TextHunk]) -> Text keybindEventHelpText width eventNameWidth (evName, desc, evs) =-    let name = case evName of-            Left s -> s-            Right s -> s-    in padTo width (T.intercalate ", " evs) <> " " <>-       padTo eventNameWidth name <> " " <>+    let getText (Comment s) = s+        getText (Verbatim s) = s+    in padTo width (T.intercalate ", " $ getText <$> evs) <> " " <>+       padTo eventNameWidth (getText evName) <> " " <>        desc -mkKeybindEventHelp :: KeyConfig -> KeyEventHandler -> (Either Text Text, Text, [Text])+mkKeybindEventHelp :: KeyConfig -> KeyEventHandler -> (TextHunk, Text, [TextHunk]) mkKeybindEventHelp kc h =   let trig = kehEventTrigger h-      unbound = ["(unbound)"]+      unbound = [Comment "(unbound)"]       (label, evText) = case trig of-          Static key -> (Left "(non-customizable key)", [ppBinding $ eventToBinding key])+          Static key -> (Comment "(non-customizable key)", [Verbatim $ ppBinding $ eventToBinding key])           ByEvent ev -> case M.lookup ev kc of               Nothing ->                   let name = keyEventName ev                   in if not (null (defaultBindings ev))-                     then (Right name, ppBinding <$> defaultBindings ev)-                     else (Left name, unbound)-              Just Unbound -> (Right $ keyEventName ev, unbound)-              Just (BindingList bs) -> (Right $ keyEventName ev,+                     then (Verbatim name, Verbatim <$> ppBinding <$> defaultBindings ev)+                     else (Verbatim name, unbound)+              Just Unbound -> (Verbatim $ keyEventName ev, unbound)+              Just (BindingList bs) -> (Verbatim $ keyEventName ev,                                         if not (null bs)-                                        then ppBinding <$> bs+                                        then Verbatim <$> ppBinding <$> bs                                         else unbound                                         )   in (label, ehDescription $ kehHandler h, evText)

@@ -12,6 +12,8 @@ import           Data.List ( intersperse ) import qualified Graphics.Vty as Vty +import           Network.Mattermost.Types ( TeamId )+ import           Matterhorn.Draw.Util ( renderKeybindingHelp ) import           Matterhorn.Types import           Matterhorn.Themes@@ -26,12 +28,13 @@     let cur = getCurrentTabbedWindowEntry w         tabBody = tweRender cur (twValue w) cs         title = forceAttr clientEmphAttr $ twtTitle (twTemplate w) (tweValue cur)+        tId = cs^.csCurrentTeamId     in centerLayer $        vLimit (twWindowHeight w) $        hLimit (twWindowWidth w) $        joinBorders $        borderWithLabel title $-       (tabBar w <=> tabBody <=> hBorder <=> hCenter keybindingHelp)+       (tabBar tId w <=> tabBody <=> hBorder <=> hCenter keybindingHelp)  -- | Keybinding help to show at the bottom of a tabbed window. keybindingHelp :: Widget Name@@ -43,9 +46,10 @@  -- | The scrollable tab bar to show at the top of a tabbed window. tabBar :: (Eq a, Show a)-       => TabbedWindow a+       => TeamId+       -> TabbedWindow a        -> Widget Name-tabBar w =+tabBar tId w =     let cur = getCurrentTabbedWindowEntry w         entries = twtEntries (twTemplate w)         renderEntry e =@@ -74,4 +78,4 @@             render $ hBox $ (intersperse divider $ renderEntry <$> entries) <>                             [divider, padTop (Pad 1) $ hLimit width hBorder]         divider = vLimit 1 vBorder <=> joinableBorder (Edges True False False False)-    in vLimit 2 $ viewport TabbedWindowTabBar Horizontal contents+    in vLimit 2 $ viewport (TabbedWindowTabBar tId) Horizontal contents

@@ -23,7 +23,7 @@  drawThemeListOverlay :: ChatState -> Widget Name drawThemeListOverlay st =-    let overlay = drawListOverlay (st^.csThemeListOverlay)+    let overlay = drawListOverlay (st^.csCurrentTeam.tsThemeListOverlay)                                   (const $ txt "Themes")                                   (const $ txt "No matching themes found.")                                   (const $ txt "Search built-in themes:")

@@ -9,6 +9,7 @@ import           Brick import           Brick.Widgets.Border ( hBorder ) import           Brick.Widgets.List ( renderList )+import qualified Data.Sequence as Seq import qualified Data.Foldable as F import           Lens.Micro.Platform ( to ) @@ -19,7 +20,7 @@ import           Matterhorn.Draw.RichText import           Matterhorn.Themes import           Matterhorn.Types-import           Matterhorn.Types.RichText ( unURL, TeamURLName(..) )+import           Matterhorn.Types.RichText   renderUrlList :: ChatState -> Widget Name@@ -35,10 +36,12 @@                      then str "No URLs found in this channel."                      else renderList renderItem True urls -        urls = st^.csUrlList+        urls = st^.csCurrentTeam.tsUrlList          me = myUsername st +        hSet = getHighlightSet st+         renderItem sel link =           let time = link^.linkTime           in attr sel $ vLimit 2 $@@ -47,7 +50,11 @@                     in colorUsername me u u                   , case link^.linkLabel of                       Nothing -> emptyWidget-                      Just label -> txt ": " <+> hBox (F.toList $ renderElementSeq me label)+                      Just label ->+                          case Seq.null (unInlines label) of+                              True -> emptyWidget+                              False -> txt ": " <+> renderRichText me hSet Nothing False+                                                    (Blocks $ Seq.singleton $ Para label)                   , fill ' '                   , renderDate st $ withServerTime time                   , str " "

@@ -22,7 +22,7 @@  drawUserListOverlay :: ChatState -> Widget Name drawUserListOverlay st =-    let overlay = drawListOverlay (st^.csUserListOverlay) userSearchScopeHeader+    let overlay = drawListOverlay (st^.csCurrentTeam.tsUserListOverlay) userSearchScopeHeader                                   userSearchScopeNoResults userSearchScopePrompt                                   (renderUser (myUsername st))                                   Nothing

@@ -18,7 +18,6 @@ import           Data.List ( intersperse ) import qualified Data.Set as Set import qualified Data.Text as T-import           Lens.Micro.Platform ( to ) import           Network.Mattermost.Types  import           Matterhorn.Constants ( userSigil, normalChannelSigil )@@ -40,11 +39,11 @@  getTimeFormat :: ChatState -> Text getTimeFormat st =-    maybe defaultTimeFormat id (st^.csResources.crConfiguration.to configTimeFormat)+    maybe defaultTimeFormat id (st^.csResources.crConfiguration.configTimeFormatL)  getDateFormat :: ChatState -> Text getDateFormat st =-    maybe defaultDateFormat id (st^.csResources.crConfiguration.to configDateFormat)+    maybe defaultDateFormat id (st^.csResources.crConfiguration.configDateFormatL)  renderTime :: ChatState -> UTCTime -> Widget Name renderTime st = renderUTCTime (getTimeFormat st) (st^.timeZone)

@@ -9,30 +9,22 @@ import           Matterhorn.Prelude  import           Brick-import qualified Data.Sequence as Seq-import qualified Data.Set as Set import qualified Data.Text as T import qualified Graphics.Vty as Vty-import           Lens.Micro.Platform ( (.=), preuse, _2, singular, _Just )+import           Lens.Micro.Platform ( (.=), _2, singular, _Just )  import qualified Network.Mattermost.Endpoints as MM import           Network.Mattermost.Exceptions ( mattermostErrorMessage )-import           Network.Mattermost.Lenses-import           Network.Mattermost.Types-import           Network.Mattermost.WebSocket  import           Matterhorn.Connection import           Matterhorn.Constants ( userSigil, normalChannelSigil ) import           Matterhorn.HelpTopics+import           Matterhorn.State.ChannelList import           Matterhorn.State.Channels import           Matterhorn.State.Common-import           Matterhorn.State.Flagging import           Matterhorn.State.Help import           Matterhorn.State.Messages-import           Matterhorn.State.Reactions-import           Matterhorn.State.Users import           Matterhorn.Types-import           Matterhorn.Types.Common  import           Matterhorn.Events.ChannelSelect import           Matterhorn.Events.ChannelTopicWindow@@ -51,6 +43,7 @@ import           Matterhorn.Events.TabbedWindow import           Matterhorn.Events.ManageAttachments import           Matterhorn.Events.EditNotifyPrefs+import           Matterhorn.Events.Websocket   onEvent :: ChatState -> BrickEvent Name MHEvent -> EventM Name (Next ChatState)@@ -102,9 +95,9 @@ onAppEvent (BGBusy n) =     csWorkerIsBusy .= Just n onAppEvent (WSEvent we) =-    handleWSEvent we+    handleWebsocketEvent we onAppEvent (WSActionResponse r) =-    handleWSActionResponse r+    handleWebsocketActionResponse r onAppEvent (RespEvent f) = f onAppEvent (WebsocketParseError e) = do     let msg = "A websocket message could not be parsed:\n  " <>@@ -185,26 +178,31 @@  handleGlobalEvent :: Vty.Event -> MH () handleGlobalEvent e = do-    mode <- gets appMode+    mode <- use (csCurrentTeam.tsMode)+    globalHandlerByMode mode e++globalHandlerByMode :: Mode -> Vty.Event -> MH ()+globalHandlerByMode mode =     case mode of-        Main                       -> onEventMain e-        ShowHelp _ _               -> void $ onEventShowHelp e-        ChannelSelect              -> void $ onEventChannelSelect e-        UrlSelect                  -> void $ onEventUrlSelect e-        LeaveChannelConfirm        -> onEventLeaveChannelConfirm e-        MessageSelect              -> onEventMessageSelect e-        MessageSelectDeleteConfirm -> onEventMessageSelectDeleteConfirm e-        DeleteChannelConfirm       -> onEventDeleteChannelConfirm e-        ThemeListOverlay           -> onEventThemeListOverlay e-        PostListOverlay _          -> onEventPostListOverlay e-        UserListOverlay            -> onEventUserListOverlay e-        ChannelListOverlay         -> onEventChannelListOverlay e-        ReactionEmojiListOverlay   -> onEventReactionEmojiListOverlay e-        ViewMessage                -> void $ handleTabbedWindowEvent (csViewedMessage.singular _Just._2) e-        ManageAttachments          -> onEventManageAttachments e-        ManageAttachmentsBrowseFiles -> onEventManageAttachments e-        EditNotifyPrefs            -> void $ onEventEditNotifyPrefs e-        ChannelTopicWindow         -> onEventChannelTopicWindow e+        Main                       -> onEventMain+        ShowHelp _ _               -> void . onEventShowHelp+        ChannelSelect              -> void . onEventChannelSelect+        UrlSelect                  -> void . onEventUrlSelect+        LeaveChannelConfirm        -> onEventLeaveChannelConfirm+        MessageSelect              -> onEventMessageSelect+        MessageSelectDeleteConfirm -> onEventMessageSelectDeleteConfirm+        DeleteChannelConfirm       -> onEventDeleteChannelConfirm+        ThemeListOverlay           -> onEventThemeListOverlay+        PostListOverlay _          -> onEventPostListOverlay+        UserListOverlay            -> onEventUserListOverlay+        ChannelListOverlay         -> onEventChannelListOverlay+        ReactionEmojiListOverlay   -> onEventReactionEmojiListOverlay+        ViewMessage                -> void . handleTabbedWindowEvent+                                             (csCurrentTeam.tsViewedMessage.singular _Just._2)+        ManageAttachments          -> onEventManageAttachments+        ManageAttachmentsBrowseFiles -> onEventManageAttachments+        EditNotifyPrefs            -> void . onEventEditNotifyPrefs+        ChannelTopicWindow         -> onEventChannelTopicWindow  globalKeybindings :: KeyConfig -> KeyHandlerMap globalKeybindings = mkKeybindings globalKeyHandlers@@ -216,164 +214,6 @@         (showHelpScreen mainHelpTopic)     ] -handleWSActionResponse :: WebsocketActionResponse -> MH ()-handleWSActionResponse r =-    case warStatus r of-        WebsocketActionStatusOK -> return ()--handleWSEvent :: WebsocketEvent -> MH ()-handleWSEvent we = do-    myId <- gets myUserId-    myTId <- gets myTeamId-    case weEvent we of-        WMPosted-            | Just p <- wepPost (weData we) ->-                when (wepTeamId (weData we) == Just myTId ||-                      wepTeamId (weData we) == Nothing) $ do-                    let wasMentioned = maybe False (Set.member myId) $ wepMentions (weData we)-                    addNewPostedMessage $ RecentPost p wasMentioned-                    cId <- use csCurrentChannelId-                    when (postChannelId p /= cId) $-                        showChannelInSidebar (p^.postChannelIdL) False-            | otherwise -> return ()--        WMPostEdited-            | Just p <- wepPost (weData we) -> do-                editMessage p-                cId <- use csCurrentChannelId-                when (postChannelId p == cId) (updateViewed False)-                when (postChannelId p /= cId) $-                    showChannelInSidebar (p^.postChannelIdL) False-            | otherwise -> return ()--        WMPostDeleted-            | Just p <- wepPost (weData we) -> do-                deleteMessage p-                cId <- use csCurrentChannelId-                when (postChannelId p == cId) (updateViewed False)-                when (postChannelId p /= cId) $-                    showChannelInSidebar (p^.postChannelIdL) False-            | otherwise -> return ()--        WMStatusChange-            | Just status <- wepStatus (weData we)-            , Just uId <- wepUserId (weData we) ->-                setUserStatus uId status-            | otherwise -> return ()--        WMUserAdded-            | Just cId <- webChannelId (weBroadcast we) ->-                when (wepUserId (weData we) == Just myId &&-                      wepTeamId (weData we) == Just myTId) $-                    handleChannelInvite cId-            | otherwise -> return ()--        WMNewUser-            | Just uId <- wepUserId $ weData we ->-                handleNewUsers (Seq.singleton uId) (return ())-            | otherwise -> return ()--        WMUserRemoved-            | Just cId <- wepChannelId (weData we) ->-                when (webUserId (weBroadcast we) == Just myId) $-                    removeChannelFromState cId-            | otherwise -> return ()--        WMTyping-            | Just uId <- wepUserId $ weData we-            , Just cId <- webChannelId (weBroadcast we) -> handleTypingUser uId cId-            | otherwise -> return ()--        WMChannelDeleted-            | Just cId <- wepChannelId (weData we) ->-                when (webTeamId (weBroadcast we) == Just myTId) $-                    removeChannelFromState cId-            | otherwise -> return ()--        WMDirectAdded-            | Just cId <- webChannelId (weBroadcast we) -> handleChannelInvite cId-            | otherwise -> return ()--        -- An 'ephemeral message' is just Mattermost's version of our-        -- 'client message'. This can be a little bit wacky, e.g.-        -- if the user types '/shortcuts' in the browser, we'll get-        -- an ephemeral message even in MatterHorn with the browser-        -- shortcuts, but it's probably a good idea to handle these-        -- messages anyway.-        WMEphemeralMessage-            | Just p <- wepPost $ weData we -> postInfoMessage (sanitizeUserText $ p^.postMessageL)-            | otherwise -> return ()--        WMPreferenceChanged-            | Just prefs <- wepPreferences (weData we) ->-                mapM_ applyPreferenceChange prefs-            | otherwise -> return ()--        WMPreferenceDeleted-            | Just pref <- wepPreferences (weData we)-            , Just fps <- mapM preferenceToFlaggedPost pref ->-              forM_ fps $ \f ->-                  updateMessageFlag (flaggedPostId f) False-            | otherwise -> return ()--        WMReactionAdded-            | Just r <- wepReaction (weData we)-            , Just cId <- webChannelId (weBroadcast we) -> addReactions cId [r]-            | otherwise -> return ()--        WMReactionRemoved-            | Just r <- wepReaction (weData we)-            , Just cId <- webChannelId (weBroadcast we) -> removeReaction r cId-            | otherwise -> return ()--        WMChannelViewed-            | Just cId <- wepChannelId $ weData we -> refreshChannelById cId-            | otherwise -> return ()--        WMChannelUpdated-            | Just cId <- webChannelId $ weBroadcast we -> do-                mChan <- preuse (csChannel(cId))-                when (isJust mChan) $ do-                    refreshChannelById cId-                    updateSidebar-            | otherwise -> return ()--        WMGroupAdded-            | Just cId <- webChannelId (weBroadcast we) -> handleChannelInvite cId-            | otherwise -> return ()--        WMChannelMemberUpdated-            | Just channelMember <- wepChannelMember $ weData we ->-                  when (channelMemberUserId channelMember == myId) $-                      updateChannelNotifyProps-                      (channelMemberChannelId channelMember)-                      (channelMemberNotifyProps channelMember)-            | otherwise -> return ()--        -- We are pretty sure we should do something about these:-        WMAddedToTeam -> return ()--        -- We aren't sure whether there is anything we should do about-        -- these yet:-        WMUpdateTeam -> return ()-        WMTeamDeleted -> return ()-        WMUserUpdated -> return ()-        WMLeaveTeam -> return ()--        -- We deliberately ignore these events:-        WMChannelCreated -> return ()-        WMEmojiAdded -> return ()-        WMWebRTC -> return ()-        WMHello -> return ()-        WMAuthenticationChallenge -> return ()-        WMUserRoleUpdated -> return ()-        WMPluginStatusesChanged -> return ()-        WMPluginEnabled -> return ()-        WMPluginDisabled -> return ()-        WMUnknownEvent {} ->-            mhLog LogWebsocket $ T.pack $-                "Websocket event not handled due to unknown event type: " <> show we- -- | Refresh client-accessible server configuration information. This -- is usually triggered when a reconnect event for the WebSocket to the -- server occurs.@@ -384,4 +224,4 @@         cfg <- MM.mmGetClientConfiguration (Just "old") session         return $ Just $ do             csClientConfig .= Just cfg-            updateSidebar+            updateSidebar Nothing

@@ -18,7 +18,7 @@  onEventChannelListOverlay :: Vty.Event -> MH () onEventChannelListOverlay =-    void . onEventListOverlay csChannelListOverlay channelListOverlayKeybindings+    void . onEventListOverlay (csCurrentTeam.tsChannelListOverlay) channelListOverlayKeybindings  -- | The keybindings we want to use while viewing a channel list overlay channelListOverlayKeybindings :: KeyConfig -> KeyHandlerMap@@ -26,10 +26,10 @@  channelListOverlayKeyHandlers :: [KeyEventHandler] channelListOverlayKeyHandlers =-    [ mkKb CancelEvent "Close the channel search list" (exitListOverlay csChannelListOverlay)+    [ mkKb CancelEvent "Close the channel search list" (exitListOverlay (csCurrentTeam.tsChannelListOverlay))     , mkKb SearchSelectUpEvent "Select the previous channel" channelListSelectUp     , mkKb SearchSelectDownEvent "Select the next channel" channelListSelectDown     , mkKb PageDownEvent "Page down in the channel list" channelListPageDown     , mkKb PageUpEvent "Page up in the channel list" channelListPageUp-    , mkKb ActivateListItemEvent "Join the selected channel" (listOverlayActivateCurrent csChannelListOverlay)+    , mkKb ActivateListItemEvent "Join the selected channel" (listOverlayActivateCurrent (csCurrentTeam.tsChannelListOverlay))     ]

@@ -17,9 +17,9 @@ onEventChannelSelect :: Vty.Event -> MH Bool onEventChannelSelect =   handleKeyboardEvent channelSelectKeybindings $ \e -> do-      handled <- handleKeyboardEvent (editingKeybindings (csChannelSelectState.channelSelectInput)) (const $ return ()) e+      handled <- handleKeyboardEvent (editingKeybindings (csCurrentTeam.tsChannelSelectState.channelSelectInput)) (const $ return ()) e       when (not handled) $-          mhHandleEventLensed (csChannelSelectState.channelSelectInput) handleEditorEvent e+          mhHandleEventLensed (csCurrentTeam.tsChannelSelectState.channelSelectInput) handleEditorEvent e        updateChannelSelectMatches @@ -30,7 +30,7 @@ channelSelectKeyHandlers =     [ staticKb "Switch to selected channel"          (Vty.EvKey Vty.KEnter []) $ do-             matches <- use (csChannelSelectState.channelSelectMatches)+             matches <- use (csCurrentTeam.tsChannelSelectState.channelSelectMatches)              case Z.focus matches of                  Nothing -> return ()                  Just match -> do

@@ -18,31 +18,31 @@  onEventChannelTopicWindow :: Vty.Event -> MH () onEventChannelTopicWindow (Vty.EvKey (Vty.KChar '\t') []) =-    csChannelTopicDialog.channelTopicDialogFocus %= focusNext+    csCurrentTeam.tsChannelTopicDialog.channelTopicDialogFocus %= focusNext onEventChannelTopicWindow (Vty.EvKey Vty.KBackTab []) =-    csChannelTopicDialog.channelTopicDialogFocus %= focusPrev+    csCurrentTeam.tsChannelTopicDialog.channelTopicDialogFocus %= focusPrev onEventChannelTopicWindow e@(Vty.EvKey Vty.KEnter []) = do-    f <- use (csChannelTopicDialog.channelTopicDialogFocus)+    f <- use (csCurrentTeam.tsChannelTopicDialog.channelTopicDialogFocus)     case focusGetCurrent f of-        Just ChannelTopicSaveButton -> do-            ed <- use (csChannelTopicDialog.channelTopicDialogEditor)+        Just (ChannelTopicSaveButton {}) -> do+            ed <- use (csCurrentTeam.tsChannelTopicDialog.channelTopicDialogEditor)             let topic = T.unlines $ getEditContents ed             setChannelTopic topic             setMode Main-        Just ChannelTopicEditor ->-            mhHandleEventLensed (csChannelTopicDialog.channelTopicDialogEditor)+        Just (ChannelTopicEditor {}) ->+            mhHandleEventLensed (csCurrentTeam.tsChannelTopicDialog.channelTopicDialogEditor)                                 handleEditorEvent e-        Just ChannelTopicCancelButton ->+        Just (ChannelTopicCancelButton {}) ->             setMode Main         _ ->             setMode Main onEventChannelTopicWindow (Vty.EvKey Vty.KEsc []) = do     setMode Main onEventChannelTopicWindow e = do-    f <- use (csChannelTopicDialog.channelTopicDialogFocus)+    f <- use (csCurrentTeam.tsChannelTopicDialog.channelTopicDialogFocus)     case focusGetCurrent f of-        Just ChannelTopicEditor ->-            mhHandleEventLensed (csChannelTopicDialog.channelTopicDialogEditor)+        Just (ChannelTopicEditor {}) ->+            mhHandleEventLensed (csCurrentTeam.tsChannelTopicDialog.channelTopicDialogEditor)                                 handleEditorEvent e         _ ->             return ()

@@ -25,9 +25,9 @@ onEventEditNotifyPrefs :: V.Event -> MH Bool onEventEditNotifyPrefs =     let fallback e = do-            form <- use (csNotifyPrefs.singular _Just)+            form <- use (csCurrentTeam.tsNotifyPrefs.singular _Just)             updatedForm <- mh $ handleFormEvent (VtyEvent e) form-            csNotifyPrefs .= Just updatedForm+            csCurrentTeam.tsNotifyPrefs .= Just updatedForm     in handleKeyboardEvent editNotifyPrefsKeybindings fallback  editNotifyPrefsKeybindings :: KeyConfig -> KeyHandlerMap@@ -38,8 +38,8 @@     [ mkKb CancelEvent "Close channel notification preferences" exitEditNotifyPrefsMode     , mkKb FormSubmitEvent "Save channel notification preferences" $ do         st <- use id-        let form = fromJust $ st^.csNotifyPrefs-            cId = st^.csCurrentChannelId+        let form = fromJust $ st^.csCurrentTeam.tsNotifyPrefs+            cId = st^.csCurrentChannelId(st^.csCurrentTeamId)          doAsyncChannelMM Preempt cId           (\s _ -> MM.mmUpdateChannelNotifications cId (myUserId st) (formState form) s)

@@ -226,6 +226,10 @@         EditorEndEvent                -> [ kb Vty.KEnd ]         EditorYankEvent               -> [ ctrl (key 'y') ]         FormSubmitEvent               -> [ kb Vty.KEnter ]+        NextTeamEvent                 -> [ ctrl (kb Vty.KRight) ]+        PrevTeamEvent                 -> [ ctrl (kb Vty.KLeft) ]+        MoveCurrentTeamLeftEvent      -> [ ]+        MoveCurrentTeamRightEvent     -> [ ]  -- | Given a configuration, we want to check it for internal consistency -- (i.e. that a given keybinding isn't associated with multiple events

@@ -11,10 +11,12 @@ import           Matterhorn.Events.Keybindings import           Matterhorn.State.Attachments import           Matterhorn.State.ChannelSelect+import           Matterhorn.State.ChannelList import           Matterhorn.State.Channels import           Matterhorn.State.Editing import           Matterhorn.State.MessageSelect import           Matterhorn.State.PostListOverlay ( enterFlaggedPostListMode )+import           Matterhorn.State.Teams import           Matterhorn.State.UrlSelect import           Matterhorn.Types @@ -50,6 +52,18 @@     , mkKb ToggleExpandedChannelTopicsEvent "Toggle display of expanded channel topics"         toggleExpandedChannelTopics +    , mkKb NextTeamEvent "Switch to the next available team"+        nextTeam++    , mkKb PrevTeamEvent "Switch to the previous available team"+        prevTeam++    , mkKb MoveCurrentTeamLeftEvent "Move the current team to the left in the team list"+        moveCurrentTeamLeft++    , mkKb MoveCurrentTeamRightEvent "Move the current team to the right in the team list"+        moveCurrentTeamRight+     , mkKb         InvokeEditorEvent         "Invoke `$EDITOR` to edit the current message"@@ -78,9 +92,9 @@         "Scroll up in the channel input history" $ do              -- Up in multiline mode does the usual thing; otherwise we              -- navigate the history.-             isMultiline <- use (csEditState.cedEphemeral.eesMultiline)+             isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)              case isMultiline of-                 True -> mhHandleEventLensed (csEditState.cedEditor) handleEditorEvent+                 True -> mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent                                            (Vty.EvKey Vty.KUp [])                  False -> channelHistoryBackward @@ -89,9 +103,9 @@         "Scroll down in the channel input history" $ do              -- Down in multiline mode does the usual thing; otherwise              -- we navigate the history.-             isMultiline <- use (csEditState.cedEphemeral.eesMultiline)+             isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)              case isMultiline of-                 True -> mhHandleEventLensed (csEditState.cedEditor) handleEditorEvent+                 True -> mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent                                            (Vty.EvKey Vty.KDown [])                  False -> channelHistoryForward @@ -123,22 +137,24 @@      , staticKb "Send the current message"          (Vty.EvKey Vty.KEnter []) $ do-             isMultiline <- use (csEditState.cedEphemeral.eesMultiline)+             isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)              case isMultiline of                  -- Normally, this event causes the current message to                  -- be sent. But in multiline mode we want to insert a                  -- newline instead.                  True -> handleEditingInput (Vty.EvKey Vty.KEnter [])                  False -> do-                     cId <- use csCurrentChannelId+                     tId <- use csCurrentTeamId+                     cId <- use (csCurrentChannelId tId)                      content <- getEditorContent-                     handleInputSubmission cId content+                     handleInputSubmission tId cId content      , mkKb EnterOpenURLModeEvent "Select and open a URL posted to the current channel"            startUrlSelect -    , mkKb ClearUnreadEvent "Clear the current channel's unread / edited indicators" $-           clearChannelUnreadStatus =<< use csCurrentChannelId+    , mkKb ClearUnreadEvent "Clear the current channel's unread / edited indicators" $ do+           tId <- use csCurrentTeamId+           clearChannelUnreadStatus =<< use (csCurrentChannelId tId)      , mkKb ToggleMultiLineEvent "Toggle multi-line message compose mode"            toggleMultilineEditing

@@ -30,7 +30,7 @@  onEventManageAttachments :: V.Event -> MH () onEventManageAttachments e = do-    mode <- gets appMode+    mode <- use (csCurrentTeam.tsMode)     case mode of         ManageAttachments -> void $ onEventAttachmentList e         ManageAttachmentsBrowseFiles -> onEventBrowseFile e@@ -39,7 +39,7 @@ onEventAttachmentList :: V.Event -> MH Bool onEventAttachmentList =     handleKeyboardEvent attachmentListKeybindings $-        mhHandleEventLensed (csEditState.cedAttachmentList) L.handleListEvent+        mhHandleEventLensed (csCurrentTeam.tsEditState.cedAttachmentList) L.handleListEvent  attachmentListKeybindings :: KeyConfig -> KeyHandlerMap attachmentListKeybindings = mkKeybindings attachmentListKeyHandlers@@ -49,9 +49,9 @@     [ mkKb CancelEvent "Close attachment list"           (setMode Main)     , mkKb SelectUpEvent "Move cursor up" $-          mhHandleEventLensed (csEditState.cedAttachmentList) L.handleListEvent (V.EvKey V.KUp [])+          mhHandleEventLensed (csCurrentTeam.tsEditState.cedAttachmentList) L.handleListEvent (V.EvKey V.KUp [])     , mkKb SelectDownEvent "Move cursor down" $-          mhHandleEventLensed (csEditState.cedAttachmentList) L.handleListEvent (V.EvKey V.KDown [])+          mhHandleEventLensed (csCurrentTeam.tsEditState.cedAttachmentList) L.handleListEvent (V.EvKey V.KDown [])     , mkKb AttachmentListAddEvent "Add a new attachment to the attachment list"           showAttachmentFileBrowser     , mkKb AttachmentOpenEvent "Open the selected attachment using the URL open command"@@ -68,12 +68,12 @@     [ mkKb CancelEvent "Cancel attachment file browse"       cancelAttachmentBrowse     , mkKb AttachmentOpenEvent "Open the selected file using the URL open command"-          openSelectedBrowserEntry+      openSelectedBrowserEntry     ]  withFileBrowser :: ((FB.FileBrowser Name) -> MH ()) -> MH () withFileBrowser f = do-    use (csEditState.cedFileBrowser) >>= \case+    use (csCurrentTeam.tsEditState.cedFileBrowser) >>= \case         Nothing -> do             -- The widget has not been created yet.  This should             -- normally not occur, because the ManageAttachments@@ -82,14 +82,15 @@             -- This could therefore be implemented as an `error "BUG:             -- ..."` handler, but the more benign approach is to             -- simply create an available FileBrowser at this stage.-            new_b <- liftIO $ FB.newFileBrowser FB.selectNonDirectories AttachmentFileBrowser Nothing-            csEditState.cedFileBrowser ?= new_b+            tId <- use csCurrentTeamId+            new_b <- liftIO $ FB.newFileBrowser FB.selectNonDirectories (AttachmentFileBrowser tId) Nothing+            csCurrentTeam.tsEditState.cedFileBrowser ?= new_b             f new_b         Just b -> f b  openSelectedAttachment :: MH () openSelectedAttachment = do-    cur <- use (csEditState.cedAttachmentList.to L.listSelectedElement)+    cur <- use (csCurrentTeam.tsEditState.cedAttachmentList.to L.listSelectedElement)     case cur of         Nothing -> return ()         Just (_, entry) -> void $ openFilePath (FB.fileInfoFilePath $@@ -119,7 +120,7 @@  cancelAttachmentBrowse :: MH () cancelAttachmentBrowse = do-    es <- use (csEditState.cedAttachmentList.L.listElementsL)+    es <- use (csCurrentTeam.tsEditState.cedAttachmentList.L.listElementsL)     case length es of         0 -> setMode Main         _ -> setMode ManageAttachments@@ -127,14 +128,14 @@ handleFileBrowserEvent :: V.Event -> MH () handleFileBrowserEvent e = do   let fbHandle ev = sequence . (fmap (FB.handleFileBrowserEvent ev))-  mhHandleEventLensed (csEditState.cedFileBrowser) fbHandle e+  mhHandleEventLensed (csCurrentTeam.tsEditState.cedFileBrowser) fbHandle e    withFileBrowser $ \b -> do     -- TODO: Check file browser exception state     let entries = FB.fileBrowserSelection b     forM_ entries $ \entry -> do         -- Is the entry already present? If so, ignore the selection.-        es <- use (csEditState.cedAttachmentList.L.listElementsL)+        es <- use (csCurrentTeam.tsEditState.cedAttachmentList.L.listElementsL)         let matches = (== (FB.fileInfoFilePath entry)) .                       FB.fileInfoFilePath .                       attachmentDataFileInfo@@ -151,23 +152,23 @@                         let a = AttachmentData { attachmentDataFileInfo = entry                                                , attachmentDataBytes = bytes                                                }-                        oldIdx <- use (csEditState.cedAttachmentList.L.listSelectedL)+                        oldIdx <- use (csCurrentTeam.tsEditState.cedAttachmentList.L.listSelectedL)                         let newIdx = if Vector.null es                                      then Just 0                                      else oldIdx-                        csEditState.cedAttachmentList %= L.listReplace (Vector.snoc es a) newIdx+                        csCurrentTeam.tsEditState.cedAttachmentList %= L.listReplace (Vector.snoc es a) newIdx      when (not $ null entries) $ setMode Main  deleteSelectedAttachment :: MH () deleteSelectedAttachment = do-    es <- use (csEditState.cedAttachmentList.L.listElementsL)-    mSel <- use (csEditState.cedAttachmentList.to L.listSelectedElement)+    es <- use (csCurrentTeam.tsEditState.cedAttachmentList.L.listElementsL)+    mSel <- use (csCurrentTeam.tsEditState.cedAttachmentList.to L.listSelectedElement)     case mSel of         Nothing ->             return ()         Just (pos, _) -> do-            oldIdx <- use (csEditState.cedAttachmentList.L.listSelectedL)+            oldIdx <- use (csCurrentTeam.tsEditState.cedAttachmentList.L.listSelectedL)             let idx = if Vector.length es == 1                       then Nothing                       else case oldIdx of@@ -175,7 +176,7 @@                           Just old -> if pos >= old                                       then Just $ pos - 1                                       else Just pos-            csEditState.cedAttachmentList %= L.listReplace (deleteAt pos es) idx+            csCurrentTeam.tsEditState.cedAttachmentList %= L.listReplace (deleteAt pos es) idx  deleteAt :: Int -> Vector.Vector a -> Vector.Vector a deleteAt p as | p < 0 || p >= length as = as

@@ -18,7 +18,8 @@  onEventReactionEmojiListOverlay :: Vty.Event -> MH () onEventReactionEmojiListOverlay =-    void . onEventListOverlay csReactionEmojiListOverlay reactionEmojiListOverlayKeybindings+    void . onEventListOverlay (csCurrentTeam.tsReactionEmojiListOverlay)+           reactionEmojiListOverlayKeybindings  -- | The keybindings we want to use while viewing an emoji list overlay reactionEmojiListOverlayKeybindings :: KeyConfig -> KeyHandlerMap@@ -26,10 +27,16 @@  reactionEmojiListOverlayKeyHandlers :: [KeyEventHandler] reactionEmojiListOverlayKeyHandlers =-    [ mkKb CancelEvent "Close the emoji search window" (exitListOverlay csReactionEmojiListOverlay)-    , mkKb SearchSelectUpEvent "Select the previous emoji" reactionEmojiListSelectUp-    , mkKb SearchSelectDownEvent "Select the next emoji" reactionEmojiListSelectDown-    , mkKb PageDownEvent "Page down in the emoji list" reactionEmojiListPageDown-    , mkKb PageUpEvent "Page up in the emoji list" reactionEmojiListPageUp-    , mkKb ActivateListItemEvent "Post the selected emoji reaction" (listOverlayActivateCurrent csReactionEmojiListOverlay)+    [ mkKb CancelEvent "Close the emoji search window"+      (exitListOverlay (csCurrentTeam.tsReactionEmojiListOverlay))+    , mkKb SearchSelectUpEvent "Select the previous emoji"+      reactionEmojiListSelectUp+    , mkKb SearchSelectDownEvent "Select the next emoji"+      reactionEmojiListSelectDown+    , mkKb PageDownEvent "Page down in the emoji list"+      reactionEmojiListPageDown+    , mkKb PageUpEvent "Page up in the emoji list"+      reactionEmojiListPageUp+    , mkKb ActivateListItemEvent "Post the selected emoji reaction"+      (listOverlayActivateCurrent (csCurrentTeam.tsReactionEmojiListOverlay))     ]

@@ -40,5 +40,5 @@  popMode :: MH () popMode = do-    ShowHelp _ prevMode <- gets appMode+    ShowHelp _ prevMode <- use (csCurrentTeam.tsMode)     setMode prevMode

@@ -13,7 +13,8 @@  onEventThemeListOverlay :: Vty.Event -> MH () onEventThemeListOverlay =-    void . onEventListOverlay csThemeListOverlay themeListOverlayKeybindings+    void . onEventListOverlay (csCurrentTeam.tsThemeListOverlay)+        themeListOverlayKeybindings  -- | The keybindings we want to use while viewing a user list overlay themeListOverlayKeybindings :: KeyConfig -> KeyHandlerMap@@ -21,10 +22,16 @@  themeListOverlayKeyHandlers :: [KeyEventHandler] themeListOverlayKeyHandlers =-    [ mkKb CancelEvent "Close the theme list" (exitListOverlay csThemeListOverlay)-    , mkKb SearchSelectUpEvent "Select the previous theme" themeListSelectUp-    , mkKb SearchSelectDownEvent "Select the next theme" themeListSelectDown-    , mkKb PageDownEvent "Page down in the theme list" themeListPageDown-    , mkKb PageUpEvent "Page up in the theme list" themeListPageUp-    , mkKb ActivateListItemEvent "Switch to the selected color theme" (listOverlayActivateCurrent csThemeListOverlay)+    [ mkKb CancelEvent "Close the theme list"+      (exitListOverlay (csCurrentTeam.tsThemeListOverlay))+    , mkKb SearchSelectUpEvent "Select the previous theme"+      themeListSelectUp+    , mkKb SearchSelectDownEvent "Select the next theme"+      themeListSelectDown+    , mkKb PageDownEvent "Page down in the theme list"+      themeListPageDown+    , mkKb PageUpEvent "Page up in the theme list"+      themeListPageUp+    , mkKb ActivateListItemEvent "Switch to the selected color theme"+      (listOverlayActivateCurrent (csCurrentTeam.tsThemeListOverlay))     ]

@@ -14,7 +14,7 @@ onEventUrlSelect :: Vty.Event -> MH Bool onEventUrlSelect =   handleKeyboardEvent urlSelectKeybindings $ \ ev ->-    mhHandleEventLensed csUrlList handleListEvent ev+    mhHandleEventLensed (csCurrentTeam.tsUrlList) handleListEvent ev  urlSelectKeybindings :: KeyConfig -> KeyHandlerMap urlSelectKeybindings = mkKeybindings urlSelectKeyHandlers@@ -28,10 +28,10 @@     , mkKb CancelEvent "Cancel URL selection" stopUrlSelect      , mkKb SelectUpEvent "Move cursor up" $-        mhHandleEventLensed csUrlList handleListEvent (Vty.EvKey Vty.KUp [])+        mhHandleEventLensed (csCurrentTeam.tsUrlList) handleListEvent (Vty.EvKey Vty.KUp [])      , mkKb SelectDownEvent "Move cursor down" $-        mhHandleEventLensed csUrlList handleListEvent (Vty.EvKey Vty.KDown [])+        mhHandleEventLensed (csCurrentTeam.tsUrlList) handleListEvent (Vty.EvKey Vty.KDown [])      , staticKb "Cancel URL selection"          (Vty.EvKey (Vty.KChar 'q') []) $ stopUrlSelect

@@ -13,7 +13,7 @@  onEventUserListOverlay :: Vty.Event -> MH () onEventUserListOverlay =-    void . onEventListOverlay csUserListOverlay userListOverlayKeybindings+    void . onEventListOverlay (csCurrentTeam.tsUserListOverlay) userListOverlayKeybindings  -- | The keybindings we want to use while viewing a user list overlay userListOverlayKeybindings :: KeyConfig -> KeyHandlerMap@@ -21,10 +21,10 @@  userListOverlayKeyHandlers :: [KeyEventHandler] userListOverlayKeyHandlers =-    [ mkKb CancelEvent "Close the user search list" (exitListOverlay csUserListOverlay)+    [ mkKb CancelEvent "Close the user search list" (exitListOverlay (csCurrentTeam.tsUserListOverlay))     , mkKb SearchSelectUpEvent "Select the previous user" userListSelectUp     , mkKb SearchSelectDownEvent "Select the next user" userListSelectDown     , mkKb PageDownEvent "Page down in the user list" userListPageDown     , mkKb PageUpEvent "Page up in the user list" userListPageUp-    , mkKb ActivateListItemEvent "Interact with the selected user" (listOverlayActivateCurrent csUserListOverlay)+    , mkKb ActivateListItemEvent "Interact with the selected user" (listOverlayActivateCurrent (csCurrentTeam.tsUserListOverlay))     ]

@@ -0,0 +1,236 @@+module Matterhorn.Events.Websocket+  ( handleWebsocketEvent+  , handleWebsocketActionResponse+  )+where++import           Prelude ()+import           Matterhorn.Prelude++import qualified Data.HashMap.Strict as HM+import qualified Data.Sequence as Seq+import qualified Data.Set as Set+import qualified Data.Text as T+import           Lens.Micro.Platform ( preuse )++import           Network.Mattermost.Lenses+import           Network.Mattermost.Types+import           Network.Mattermost.WebSocket++import           Matterhorn.State.ChannelList+import           Matterhorn.State.Channels+import           Matterhorn.State.Common+import           Matterhorn.State.Flagging+import           Matterhorn.State.Messages+import           Matterhorn.State.Reactions+import           Matterhorn.State.Teams+import           Matterhorn.State.Users+import           Matterhorn.Types+import           Matterhorn.Types.Common+++foreachTeam :: (TeamId -> MH ()) -> MH ()+foreachTeam act = do+    ts <- use csTeams+    let myTIds = HM.keys ts+    mapM_ act myTIds++handleWebsocketEvent :: WebsocketEvent -> MH ()+handleWebsocketEvent we = do+    myId <- gets myUserId+    ts <- use csTeams+    let memberOf tId = HM.member tId ts++        -- The team ID is one of the teams we're in, or the team ID is+        -- absent, which typically indicates a DM channel event since DM+        -- channels are not associated with teams.+        inMyTeamOrDM (Just i) = memberOf i+        inMyTeamOrDM Nothing = True++        -- The team ID is one of the teams we're in. A missing team ID+        -- yields False.+        inMyTeam (Just i) = memberOf i+        inMyTeam Nothing = False++    case weEvent we of+        WMPosted+            | Just p <- wepPost (weData we) ->+                when (inMyTeamOrDM (wepTeamId (weData we))) $ do+                    let wasMentioned = maybe False (Set.member myId) $ wepMentions (weData we)+                    addNewPostedMessage $ RecentPost p wasMentioned+                    tId <- use csCurrentTeamId+                    cId <- use (csCurrentChannelId tId)+                    when (postChannelId p /= cId) $+                        showChannelInSidebar (p^.postChannelIdL) False+            | otherwise -> return ()++        WMPostEdited+            | Just p <- wepPost (weData we) -> do+                editMessage p++                currTid <- use csCurrentTeamId+                foreachTeam $ \tId -> do+                    cId <- use (csCurrentChannelId tId)+                    when (postChannelId p == cId && tId == currTid) $+                        updateViewed False+                    when (postChannelId p /= cId) $+                        showChannelInSidebar (p^.postChannelIdL) False+            | otherwise -> return ()++        WMPostDeleted+            | Just p <- wepPost (weData we) -> do+                deleteMessage p++                currTid <- use csCurrentTeamId+                foreachTeam $ \tId -> do+                    cId <- use (csCurrentChannelId tId)+                    when (postChannelId p == cId && tId == currTid) $+                        updateViewed False+                    when (postChannelId p /= cId) $+                        showChannelInSidebar (p^.postChannelIdL) False+            | otherwise -> return ()++        WMStatusChange+            | Just status <- wepStatus (weData we)+            , Just uId <- wepUserId (weData we) ->+                setUserStatus uId status+            | otherwise -> return ()++        -- Despite this event's name, it means "a user was added to a+        -- channel". The event that occurs when a new user is added to+        -- the server, see WMNewUser.+        WMUserAdded+            | Just cId <- webChannelId (weBroadcast we) ->+                when (wepUserId (weData we) == Just myId &&+                      inMyTeam (wepTeamId (weData we))) $+                    handleChannelInvite cId+            | otherwise -> return ()++        WMNewUser+            | Just uId <- wepUserId $ weData we ->+                handleNewUsers (Seq.singleton uId) (return ())+            | otherwise -> return ()++        WMUserRemoved+            | Just cId <- wepChannelId (weData we) ->+                when (webUserId (weBroadcast we) == Just myId) $+                    removeChannelFromState cId+            | otherwise -> return ()++        WMTyping+            | Just uId <- wepUserId $ weData we+            , Just cId <- webChannelId (weBroadcast we) -> handleTypingUser uId cId+            | otherwise -> return ()++        WMChannelDeleted+            | Just cId <- wepChannelId (weData we) ->+                when (inMyTeamOrDM (webTeamId (weBroadcast we))) $+                    removeChannelFromState cId+            | otherwise -> return ()++        WMDirectAdded+            | Just cId <- webChannelId (weBroadcast we) -> handleChannelInvite cId+            | otherwise -> return ()++        -- An 'ephemeral message' is just Mattermost's version of our+        -- 'client message'. This can be a little bit wacky, e.g.+        -- if the user types '/shortcuts' in the browser, we'll get+        -- an ephemeral message even in MatterHorn with the browser+        -- shortcuts, but it's probably a good idea to handle these+        -- messages anyway.+        WMEphemeralMessage+            | Just p <- wepPost $ weData we -> postInfoMessage (sanitizeUserText $ p^.postMessageL)+            | otherwise -> return ()++        WMPreferenceChanged+            | Just prefs <- wepPreferences (weData we) ->+                mapM_ applyPreferenceChange prefs+            | otherwise -> return ()++        WMPreferenceDeleted+            | Just pref <- wepPreferences (weData we)+            , Just fps <- mapM preferenceToFlaggedPost pref ->+              forM_ fps $ \f ->+                  updateMessageFlag (flaggedPostId f) False+            | otherwise -> return ()++        WMReactionAdded+            | Just r <- wepReaction (weData we)+            , Just cId <- webChannelId (weBroadcast we) -> addReactions cId [r]+            | otherwise -> return ()++        WMReactionRemoved+            | Just r <- wepReaction (weData we)+            , Just cId <- webChannelId (weBroadcast we) -> removeReaction r cId+            | otherwise -> return ()++        WMChannelViewed+            | Just cId <- wepChannelId $ weData we -> refreshChannelById cId+            | otherwise -> return ()++        WMChannelUpdated+            | Just cId <- webChannelId $ weBroadcast we -> do+                mChan <- preuse (csChannel(cId))+                case mChan of+                    Just chan -> do+                        refreshChannelById cId+                        updateSidebar (chan^.ccInfo.cdTeamId)+                    Nothing -> return ()+            | otherwise -> return ()++        WMGroupAdded+            | Just cId <- webChannelId (weBroadcast we) -> handleChannelInvite cId+            | otherwise -> return ()++        WMChannelMemberUpdated+            | Just channelMember <- wepChannelMember $ weData we ->+                  when (channelMemberUserId channelMember == myId) $+                      updateChannelNotifyProps+                      (channelMemberChannelId channelMember)+                      (channelMemberNotifyProps channelMember)+            | otherwise -> return ()++        WMAddedToTeam+            | Just tId <- wepTeamId $ weData we+            , Just uId <- wepUserId $ weData we -> do+                when (uId == myId && not (memberOf tId)) $ do+                    handleJoinTeam tId+            | otherwise -> return ()++        WMUpdateTeam+            | Just tId <- webTeamId $ weBroadcast we -> do+                when (memberOf tId) $ do+                    handleUpdateTeam tId+            | otherwise -> return ()++        WMLeaveTeam+            | Just tId <- wepTeamId $ weData we+            , Just uId <- wepUserId $ weData we -> do+                when (uId == myId && memberOf tId) $ do+                    handleLeaveTeam tId+            | otherwise -> return ()++        WMTeamDeleted -> do+            mhLog LogGeneral $ T.pack $+                "WMTeamDeleted event: " <> show we++        WMUserUpdated -> return ()++        -- We deliberately ignore these events:+        WMChannelCreated -> return ()+        WMEmojiAdded -> return ()+        WMWebRTC -> return ()+        WMHello -> return ()+        WMAuthenticationChallenge -> return ()+        WMUserRoleUpdated -> return ()+        WMPluginStatusesChanged -> return ()+        WMPluginEnabled -> return ()+        WMPluginDisabled -> return ()+        WMUnknownEvent {} ->+            mhLog LogWebsocket $ T.pack $+                "Websocket event not handled due to unknown event type: " <> show we++handleWebsocketActionResponse :: WebsocketActionResponse -> MH ()+handleWebsocketActionResponse r =+    case warStatus r of+        WebsocketActionStatusOK -> return ()

@@ -5,7 +5,7 @@   , lrsPort   , lrsUserId   , lrsSelectedChannelId-  , writeLastRunState+  , writeLastRunStates   , readLastRunState   , isValidLastRunState   )@@ -18,6 +18,7 @@ import qualified Data.Aeson as A import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS+import qualified Data.HashMap.Strict as HM import           Lens.Micro.Platform ( makeLenses ) import           System.Directory ( createDirectoryIfMissing ) import           System.FilePath ( dropFileName )@@ -63,7 +64,7 @@   { _lrsHost              = cs^.csResources.crConn.cdHostnameL   , _lrsPort              = cs^.csResources.crConn.cdPortL   , _lrsUserId            = myUserId cs-  , _lrsSelectedChannelId = cs^.csCurrentChannelId+  , _lrsSelectedChannelId = cs^.csCurrentChannelId(cs^.csCurrentTeamId)   }  lastRunStateFileMode :: P.FileMode@@ -71,16 +72,20 @@  -- | Writes the run state to a file. The file is specific to the current team. -- | Writes only if the current channel is an ordrinary or a private channel.-writeLastRunState :: ChatState -> IO ()-writeLastRunState cs =-  when (cs^.csCurrentChannel.ccInfo.cdType `elem` [Ordinary, Private]) $ do-    let runState = toLastRunState cs-        tId      = myTeamId cs+writeLastRunStates :: ChatState -> IO ()+writeLastRunStates cs =+    forM_ (HM.keys $ cs^.csTeams) $ \tId ->+        writeLastRunState cs tId -    lastRunStateFile <- lastRunStateFilePath $ unId $ toId tId-    createDirectoryIfMissing True $ dropFileName lastRunStateFile-    BS.writeFile lastRunStateFile $ LBS.toStrict $ A.encode runState-    P.setFileMode lastRunStateFile lastRunStateFileMode+writeLastRunState :: ChatState -> TeamId -> IO ()+writeLastRunState cs tId = do+    when (cs^.csCurrentChannel.ccInfo.cdType `elem` [Ordinary, Private]) $ do+        let runState = toLastRunState cs++        lastRunStateFile <- lastRunStateFilePath $ unId $ toId tId+        createDirectoryIfMissing True $ dropFileName lastRunStateFile+        BS.writeFile lastRunStateFile $ LBS.toStrict $ A.encode runState+        P.setFileMode lastRunStateFile lastRunStateFileMode  -- | Reads the last run state from a file given the current team ID. readLastRunState :: TeamId -> IO (Either String LastRunState)

@@ -47,8 +47,11 @@     ExitSuccess -> do         case null $ programStderr po of             True -> Just $ do-                mode <- use (csEditState.cedEditMode)-                sendMessage cId mode (T.pack $ programStdout po) []+                withChannel cId $ \chan -> do+                    mode <- case chan^.ccInfo.cdTeamId of+                        Nothing -> use (csCurrentTeam.tsEditState.cedEditMode)+                        Just tId -> use (csTeam(tId).tsEditState.cedEditMode)+                    sendMessage cId mode (T.pack $ programStdout po) []             False -> Nothing     ExitFailure _ -> Nothing 

@@ -34,20 +34,23 @@  showAttachmentList :: MH () showAttachmentList = do-    lst <- use (csEditState.cedAttachmentList)+    lst <- use (csCurrentTeam.tsEditState.cedAttachmentList)     case length (L.listElements lst) of         0 -> showAttachmentFileBrowser         _ -> setMode ManageAttachments  resetAttachmentList :: MH () resetAttachmentList = do-    csEditState.cedAttachmentList .= L.list AttachmentList mempty 1-    mh $ vScrollToBeginning $ viewportScroll AttachmentList+    tId <- use csCurrentTeamId+    let listName = AttachmentList tId+    csCurrentTeam.tsEditState.cedAttachmentList .= L.list listName mempty 1+    mh $ vScrollToBeginning $ viewportScroll listName  showAttachmentFileBrowser :: MH () showAttachmentFileBrowser = do     config <- use (csResources.crConfiguration)+    tId <- use csCurrentTeamId     filePath <- liftIO $ defaultAttachmentsPath config-    browser <- liftIO $ Just <$> FB.newFileBrowser FB.selectNonDirectories AttachmentFileBrowser filePath-    csEditState.cedFileBrowser .= browser+    browser <- liftIO $ Just <$> FB.newFileBrowser FB.selectNonDirectories (AttachmentFileBrowser tId) filePath+    csCurrentTeam.tsEditState.cedFileBrowser .= browser     setMode ManageAttachmentsBrowseFiles

@@ -22,7 +22,7 @@ import           Lens.Micro.Platform ( (%=), (.=), (.~), _Just, preuse ) import qualified Skylighting.Types as Sky -import           Network.Mattermost.Types (userId, channelId, Command(..))+import           Network.Mattermost.Types (userId, channelId, Command(..), TeamId) import qualified Network.Mattermost.Endpoints as MM  import           Matterhorn.Constants ( userSigil, normalChannelSigil )@@ -61,7 +61,7 @@     case result of         Nothing -> resetAutocomplete         Just (ty, runUpdater, searchString) -> do-            prevResult <- use (csEditState.cedAutocomplete)+            prevResult <- use (csCurrentTeam.tsEditState.cedAutocomplete)             -- We should update the completion state if EITHER:             --             -- 1) The type changed@@ -74,13 +74,13 @@                                 (maybe True ((== ty) . _acType) prevResult)) ||                                (maybe False ((/= ty) . _acType) prevResult)             when shouldUpdate $ do-                csEditState.cedAutocompletePending .= Just searchString+                csCurrentTeam.tsEditState.cedAutocompletePending .= Just searchString                 runUpdater ty ctx searchString  getCompleterForInput :: AutocompleteContext                      -> MH (Maybe (AutocompletionType, AutocompletionType -> AutocompleteContext -> Text -> MH (), Text)) getCompleterForInput ctx = do-    z <- use (csEditState.cedEditor.editContentsL)+    z <- use (csCurrentTeam.tsEditState.cedEditor.editContentsL)      let col = snd $ Z.cursorPosition z         curLine = Z.currentLine z@@ -105,21 +105,23 @@ doEmojiAutoCompletion ty ctx searchString = do     session <- getSession     em <- use (csResources.crEmoji)-    withCachedAutocompleteResults ctx ty searchString $+    tId <- use csCurrentTeamId+    withCachedAutocompleteResults tId ctx ty searchString $         doAsyncWith Preempt $ do             results <- getMatchingEmoji session em searchString             let alts = EmojiCompletion <$> results-            return $ Just $ setCompletionAlternatives ctx searchString alts ty+            return $ Just $ setCompletionAlternatives tId ctx searchString alts ty  doSyntaxAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH () doSyntaxAutoCompletion ty ctx searchString = do     mapping <- use (csResources.crSyntaxMap)+    tId <- use csCurrentTeamId     let allNames = Sky.sShortname <$> M.elems mapping         (prefixed, notPrefixed) = partition isPrefixed $ filter match allNames         match = (((T.toLower searchString) `T.isInfixOf`) . T.toLower)         isPrefixed = (((T.toLower searchString) `T.isPrefixOf`) . T.toLower)         alts = SyntaxCompletion <$> (sort prefixed <> sort notPrefixed)-    setCompletionAlternatives ctx searchString alts ty+    setCompletionAlternatives tId ctx searchString alts ty  -- | This list of server commands should be hidden because they make -- assumptions about a web-based client or otherwise just don't make@@ -165,10 +167,10 @@ doCommandAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH () doCommandAutoCompletion ty ctx searchString = do     session <- getSession-    myTid <- gets myTeamId+    myTid <- use csCurrentTeamId -    mCache <- preuse (csEditState.cedAutocomplete._Just.acCachedResponses)-    mActiveTy <- preuse (csEditState.cedAutocomplete._Just.acType)+    mCache <- preuse (csTeam(myTid).tsEditState.cedAutocomplete._Just.acCachedResponses)+    mActiveTy <- preuse (csTeam(myTid).tsEditState.cedAutocomplete._Just.acType)      -- Command completion works a little differently than the other     -- modes. To do command autocompletion, we want to query the server@@ -222,19 +224,19 @@                  return $ Just $ do                     -- Store the complete list of alterantives in the cache-                    setCompletionAlternatives ctx serverResponseKey alts ty+                    setCompletionAlternatives myTid ctx serverResponseKey alts ty                      -- Also store the list of alternatives specific to                     -- this search string                     let newAlts = sortBy (compareCommandAlts searchString) $                                   filter matches alts-                    setCompletionAlternatives ctx searchString newAlts ty+                    setCompletionAlternatives myTid ctx searchString newAlts ty         else case entry of            Just alts | mActiveTy == Just ACCommands ->                let newAlts = sortBy (compareCommandAlts searchString) $                              filter matches alts-               in setCompletionAlternatives ctx searchString newAlts ty+               in setCompletionAlternatives myTid ctx searchString newAlts ty            _ -> return ()  compareCommandAlts :: Text -> AutocompleteAlternative -> AutocompleteAlternative -> Ordering@@ -252,13 +254,13 @@ doUserAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH () doUserAutoCompletion ty ctx searchString = do     session <- getSession-    myTid <- gets myTeamId+    tId <- use csCurrentTeamId     myUid <- gets myUserId-    cId <- use csCurrentChannelId+    cId <- use (csCurrentChannelId(tId)) -    withCachedAutocompleteResults ctx ty searchString $+    withCachedAutocompleteResults tId ctx ty searchString $         doAsyncWith Preempt $ do-            ac <- MM.mmAutocompleteUsers (Just myTid) (Just cId) searchString session+            ac <- MM.mmAutocompleteUsers (Just tId) (Just cId) searchString session              let active = Seq.filter (\u -> userId u /= myUid && (not $ userDeleted u))                 alts = F.toList $@@ -273,22 +275,22 @@                          , (T.toLower searchString) `T.isPrefixOf` specialMentionName m                          ] -            return $ Just $ setCompletionAlternatives ctx searchString (alts <> extras) ty+            return $ Just $ setCompletionAlternatives tId ctx searchString (alts <> extras) ty  doChannelAutoCompletion :: AutocompletionType -> AutocompleteContext -> Text -> MH () doChannelAutoCompletion ty ctx searchString = do     session <- getSession-    tId <- gets myTeamId+    tId <- use csCurrentTeamId     cs <- use csChannels -    withCachedAutocompleteResults ctx ty searchString $ do+    withCachedAutocompleteResults tId ctx ty searchString $ do         doAsyncWith Preempt $ do             results <- MM.mmAutocompleteChannels tId searchString session             let alts = F.toList $ (ChannelCompletion True <$> inChannels) <>                                   (ChannelCompletion False <$> notInChannels)                 (inChannels, notInChannels) = Seq.partition isMember results                 isMember c = isJust $ findChannelById (channelId c) cs-            return $ Just $ setCompletionAlternatives ctx searchString alts ty+            return $ Just $ setCompletionAlternatives tId ctx searchString alts ty  -- Utility functions @@ -296,7 +298,8 @@ -- a given search string. If the cache contains no such entry (keyed -- on search string), run the specified action, which is assumed to be -- responsible for fetching the completion results from the server.-withCachedAutocompleteResults :: AutocompleteContext+withCachedAutocompleteResults :: TeamId+                              -> AutocompleteContext                               -- ^ The autocomplete context                               -> AutocompletionType                               -- ^ The type of autocompletion we're@@ -307,26 +310,27 @@                               -> MH ()                               -- ^ The action to execute on a cache miss                               -> MH ()-withCachedAutocompleteResults ctx ty searchString act = do-    mCache <- preuse (csEditState.cedAutocomplete._Just.acCachedResponses)-    mActiveTy <- preuse (csEditState.cedAutocomplete._Just.acType)+withCachedAutocompleteResults tId ctx ty searchString act = do+    mCache <- preuse (csTeam(tId).tsEditState.cedAutocomplete._Just.acCachedResponses)+    mActiveTy <- preuse (csTeam(tId).tsEditState.cedAutocomplete._Just.acType)      case Just ty == mActiveTy of         True ->             -- Does the cache have results for this search string? If             -- so, use them; otherwise invoke the specified action.             case HM.lookup searchString =<< mCache of-                Just alts -> setCompletionAlternatives ctx searchString alts ty+                Just alts -> setCompletionAlternatives tId ctx searchString alts ty                 Nothing -> act         False -> act -setCompletionAlternatives :: AutocompleteContext+setCompletionAlternatives :: TeamId+                          -> AutocompleteContext                           -> Text                           -> [AutocompleteAlternative]                           -> AutocompletionType                           -> MH ()-setCompletionAlternatives ctx searchString alts ty = do-    let list = L.list CompletionList (V.fromList $ F.toList alts) 1+setCompletionAlternatives tId ctx searchString alts ty = do+    let list = L.list (CompletionList tId) (V.fromList $ F.toList alts) 1         state = AutocompleteState { _acPreviousSearchString = searchString                                   , _acCompletionList =                                       list & L.listSelectedL .~ Nothing@@ -334,13 +338,13 @@                                   , _acType = ty                                   } -    pending <- use (csEditState.cedAutocompletePending)+    pending <- use (csTeam(tId).tsEditState.cedAutocompletePending)     case pending of         Just val | val == searchString -> do              -- If there is already state, update it, but also cache the             -- search results.-            csEditState.cedAutocomplete %= \prev ->+            csTeam(tId).tsEditState.cedAutocomplete %= \prev ->                 let newState = case prev of                         Nothing ->                             state@@ -349,7 +353,7 @@                                 HM.insert searchString alts (oldState^.acCachedResponses)                 in Just newState -            mh $ vScrollToBeginning $ viewportScroll CompletionList+            mh $ vScrollToBeginning $ viewportScroll $ CompletionList tId              when (autocompleteFirstMatch ctx) $                 tabComplete Forwards

@@ -0,0 +1,164 @@+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 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.+    z <- use (csCurrentTeam.tsFocus)+    myId <- gets myUserId+    scheduleUserStatusFetches $ myId : userIdsFromZipper z++    updateWindowTitle++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+    us <- getUsers+    prefs <- use (csResources.crUserPreferences)+    now <- liftIO getCurrentTime+    config <- use (csResources.crConfiguration)++    let zl = mkChannelZipperList now config tId cconfig prefs cs us+    csTeam(tId).tsFocus %= Z.updateList 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++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.+            csCurrentTeam.tsPendingChannelChange .= Nothing++            now <- liftIO getCurrentTime+            csChannel(cId).ccInfo.cdSidebarShowOverride .= Just now+            updateSidebar (ch^.ccInfo.cdTeamId)++            curTid <- use csCurrentTeamId+            let tId = fromMaybe curTid (ch^.ccInfo.cdTeamId)++            case ch^.ccInfo.cdType of+                Direct -> do+                    let Just uId = ch^.ccInfo.cdDMUserId+                    case dmChannelShowPreference prefs uId of+                        Just False -> do+                            let pref = showDirectChannelPref (me^.userIdL) uId True+                            when setPending $+                                csCurrentTeam.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 $+                                csCurrentTeam.tsPendingChannelChange .=+                                    Just (ChangeByChannelId tId (ch^.ccInfo.cdChannelId) Nothing)+                            doAsyncWith Preempt $ do+                                MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session+                                return Nothing+                        _ -> return ()++                _ -> return ()

@@ -27,9 +27,9 @@  enterChannelListOverlayMode :: MH () enterChannelListOverlayMode = do-    myTId <- gets myTeamId+    myTId <- use csCurrentTeamId     myChannels <- use (csChannels.to (filteredChannelIds (const True)))-    enterListOverlayMode csChannelListOverlay ChannelListOverlay+    enterListOverlayMode (csTeam(myTId).tsChannelListOverlay) ChannelListOverlay         AllChannels enterHandler (fetchResults myTId myChannels)  enterHandler :: Channel -> MH Bool@@ -75,7 +75,7 @@ -- cursor, and then check to see whether the modification warrants a -- prefetch of more search results. channelListMove :: (L.List Name Channel -> L.List Name Channel) -> MH ()-channelListMove = listOverlayMove csChannelListOverlay+channelListMove = listOverlayMove (csCurrentTeam.tsChannelListOverlay)  -- | The number of channels in a "page" for cursor movement purposes. channelListPageSize :: Int

@@ -24,14 +24,15 @@ beginChannelSelect :: MH () beginChannelSelect = do     setMode ChannelSelect-    csChannelSelectState .= emptyChannelSelectState+    tId <- use csCurrentTeamId+    csCurrentTeam.tsChannelSelectState .= emptyChannelSelectState tId     updateChannelSelectMatches      -- Preserve the current channel selection when initializing channel     -- selection mode-    zipper <- use csFocus+    zipper <- use (csCurrentTeam.tsFocus)     let isCurrentFocus m = Just (matchEntry m) == Z.focus zipper-    csChannelSelectState.channelSelectMatches %= Z.findRight isCurrentFocus+    csCurrentTeam.tsChannelSelectState.channelSelectMatches %= Z.findRight isCurrentFocus  -- Select the next match in channel selection mode. channelSelectNext :: MH ()@@ -45,7 +46,7 @@ updateChannelSelectMatches = do     st <- use id -    input <- use (csChannelSelectState.channelSelectInput)+    input <- use (csCurrentTeam.tsChannelSelectState.channelSelectInput)     cconfig <- use csClientConfig     prefs <- use (csResources.crUserPreferences) @@ -82,7 +83,8 @@         preserveFocus Nothing _ = False         preserveFocus (Just m) m2 = matchEntry m == matchEntry m2 -    csChannelSelectState.channelSelectMatches %= (Z.updateListBy preserveFocus $ Z.toList $ Z.maybeMapZipper matches (st^.csFocus))+    csCurrentTeam.tsChannelSelectState.channelSelectMatches %=+        (Z.updateListBy preserveFocus $ Z.toList $ Z.maybeMapZipper matches (st^.csCurrentTeam.tsFocus))  applySelectPattern :: ChannelSelectPattern -> ChannelListEntry -> Text -> Maybe ChannelSelectMatch applySelectPattern CSPAny entry chanName = do@@ -152,4 +154,4 @@ updateSelectedMatch :: (Z.Zipper ChannelListGroup ChannelSelectMatch -> Z.Zipper ChannelListGroup ChannelSelectMatch)                     -> MH () updateSelectedMatch nextItem =-    csChannelSelectState.channelSelectMatches %= nextItem+    csCurrentTeam.tsChannelSelectState.channelSelectMatches %= nextItem

@@ -3,6 +3,9 @@   ) where +import           Prelude ()+import           Matterhorn.Prelude+ import           Lens.Micro.Platform ( (.=) )  import           Matterhorn.Types@@ -12,5 +15,6 @@ openChannelTopicWindow :: MH () openChannelTopicWindow = do     t <- getCurrentChannelTopic-    csChannelTopicDialog .= newChannelTopicDialog t+    tId <- use csCurrentTeamId+    csCurrentTeam.tsChannelTopicDialog .= newChannelTopicDialog tId t     setMode ChannelTopicWindow

@@ -1,9 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} module Matterhorn.State.Channels-  ( updateSidebar-  , updateViewed-  , updateViewedChan+  ( updateViewed   , refreshChannel   , refreshChannelsAndUsers   , setFocus@@ -16,7 +14,6 @@   , nextUnreadChannel   , nextUnreadUserOrChannel   , createOrFocusDMChannel-  , clearChannelUnreadStatus   , prevChannel   , nextChannel   , recentChannel@@ -46,17 +43,16 @@   , setChannelTopic   , getCurrentChannelTopic   , beginCurrentChannelDeleteConfirm-  , toggleChannelListVisibility   , toggleExpandedChannelTopics-  , showChannelInSidebar   , updateChannelNotifyProps+  , renameChannelUrl   ) where  import           Prelude () import           Matterhorn.Prelude -import           Brick.Main ( getVtyHandle, viewportScroll, vScrollToBeginning+import           Brick.Main ( viewportScroll, vScrollToBeginning                             , invalidateCache, invalidateCacheEntry ) import           Brick.Widgets.Edit ( applyEdit, getEditContents, editContentsL ) import           Control.Concurrent.Async ( runConcurrently, Concurrently(..) )@@ -71,7 +67,6 @@ import qualified Data.Text as T import           Data.Text.Zipper ( textZipper, clearZipper, insertMany, gotoEOL ) import           Data.Time.Clock ( getCurrentTime )-import qualified Graphics.Vty as Vty import           Lens.Micro.Platform  import qualified Network.Mattermost.Endpoints as MM@@ -82,6 +77,7 @@ import           Matterhorn.InputHistory import           Matterhorn.State.Common import {-# SOURCE #-} Matterhorn.State.Messages ( fetchVisibleIfNeeded )+import           Matterhorn.State.ChannelList import           Matterhorn.State.Users import           Matterhorn.State.Flagging import           Matterhorn.Types@@ -90,53 +86,11 @@ import qualified Matterhorn.Zipper as Z  -updateSidebar :: MH ()-updateSidebar = do-    -- Invalidate the cached sidebar rendering since we are about to-    -- change the underlying state-    mh $ invalidateCacheEntry ChannelSidebar--    -- Get the currently-focused channel ID so we can compare after the-    -- zipper is rebuilt-    cconfig <- use csClientConfig-    oldCid <- use csCurrentChannelId--    -- Update the zipper-    cs <- use csChannels-    us <- getUsers-    prefs <- use (csResources.crUserPreferences)-    now <- liftIO getCurrentTime-    config <- use (csResources.crConfiguration)--    let zl = mkChannelZipperList now config cconfig prefs cs us-    csFocus %= Z.updateList zl--    -- Schedule the current sidebar for user status updates at the end-    -- of this MH action.-    newZ <- use csFocus-    myId <- gets myUserId-    scheduleUserStatusFetches $ myId : userIdsFromZipper newZ--    -- Update the window title based on the unread status of the-    -- channels.-    let unread = sum $ (channelListGroupUnread . fst) <$> zl-        title = "matterhorn" <> if unread > 0 then "(" <> show unread <> ")" else ""--    vty <- mh getVtyHandle-    liftIO $ Vty.setWindowTitle vty title--    -- 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-    when (newCid /= oldCid) $-        fetchVisibleIfNeeded- updateViewed :: Bool -> MH () updateViewed updatePrev = do     csCurrentChannel.ccInfo.cdMentionCount .= 0-    updateViewedChan updatePrev =<< use csCurrentChannelId+    tId <- use csCurrentTeamId+    updateViewedChan updatePrev =<< use (csCurrentChannelId tId)  -- | When a new channel has been selected for viewing, this will -- notify the server of the change, and also update the local channel@@ -149,15 +103,19 @@ -- of the specified channel, False should be provided. updateViewedChan :: Bool -> ChannelId -> MH () updateViewedChan updatePrev cId = use csConnectionStatus >>= \case+    -- Only do this if we're connected to avoid triggering noisy+    -- exceptions.     Connected -> do-        -- Only do this if we're connected to avoid triggering noisy-        -- exceptions.-        pId <- if updatePrev-               then use csRecentChannel-               else return Nothing-        doAsyncChannelMM Preempt cId-          (\s c -> MM.mmViewChannel UserMe c pId s)-          (\c () -> Just $ setLastViewedFor pId c)+        withChannel cId $ \chan -> do+            pId <- if updatePrev+                   then do+                       case chan^.ccInfo.cdTeamId of+                           Just tId -> use (csTeam(tId).tsRecentChannel)+                           Nothing -> use (csCurrentTeam.tsRecentChannel)+                   else return Nothing+            doAsyncChannelMM Preempt cId+              (\s c -> MM.mmViewChannel UserMe c pId s)+              (\c () -> Just $ setLastViewedFor pId c)     Disconnected ->         -- Cannot update server; make no local updates to avoid getting         -- out of sync with the server. Assumes that this is a temporary@@ -167,19 +125,17 @@         -- this state is irrelevant.         return () -toggleChannelListVisibility :: MH ()-toggleChannelListVisibility = do-    mh invalidateCache-    csShowChannelList %= not- toggleExpandedChannelTopics :: MH () toggleExpandedChannelTopics = do     mh invalidateCache-    csShowExpandedChannelTopics %= not+    csResources.crConfiguration.configShowExpandedChannelTopicsL %= not  -- | If the current channel is a DM channel with a single user or a -- group of users, hide it from the sidebar and adjust the server-side--- preference to hide it persistently.+-- preference to hide it persistently. Note that this does not actually+-- hide the channel in our UI; we hide it in response to the preference+-- change websocket event triggered by this function's API interaction+-- with the server. -- -- If the current channel is any other kind of channel, complain with a -- usage error.@@ -261,14 +217,17 @@ refreshChannelsAndUsers :: MH () refreshChannelsAndUsers = do     session <- getSession-    myTId <- gets myTeamId     me <- gets myUser     knownUsers <- gets allUserIds+    ts <- use csTeams     doAsyncWith Preempt $ do-      (chans, datas) <- runConcurrently $ (,)-                       <$> Concurrently (MM.mmGetChannelsForUser UserMe myTId session)-                       <*> Concurrently (MM.mmGetChannelMembersForUser UserMe myTId session)+      pairs <- forM (HM.keys ts) $ \tId -> do+          runConcurrently $ (,)+              <$> Concurrently (MM.mmGetChannelsForUser UserMe tId session)+              <*> Concurrently (MM.mmGetChannelMembersForUser UserMe tId session) +      let (chans, datas) = (mconcat $ fst <$> pairs, mconcat $ snd <$> pairs)+       -- Collect all user IDs associated with DM channels so we can       -- bulk-fetch their user records.       let dmUsers = catMaybes $ flip map (F.toList chans) $ \chan ->@@ -288,7 +247,7 @@           handleNewUsers (Seq.fromList uIdsToFetch) $ do               -- Then refresh all loaded channels               forM_ chansWithData $ uncurry (refreshChannel SidebarUpdateDeferred)-              updateSidebar+              updateSidebar Nothing  -- | Refresh information about a specific channel.  The channel -- metadata is refreshed, and if this is a loaded channel, the@@ -305,14 +264,16 @@ -- immediate setting is passed here. refreshChannel :: SidebarUpdate -> Channel -> ChannelMember -> MH () refreshChannel upd chan member = do-    let cId = getId chan-    myTId <- gets myTeamId-    let ourTeam = channelTeamId chan == Nothing ||-                  Just myTId == channelTeamId chan+    ts <- use csTeams+    let ourTeams = HM.keys ts+        isOurTeam = case channelTeamId chan of+            Nothing -> True+            Just tId -> tId `elem` ourTeams -    case not ourTeam of-        True -> return ()-        False -> do+    case isOurTeam of+        False -> return ()+        True -> do+            let cId = getId chan             -- If this channel is unknown, register it first.             mChan <- preuse (csChannel(cId))             when (isNothing mChan) $@@ -402,7 +363,7 @@                     -- switch to this channel when doing a sidebar                     -- update, since that's the only case where it's                     -- possible to do so.-                    updateSidebar+                    updateSidebar (cChannel^.ccInfo.cdTeamId)                      -- Finally, set our focus to the newly created                     -- channel if the caller requested a change of@@ -431,10 +392,11 @@ -- specified channel. checkPendingChannelChange :: ChannelId -> MH (Maybe (Maybe (MH ()))) checkPendingChannelChange cId = do-    ch <- use csPendingChannelChange+    ch <- use (csCurrentTeam.tsPendingChannelChange)+    curTid <- use csCurrentTeamId     return $ case ch of-        Just (ChangeByChannelId i act) ->-            if i == cId then Just act else Nothing+        Just (ChangeByChannelId tId i act) ->+            if i == cId && curTid == tId then Just act else Nothing         _ -> Nothing  -- | Check to see whether the specified channel has been queued up to@@ -448,7 +410,7 @@ -- specified channel. checkPendingChannelChangeByUserId :: UserId -> MH Bool checkPendingChannelChangeByUserId uId = do-    ch <- use csPendingChannelChange+    ch <- use (csCurrentTeam.tsPendingChannelChange)     return $ case ch of         Just (ChangeByUserId i) ->             i == uId@@ -461,94 +423,37 @@ updateChannelInfo cid new member = do     mh $ invalidateCacheEntry $ ChannelMessages cid     csChannel(cid).ccInfo %= channelInfoFromChannelWithData new member-    updateSidebar+    withChannel cid $ \chan ->+        updateSidebar (chan^.ccInfo.cdTeamId)  setFocus :: ChannelId -> MH () setFocus cId = do     showChannelInSidebar cId True     setFocusWith True (Z.findRight ((== cId) . channelListEntryChannelId)) (return ()) -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.-            csPendingChannelChange .= Nothing--            now <- liftIO getCurrentTime-            csChannel(cId).ccInfo.cdSidebarShowOverride .= Just now-            updateSidebar--            case ch^.ccInfo.cdType of-                Direct -> do-                    let Just uId = ch^.ccInfo.cdDMUserId-                    case dmChannelShowPreference prefs uId of-                        Just False -> do-                            let pref = showDirectChannelPref (me^.userIdL) uId True-                            when setPending $-                                csPendingChannelChange .= Just (ChangeByChannelId (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 $-                                csPendingChannelChange .= Just (ChangeByChannelId (ch^.ccInfo.cdChannelId) Nothing)-                            doAsyncWith Preempt $ do-                                MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session-                                return Nothing-                        _ -> return ()--                _ -> return ()- setFocusWith :: Bool              -> (Zipper ChannelListGroup ChannelListEntry              -> Zipper ChannelListGroup ChannelListEntry)              -> MH ()              -> MH () setFocusWith updatePrev f onNoChange = do-    oldZipper <- use csFocus+    tId <- use csCurrentTeamId+    oldZipper <- use (csCurrentTeam.tsFocus)     let newZipper = f oldZipper         newFocus = Z.focus newZipper         oldFocus = Z.focus oldZipper      -- If we aren't changing anything, skip all the book-keeping because-    -- we'll end up clobbering things like csRecentChannel.+    -- we'll end up clobbering things like tsRecentChannel.     if newFocus /= oldFocus        then do-          mh $ invalidateCacheEntry ChannelSidebar+          mh $ invalidateCacheEntry $ ChannelSidebar tId           resetAutocomplete           preChangeChannelCommon-          csFocus .= newZipper+          csCurrentTeam.tsFocus .= newZipper            now <- liftIO getCurrentTime-          newCid <- use csCurrentChannelId+          newCid <- use (csCurrentChannelId tId)           csChannel(newCid).ccInfo.cdSidebarShowOverride .= Just now            updateViewed updatePrev@@ -564,90 +469,70 @@  loadLastEdit :: MH () loadLastEdit = do-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)      oldEphemeral <- preuse (csChannel(cId).ccEditState)     case oldEphemeral of         Nothing -> return ()-        Just e -> csEditState.cedEphemeral .= e+        Just e -> csCurrentTeam.tsEditState.cedEphemeral .= e      loadLastChannelInput  loadLastChannelInput :: MH () loadLastChannelInput = do-    cId <- use csCurrentChannelId-    inputHistoryPos <- use (csEditState.cedEphemeral.eesInputHistoryPosition)+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)+    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)     case inputHistoryPos of         Just i -> loadHistoryEntryToEditor cId i         Nothing -> do-            (lastEdit, lastEditMode) <- use (csEditState.cedEphemeral.eesLastInput)-            csEditState.cedEditor %= (applyEdit $ insertMany lastEdit . clearZipper)-            csEditState.cedEditMode .= lastEditMode+            (lastEdit, lastEditMode) <- use (csCurrentTeam.tsEditState.cedEphemeral.eesLastInput)+            csCurrentTeam.tsEditState.cedEditor %= (applyEdit $ insertMany lastEdit . clearZipper)+            csCurrentTeam.tsEditState.cedEditMode .= lastEditMode  updateChannelListScroll :: MH () updateChannelListScroll = do-    mh $ vScrollToBeginning (viewportScroll ChannelList)+    tId <- use csCurrentTeamId+    mh $ vScrollToBeginning (viewportScroll $ ChannelList tId)  preChangeChannelCommon :: MH () preChangeChannelCommon = do-    cId <- use csCurrentChannelId-    csRecentChannel .= Just cId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)+    csCurrentTeam.tsRecentChannel .= Just cId     saveCurrentEdit  resetEditorState :: MH () resetEditorState = do-    csEditState.cedEditMode .= NewPost+    csCurrentTeam.tsEditState.cedEditMode .= NewPost     clearEditor  clearEditor :: MH ()-clearEditor = csEditState.cedEditor %= applyEdit clearZipper+clearEditor = csCurrentTeam.tsEditState.cedEditor %= applyEdit clearZipper  saveCurrentEdit :: MH () saveCurrentEdit = do     saveCurrentChannelInput -    oldEphemeral <- use (csEditState.cedEphemeral)-    cId <- use csCurrentChannelId+    oldEphemeral <- use (csCurrentTeam.tsEditState.cedEphemeral)+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     csChannel(cId).ccEditState .= oldEphemeral  saveCurrentChannelInput :: MH () saveCurrentChannelInput = do-    cmdLine <- use (csEditState.cedEditor)-    mode <- use (csEditState.cedEditMode)+    cmdLine <- use (csCurrentTeam.tsEditState.cedEditor)+    mode <- use (csCurrentTeam.tsEditState.cedEditMode)      -- Only save the editor contents if the user is not navigating the     -- history.-    inputHistoryPos <- use (csEditState.cedEphemeral.eesInputHistoryPosition)+    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)      when (isNothing inputHistoryPos) $-        csEditState.cedEphemeral.eesLastInput .=+        csCurrentTeam.tsEditState.cedEphemeral.eesLastInput .=            (T.intercalate "\n" $ getEditContents $ cmdLine, mode) -hideGroupChannelPref :: ChannelId -> UserId -> Preference-hideGroupChannelPref cId uId =-    Preference { preferenceCategory = PreferenceCategoryGroupChannelShow-               , preferenceValue = PreferenceValue "false"-               , preferenceName = PreferenceName $ idString cId-               , preferenceUserId = uId-               }--showGroupChannelPref :: ChannelId -> UserId -> Preference-showGroupChannelPref cId uId =-    Preference { preferenceCategory = PreferenceCategoryGroupChannelShow-               , preferenceValue = PreferenceValue "true"-               , preferenceName = PreferenceName $ idString cId-               , preferenceUserId = uId-               }--showDirectChannelPref :: UserId -> UserId -> Bool -> Preference-showDirectChannelPref myId otherId s =-    Preference { preferenceCategory = PreferenceCategoryDirectChannelShow-               , preferenceValue = if s then PreferenceValue "true"-                                        else PreferenceValue "false"-               , preferenceName = PreferenceName $ idString otherId-               , preferenceUserId = myId-               }- applyPreferenceChange :: Preference -> MH () applyPreferenceChange pref = do     -- always update our user preferences accordingly@@ -661,8 +546,11 @@       | Just f <- preferenceToFlaggedPost pref -> do           updateMessageFlag (flaggedPostId f) (flaggedPostStatus f) +      | Just tIds <- preferenceToTeamOrder pref ->+          applyTeamOrder tIds+       | Just d <- preferenceToDirectChannelShowStatus pref -> do-          updateSidebar+          updateSidebar Nothing            cs <- use csChannels @@ -683,7 +571,7 @@                   csChannel(cId).ccInfo.cdSidebarShowOverride .= Nothing        | Just g <- preferenceToGroupChannelPreference pref -> do-          updateSidebar+          updateSidebar Nothing            -- We need to check on whether this preference was to show a           -- channel and, if so, whether it was the one we attempted to@@ -716,16 +604,27 @@ removeChannelFromState cId = do     withChannel cId $ \ chan -> do         when (chan^.ccInfo.cdType /= Direct) $ do-            origFocus <- use csCurrentChannelId-            when (origFocus == cId) nextChannelSkipPrevView+            case chan^.ccInfo.cdTeamId of+                Nothing -> return ()+                Just tId -> do+                    origFocus <- use (csCurrentChannelId tId)+                    when (origFocus == cId) nextChannelSkipPrevView+             -- Update input history-            csEditState.cedInputHistory         %= removeChannelHistory cId+            csInputHistory %= removeChannelHistory cId             -- Update msgMap-            csChannels                          %= removeChannel cId-            -- Remove from focus zipper-            csFocus %= Z.filterZipper ((/= cId) . channelListEntryChannelId)-            updateSidebar+            csChannels %= removeChannel cId +            case chan^.ccInfo.cdTeamId of+                Nothing -> do+                    ts <- use csTeams+                    forM_ (HM.keys ts) $ \tId ->+                        csTeam(tId).tsFocus %= Z.filterZipper ((/= cId) . channelListEntryChannelId)+                Just tId -> do+                    csTeam(tId).tsFocus %= Z.filterZipper ((/= cId) . channelListEntryChannelId)++            updateSidebar $ chan^.ccInfo.cdTeamId+ nextChannel :: MH () nextChannel = do     resetReturnChannel@@ -743,26 +642,27 @@  recentChannel :: MH () recentChannel = do-  recent <- use csRecentChannel+  recent <- use (csCurrentTeam.tsRecentChannel)   case recent of     Nothing  -> return ()     Just cId -> do-        ret <- use csReturnChannel+        ret <- use (csCurrentTeam.tsReturnChannel)         when (ret == Just cId) resetReturnChannel         setFocus cId  resetReturnChannel :: MH () resetReturnChannel = do-  val <- use csReturnChannel+  val <- use (csCurrentTeam.tsReturnChannel)   case val of       Nothing -> return ()       Just _ -> do-          mh $ invalidateCacheEntry ChannelSidebar-          csReturnChannel .= Nothing+          tId <- use csCurrentTeamId+          mh $ invalidateCacheEntry $ ChannelSidebar tId+          csCurrentTeam.tsReturnChannel .= Nothing  gotoReturnChannel :: MH () gotoReturnChannel = do-  ret <- use csReturnChannel+  ret <- use (csCurrentTeam.tsReturnChannel)   case ret of     Nothing  -> return ()     Just cId -> do@@ -771,12 +671,13 @@  setReturnChannel :: MH () setReturnChannel = do-  ret <- use csReturnChannel+  ret <- use (csCurrentTeam.tsReturnChannel)   case ret of     Nothing  -> do-        cId <- use csCurrentChannelId-        csReturnChannel .= Just cId-        mh $ invalidateCacheEntry ChannelSidebar+        tId <- use csCurrentTeamId+        cId <- use (csCurrentChannelId tId)+        csCurrentTeam.tsReturnChannel .= Just cId+        mh $ invalidateCacheEntry $ ChannelSidebar tId     Just _ -> return ()  nextUnreadChannel :: MH ()@@ -854,21 +755,23 @@     -- for the next candidate channel.     Z.findRight (\e ->                 let cId = channelListEntryChannelId e-                in hasUnread st cId && (cId /= st^.csCurrentChannelId))+                in hasUnread st cId && (cId /= st^.csCurrentChannelId(st^.csCurrentTeamId)))  getNextUnreadUserOrChannel :: ChatState                            -> Zipper a ChannelListEntry                            -> Zipper a ChannelListEntry getNextUnreadUserOrChannel st z =     -- Find the next unread channel, prefering direct messages-    let cur = st^.csCurrentChannelId+    let cur = st^.csCurrentChannelId(st^.csCurrentTeamId)         matches e = entryIsDMEntry e && isFresh (channelListEntryChannelId e)         isFresh c = hasUnread st c && (c /= cur)     in fromMaybe (Z.findRight (isFresh . channelListEntryChannelId) z)                  (Z.maybeFindRight matches z)  leaveCurrentChannel :: MH ()-leaveCurrentChannel = use csCurrentChannelId >>= leaveChannel+leaveCurrentChannel = do+    tId <- use csCurrentTeamId+    use (csCurrentChannelId tId) >>= leaveChannel  createGroupChannel :: Text -> MH () createGroupChannel usernameList = do@@ -893,7 +796,9 @@                           -- we can just switch to it.                           setFocus (channelId chan)                       Nothing -> do-                          csPendingChannelChange .= (Just $ ChangeByChannelId (channelId chan) Nothing)+                          tId <- use csCurrentTeamId+                          csCurrentTeam.tsPendingChannelChange .=+                              (Just $ ChangeByChannelId tId (channelId chan) Nothing)                           let pref = showGroupChannelPref (channelId chan) (me^.userIdL)                           doAsyncWith Normal $ do                             MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session@@ -910,46 +815,48 @@ channelHistoryForward = do     resetAutocomplete -    cId <- use csCurrentChannelId-    inputHistoryPos <- use (csEditState.cedEphemeral.eesInputHistoryPosition)+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)+    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)     case inputHistoryPos of         Just i           | i == 0 -> do             -- Transition out of history navigation-            csEditState.cedEphemeral.eesInputHistoryPosition .= Nothing+            csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= Nothing             loadLastChannelInput           | otherwise -> do             let newI = i - 1             loadHistoryEntryToEditor cId newI-            csEditState.cedEphemeral.eesInputHistoryPosition .= (Just newI)+            csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= (Just newI)         _ -> return ()  loadHistoryEntryToEditor :: ChannelId -> Int -> MH () loadHistoryEntryToEditor cId idx = do-    inputHistory <- use (csEditState.cedInputHistory)+    inputHistory <- use csInputHistory     case getHistoryEntry cId idx inputHistory of         Nothing -> return ()         Just entry -> do             let eLines = T.lines entry                 mv = if length eLines == 1 then gotoEOL else id-            csEditState.cedEditor.editContentsL .= (mv $ textZipper eLines Nothing)+            csCurrentTeam.tsEditState.cedEditor.editContentsL .= (mv $ textZipper eLines Nothing)  channelHistoryBackward :: MH () channelHistoryBackward = do     resetAutocomplete -    cId <- use csCurrentChannelId-    inputHistoryPos <- use (csEditState.cedEphemeral.eesInputHistoryPosition)+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)+    inputHistoryPos <- use (csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition)     saveCurrentChannelInput      let newI = maybe 0 (+ 1) inputHistoryPos     loadHistoryEntryToEditor cId newI-    csEditState.cedEphemeral.eesInputHistoryPosition .= (Just newI)+    csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= (Just newI)  createOrdinaryChannel :: Bool -> Text -> MH () createOrdinaryChannel public name = do     session <- getSession-    myTId <- gets myTeamId+    myTId <- use csCurrentTeamId     doAsyncWith Preempt $ do         -- create a new chat channel         let slug = T.map (\ c -> if isAlphaNum c then c else '-') (T.toLower name)@@ -986,7 +893,8 @@  addUserToCurrentChannel :: UserInfo -> MH () addUserToCurrentChannel u = do-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     session <- getSession     let channelMember = MinChannelMember (u^.uiId) cId     doAsyncWith Normal $ do@@ -996,7 +904,8 @@ removeUserFromCurrentChannel :: Text -> MH () removeUserFromCurrentChannel uname =     withFetchedUser (UserFetchByUsername uname) $ \u -> do-        cId <- use csCurrentChannelId+        tId <- use csCurrentTeamId+        cId <- use (csCurrentChannelId tId)         session <- getSession         doAsyncWith Normal $ do             tryMM (void $ MM.mmRemoveUserFromChannel cId (UserById $ u^.uiId) session)@@ -1013,22 +922,23 @@ deleteCurrentChannel :: MH () deleteCurrentChannel = do     setMode Main-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     leaveChannelIfPossible cId True  isCurrentChannel :: ChatState -> ChannelId -> Bool-isCurrentChannel st cId = st^.csCurrentChannelId == cId+isCurrentChannel st cId = st^.csCurrentChannelId(st^.csCurrentTeamId) == cId  isRecentChannel :: ChatState -> ChannelId -> Bool-isRecentChannel st cId = st^.csRecentChannel == Just cId+isRecentChannel st cId = st^.csCurrentTeam.tsRecentChannel == Just cId  isReturnChannel :: ChatState -> ChannelId -> Bool-isReturnChannel st cId = st^.csReturnChannel == Just cId+isReturnChannel st cId = st^.csCurrentTeam.tsReturnChannel == Just cId  joinChannelByName :: Text -> MH () joinChannelByName rawName = do     session <- getSession-    tId <- gets myTeamId+    tId <- use csCurrentTeamId     doAsyncWith Preempt $ do         result <- try $ MM.mmGetChannelByName tId (trimChannelSigil rawName) session         return $ Just $ case result of@@ -1050,8 +960,9 @@             fromMaybe (return ()) act         Nothing -> do             myId <- gets myUserId+            tId <- use csCurrentTeamId             let member = MinChannelMember myId chanId-            csPendingChannelChange .= (Just $ ChangeByChannelId chanId act)+            csCurrentTeam.tsPendingChannelChange .= (Just $ ChangeByChannelId tId chanId act)             doAsyncChannelMM Preempt chanId (\ s c -> MM.mmAddUser c member s) (const $ return act)  createOrFocusDMChannel :: UserInfo -> Maybe (ChannelId -> MH ()) -> MH ()@@ -1067,7 +978,7 @@             -- We have a user of that name but no channel. Time to make one!             myId <- gets myUserId             session <- getSession-            csPendingChannelChange .= (Just $ ChangeByUserId $ user^.uiId)+            csCurrentTeam.tsPendingChannelChange .= (Just $ ChangeByUserId $ user^.uiId)             doAsyncWith Normal $ do                 -- create a new channel                 chan <- MM.mmCreateDirectMessageChannel (user^.uiId, myId) session@@ -1108,12 +1019,27 @@  setChannelTopic :: Text -> MH () setChannelTopic msg = do-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     let patch = defaultChannelPatch { channelPatchHeader = Just msg }     doAsyncChannelMM Preempt cId         (\s _ -> MM.mmPatchChannel cId patch s)         (\_ _ -> Nothing) +-- | This renames the current channel's url name. It makes a request+-- to the server to change the name, but does not actually change the+-- name in Matterhorn yet; that is handled by a websocket event handled+-- asynchronously.+renameChannelUrl :: Text -> MH ()+renameChannelUrl name = do+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)+    s <- getSession+    let patch = defaultChannelPatch { channelPatchName = Just name }+    doAsyncWith Normal $ do+        _ <- MM.mmPatchChannel cId patch s+        return Nothing+ getCurrentChannelTopic :: MH Text getCurrentChannelTopic = do     ch <- use csCurrentChannel@@ -1121,7 +1047,8 @@  beginCurrentChannelDeleteConfirm :: MH () beginCurrentChannelDeleteConfirm = do-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     withChannel cId $ \chan -> do         let chType = chan^.ccInfo.cdType         if chType /= Direct@@ -1130,5 +1057,11 @@  updateChannelNotifyProps :: ChannelId -> ChannelNotifyProps -> MH () updateChannelNotifyProps cId notifyProps = do-    mh $ invalidateCacheEntry ChannelSidebar-    csChannel(cId).ccInfo.cdNotifyProps .= notifyProps+    withChannel cId $ \chan -> do+        case chan^.ccInfo.cdTeamId of+            Nothing -> do+                ts <- use csTeams+                forM_ (HM.keys ts) (mh . invalidateCacheEntry . ChannelSidebar)+            Just tId -> mh $ invalidateCacheEntry $ ChannelSidebar tId++        csChannel(cId).ccInfo.cdNotifyProps .= notifyProps

@@ -67,19 +67,21 @@ -- This also sets the mFlagged field of each message based on whether -- its post ID is a flagged post according to crFlaggedPosts at the time -- of this call.-installMessagesFromPosts :: Posts -> MH Messages-installMessagesFromPosts postCollection = do+installMessagesFromPosts :: Maybe TeamId -> Posts -> MH Messages+installMessagesFromPosts mTId postCollection = do   flags <- use (csResources.crFlaggedPosts)    -- Add all posts in this collection to the global post cache-  updatePostMap postCollection+  updatePostMap mTId postCollection -  baseUrl <- getServerBaseUrl+  mBaseUrl <- case mTId of+      Nothing -> return Nothing+      Just tId -> Just <$> getServerBaseUrl tId    -- 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 baseUrl p (postId <$> parent p)+      mkClientPost p = toClientPost mBaseUrl p (postId <$> parent p)       clientPosts = mkClientPost <$> postsInOrder        addNext cp (msgs, us) =@@ -102,18 +104,21 @@             Just post -> post  -- Add all posts in this collection to the global post cache-updatePostMap :: Posts -> MH ()-updatePostMap postCollection = do+updatePostMap :: Maybe TeamId -> Posts -> MH ()+updatePostMap mTId postCollection = do   -- Build a map from post ID to Matterhorn message, then add the new   -- messages to the global post map. We use the "postsPosts" field for   -- this because that might contain more messages than the "postsOrder"   -- list, since the former can contain other messages in threads that   -- the server sent us, even if those messages are not part of the   -- ordered post listing of "postsOrder."-  baseUrl <- getServerBaseUrl+  mBaseUrl <- case mTId of+      Nothing -> return Nothing+      Just tId -> Just <$> getServerBaseUrl tId+   let postMap = HM.fromList           [ ( pId-            , fst $ clientPostToMessage (toClientPost baseUrl x Nothing)+            , fst $ clientPostToMessage (toClientPost mBaseUrl x Nothing)             )           | (pId, x) <- HM.toList (postCollection^.postsPostsL)           ]@@ -122,13 +127,15 @@ -- | Add a 'ClientMessage' to the current channel's message list addClientMessage :: ClientMessage -> MH () addClientMessage msg = do-  cid <- use csCurrentChannelId+  tId <- use csCurrentTeamId+  cid <- use (csCurrentChannelId(tId))   uuid <- generateUUID   let addCMsg = ccContents.cdMessages %~           (addMessage $ clientMessageToMessage msg & mMessageId .~ Just (MessageUUID uuid))   csChannels %= modifyChannelById cid addCMsg+   mh $ invalidateCacheEntry $ ChannelMessages cid-  mh $ invalidateCacheEntry ChannelSidebar+  mh $ invalidateCacheEntry $ ChannelSidebar tId    let msgTy = case msg^.cmType of         Error -> LogError@@ -152,7 +159,7 @@ postErrorMessageIO err st = do   msg <- newClientMessage Error err   uuid <- generateUUID_IO-  let cId = st ^. csCurrentChannelId+  let cId = st ^. csCurrentChannelId (st^.csCurrentTeamId)       addEMsg = ccContents.cdMessages %~           (addMessage $ clientMessageToMessage msg & mMessageId .~ Just (MessageUUID uuid))   return $ st & csChannels %~ modifyChannelById cId addEMsg

@@ -49,7 +49,7 @@ import qualified System.Process as Sys import           Text.Aspell ( AspellResponse(..), mistakeWord, askAspell ) -import           Network.Mattermost.Types ( Post(..), ChannelId )+import           Network.Mattermost.Types ( Post(..), ChannelId, TeamId )  import           Matterhorn.Config import {-# SOURCE #-} Matterhorn.Command ( dispatchCommand )@@ -66,20 +66,20 @@ startMultilineEditing :: MH () startMultilineEditing = do     mh invalidateCache-    csEditState.cedEphemeral.eesMultiline .= True+    csCurrentTeam.tsEditState.cedEphemeral.eesMultiline .= True  toggleMultilineEditing :: MH () toggleMultilineEditing = do     mh invalidateCache-    csEditState.cedEphemeral.eesMultiline %= not+    csCurrentTeam.tsEditState.cedEphemeral.eesMultiline %= not      -- If multiline is now disabled and there is more than one line in     -- the editor, that means we're showing the multiline message status     -- (see Draw.Main.renderUserCommandBox.commandBox) so we want to be     -- sure no autocomplete UI is present in case the cursor was left on     -- a word that would otherwise show completion alternatives.-    multiline <- use (csEditState.cedEphemeral.eesMultiline)-    numLines <- use (csEditState.cedEditor.to getEditContents.to length)+    multiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)+    numLines <- use (csCurrentTeam.tsEditState.cedEditor.to getEditContents.to length)     when (not multiline && numLines > 1) resetAutocomplete  invokeExternalEditor :: MH ()@@ -96,7 +96,7 @@       Sys.withSystemTempFile "matterhorn_editor.md" $ \tmpFileName tmpFileHandle -> do         -- Write the current message to the temp file         Sys.hPutStr tmpFileHandle $ T.unpack $ T.intercalate "\n" $-            getEditContents $ st^.csEditState.cedEditor+            getEditContents $ st^.csCurrentTeam.tsEditState.cedEditor         Sys.hClose tmpFileHandle          -- Run the editor@@ -112,26 +112,26 @@                         postErrorMessageIO "Failed to decode file contents as UTF-8" st                     Right t -> do                         let tmpLines = T.lines $ sanitizeUserText' t-                        return $ st & csEditState.cedEditor.editContentsL .~ (Z.textZipper tmpLines Nothing)+                        return $ st & csCurrentTeam.tsEditState.cedEditor.editContentsL .~ (Z.textZipper tmpLines Nothing)             Sys.ExitFailure _ -> return st  handlePaste :: BS.ByteString -> MH () handlePaste bytes = do   let pasteStr = T.pack (UTF8.toString bytes)-  csEditState.cedEditor %= applyEdit (Z.insertMany (sanitizeUserText' pasteStr))-  contents <- use (csEditState.cedEditor.to getEditContents)+  csCurrentTeam.tsEditState.cedEditor %= applyEdit (Z.insertMany (sanitizeUserText' pasteStr))+  contents <- use (csCurrentTeam.tsEditState.cedEditor.to getEditContents)   case length contents > 1 of       True -> startMultilineEditing       False -> return ()  editingPermitted :: ChatState -> Bool editingPermitted st =-    (length (getEditContents $ st^.csEditState.cedEditor) == 1) ||-    st^.csEditState.cedEphemeral.eesMultiline+    (length (getEditContents $ st^.csCurrentTeam.tsEditState.cedEditor) == 1) ||+    st^.csCurrentTeam.tsEditState.cedEphemeral.eesMultiline  messageEditingKeybindings :: KeyConfig -> KeyHandlerMap messageEditingKeybindings kc =-    let KeyHandlerMap m = editingKeybindings (csEditState.cedEditor) kc+    let KeyHandlerMap m = editingKeybindings (csCurrentTeam.tsEditState.cedEditor) kc     in KeyHandlerMap $ M.map withUserTypingAction m  withUserTypingAction :: KeyHandler -> KeyHandler@@ -167,7 +167,7 @@     "Kill the line to the right of the current position and copy it" $ do       z <- use (editor.editContentsL)       let restOfLine = Z.currentLine (Z.killToBOL z)-      csEditState.cedYankBuffer .= restOfLine+      csCurrentTeam.tsEditState.cedYankBuffer .= restOfLine       editor %= applyEdit Z.killToEOL   , mkKb EditorNextCharEvent     "Move one character to the right"@@ -195,13 +195,13 @@     editor %= applyEdit gotoEnd   , mkKb EditorYankEvent     "Paste the current buffer contents at the cursor" $ do-      buf <- use (csEditState.cedYankBuffer)+      buf <- use (csCurrentTeam.tsEditState.cedYankBuffer)       editor %= applyEdit (Z.insertMany buf)   ]  getEditorContent :: MH Text getEditorContent = do-    cmdLine <- use (csEditState.cedEditor)+    cmdLine <- use (csCurrentTeam.tsEditState.cedEditor)     let (line:rest) = getEditContents cmdLine     return $ T.intercalate "\n" $ line : rest @@ -216,21 +216,22 @@ -- *source* of the text, so it also takes care of clearing the editor, -- resetting the edit mode, updating the input history for the specified -- channel, etc.-handleInputSubmission :: ChannelId -> Text -> MH ()-handleInputSubmission cId content = do+handleInputSubmission :: TeamId -> ChannelId -> Text -> MH ()+handleInputSubmission tId cId content = do     -- We clean up before dispatching the command or sending the message     -- since otherwise the command could change the state and then doing     -- cleanup afterwards could clean up the wrong things.-    csEditState.cedEditor %= applyEdit Z.clearZipper-    csEditState.cedInputHistory %= addHistoryEntry content cId-    csEditState.cedEphemeral.eesInputHistoryPosition .= Nothing+    csTeam(tId).tsEditState.cedEditor %= applyEdit Z.clearZipper+    csTeam(tId).tsEditState.cedEphemeral.eesInputHistoryPosition .= Nothing +    csInputHistory %= addHistoryEntry content cId+     case T.uncons content of       Just ('/', cmd) ->           dispatchCommand cmd       _ -> do-          attachments <- use (csEditState.cedAttachmentList.L.listElementsL)-          mode <- use (csEditState.cedEditMode)+          attachments <- use (csTeam(tId).tsEditState.cedAttachmentList.L.listElementsL)+          mode <- use (csTeam(tId).tsEditState.cedEditMode)           sendMessage cId mode content $ F.toList attachments      -- Reset the autocomplete UI@@ -241,7 +242,7 @@      -- Reset the edit mode *after* handling the input so that the input     -- handler can tell whether we're editing, replying, etc.-    csEditState.cedEditMode .= NewPost+    csTeam(tId).tsEditState.cedEditMode .= NewPost  closingPunctuationMarks :: String closingPunctuationMarks = ".,'\";:)]!?"@@ -262,18 +263,18 @@     -- Record the input line count before handling the editing event     -- so we can tell whether the editing event changes the line count     -- later.-    beforeLineCount <- use (csEditState.cedEditor.to getEditContents.to length)+    beforeLineCount <- use (csCurrentTeam.tsEditState.cedEditor.to getEditContents.to length) -    smartBacktick <- use (csResources.crConfiguration.to configSmartBacktick)+    smartBacktick <- use (csResources.crConfiguration.configSmartBacktickL)     let smartChars = "*`_"     st <- use id-    csEditState.cedEphemeral.eesInputHistoryPosition .= Nothing+    csCurrentTeam.tsEditState.cedEphemeral.eesInputHistoryPosition .= Nothing -    smartEditing <- use (csResources.crConfiguration.to configSmartEditing)-    justCompleted <- use (csEditState.cedJustCompleted)+    smartEditing <- use (csResources.crConfiguration.configSmartEditingL)+    justCompleted <- use (csCurrentTeam.tsEditState.cedJustCompleted)      conf <- use (csResources.crConfiguration)-    let keyMap = editingKeybindings (csEditState.cedEditor) (configUserKeys conf)+    let keyMap = editingKeybindings (csCurrentTeam.tsEditState.cedEditor) (configUserKeys conf)     case lookupKeybinding e keyMap of       Just kb | editingPermitted st -> (ehAction $ kehHandler $ khHandler kb)       _ -> do@@ -281,52 +282,52 @@           -- Not editing; backspace here means cancel multi-line message           -- composition           EvKey KBS [] | (not $ editingPermitted st) ->-            csEditState.cedEditor %= applyEdit Z.clearZipper+            csCurrentTeam.tsEditState.cedEditor %= applyEdit Z.clearZipper            -- Backspace in editing mode with smart pair insertion means           -- smart pair removal when possible           EvKey KBS [] | editingPermitted st && smartBacktick ->-              let backspace = csEditState.cedEditor %= applyEdit Z.deletePrevChar-              in case cursorAtOneOf smartChars (st^.csEditState.cedEditor) of+              let backspace = csCurrentTeam.tsEditState.cedEditor %= applyEdit Z.deletePrevChar+              in case cursorAtOneOf smartChars (st^.csCurrentTeam.tsEditState.cedEditor) of                   Nothing -> backspace                   Just ch ->                       -- Smart char removal:-                      if | (cursorAtChar ch $ applyEdit Z.moveLeft $ st^.csEditState.cedEditor) &&-                           (cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csEditState.cedEditor) ->-                             csEditState.cedEditor %= applyEdit (Z.deleteChar >>> Z.deletePrevChar)+                      if | (cursorAtChar ch $ applyEdit Z.moveLeft $ st^.csCurrentTeam.tsEditState.cedEditor) &&+                           (cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csCurrentTeam.tsEditState.cedEditor) ->+                             csCurrentTeam.tsEditState.cedEditor %= applyEdit (Z.deleteChar >>> Z.deletePrevChar)                          | otherwise -> backspace            EvKey (KChar ch) []             | editingPermitted st && smartBacktick && ch `elem` smartChars ->               -- Smart char insertion:               let doInsertChar = do-                    csEditState.cedEditor %= applyEdit (Z.insertChar ch)+                    csCurrentTeam.tsEditState.cedEditor %= applyEdit (Z.insertChar ch)                     sendUserTypingAction-                  curLine = Z.currentLine $ st^.csEditState.cedEditor.editContentsL+                  curLine = Z.currentLine $ st^.csCurrentTeam.tsEditState.cedEditor.editContentsL               -- First case: if the cursor is at the end of the current               -- line and it contains "``" and the user entered a third               -- "`", enable multi-line mode since they're likely typing               -- a code block.-              in if | (cursorIsAtEnd $ st^.csEditState.cedEditor) &&+              in if | (cursorIsAtEnd $ st^.csCurrentTeam.tsEditState.cedEditor) &&                          curLine == "``" &&                          ch == '`' -> do-                        csEditState.cedEditor %= applyEdit (Z.insertMany (T.singleton ch))-                        csEditState.cedEphemeral.eesMultiline .= True+                        csCurrentTeam.tsEditState.cedEditor %= applyEdit (Z.insertMany (T.singleton ch))+                        csCurrentTeam.tsEditState.cedEphemeral.eesMultiline .= True                     -- Second case: user entered some smart character                     -- (don't care which) on an empty line or at the end                     -- of the line after whitespace, so enter a pair of                     -- the smart chars and put the cursor between them.-                    | (editorEmpty $ st^.csEditState.cedEditor) ||-                         ((cursorAtChar ' ' (applyEdit Z.moveLeft $ st^.csEditState.cedEditor)) &&-                          (cursorIsAtEnd $ st^.csEditState.cedEditor)) ->-                        csEditState.cedEditor %= applyEdit (Z.insertMany (T.pack $ ch:ch:[]) >>> Z.moveLeft)+                    | (editorEmpty $ st^.csCurrentTeam.tsEditState.cedEditor) ||+                         ((cursorAtChar ' ' (applyEdit Z.moveLeft $ st^.csCurrentTeam.tsEditState.cedEditor)) &&+                          (cursorIsAtEnd $ st^.csCurrentTeam.tsEditState.cedEditor)) ->+                        csCurrentTeam.tsEditState.cedEditor %= applyEdit (Z.insertMany (T.pack $ ch:ch:[]) >>> Z.moveLeft)                     -- Third case: the cursor is already on a smart                     -- character and that character is the last one                     -- on the line, so instead of inserting a new                     -- character, just move past it.-                    | (cursorAtChar ch $ st^.csEditState.cedEditor) &&-                      (cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csEditState.cedEditor) ->-                        csEditState.cedEditor %= applyEdit Z.moveRight+                    | (cursorAtChar ch $ st^.csCurrentTeam.tsEditState.cedEditor) &&+                      (cursorIsAtEnd $ applyEdit Z.moveRight $ st^.csCurrentTeam.tsEditState.cedEditor) ->+                        csCurrentTeam.tsEditState.cedEditor %= applyEdit Z.moveRight                     -- Fall-through case: just insert one of the chars                     -- without doing anything smart.                     | otherwise -> doInsertChar@@ -336,12 +337,12 @@               -- there is a trailing space that we want to remove if the               -- next input character is punctuation.               when (smartEditing && justCompleted && isSmartClosingPunctuation e) $-                  csEditState.cedEditor %= applyEdit Z.deletePrevChar+                  csCurrentTeam.tsEditState.cedEditor %= applyEdit Z.deletePrevChar -              csEditState.cedEditor %= applyEdit (Z.insertMany (sanitizeUserText' $ T.singleton ch))+              csCurrentTeam.tsEditState.cedEditor %= applyEdit (Z.insertMany (sanitizeUserText' $ T.singleton ch))               sendUserTypingAction           _ | editingPermitted st -> do-              mhHandleEventLensed (csEditState.cedEditor) handleEditorEvent e+              mhHandleEventLensed (csCurrentTeam.tsEditState.cedEditor) handleEditorEvent e               sendUserTypingAction             | otherwise -> return () @@ -349,23 +350,24 @@                                   , autocompleteFirstMatch = False                                   }     checkForAutocompletion ctx-    liftIO $ resetSpellCheckTimer $ st^.csEditState+    liftIO $ resetSpellCheckTimer $ st^.csCurrentTeam.tsEditState      -- If the preview is enabled and multi-line editing is enabled and     -- the line count changed, we need to invalidate the rendering cache     -- entry for the channel messages because we want to redraw them to     -- fit in the space just changed by the size of the preview area.-    afterLineCount <- use (csEditState.cedEditor.to getEditContents.to length)-    isMultiline <- use (csEditState.cedEphemeral.eesMultiline)-    isPreviewing <- use csShowMessagePreview+    afterLineCount <- use (csCurrentTeam.tsEditState.cedEditor.to getEditContents.to length)+    isMultiline <- use (csCurrentTeam.tsEditState.cedEphemeral.eesMultiline)+    isPreviewing <- use (csResources.crConfiguration.configShowMessagePreviewL)     when (beforeLineCount /= afterLineCount && isMultiline && isPreviewing) $ do-        cId <- use csCurrentChannelId+        tId <- use csCurrentTeamId+        cId <- use (csCurrentChannelId tId)         mh $ invalidateCacheEntry $ ChannelMessages cId      -- Reset the recent autocompletion flag to stop smart punctuation     -- handling.     when justCompleted $-        csEditState.cedJustCompleted .= False+        csCurrentTeam.tsEditState.cedJustCompleted .= False  -- | Send the user_typing action to the server asynchronously, over the -- connected websocket. If the websocket is not connected, drop the@@ -376,12 +378,13 @@   when (configShowTypingIndicator (st^.csResources.crConfiguration)) $     case st^.csConnectionStatus of       Connected -> do-        let pId = case st^.csEditState.cedEditMode of+        let pId = case st^.csCurrentTeam.tsEditState.cedEditMode of                     Replying _ post -> Just $ postId post                     _               -> Nothing+        tId <- use csCurrentTeamId         liftIO $ do           now <- getCurrentTime-          let action = UserTyping now (st^.csCurrentChannelId) pId+          let action = UserTyping now (st^.csCurrentChannelId(tId)) pId           STM.atomically $ STM.writeTChan (st^.csResources.crWebsocketActionChan) action       Disconnected -> return () @@ -390,11 +393,12 @@ requestSpellCheck :: MH () requestSpellCheck = do     st <- use id-    case st^.csEditState.cedSpellChecker of+    case st^.csCurrentTeam.tsEditState.cedSpellChecker of         Nothing -> return ()         Just (checker, _) -> do             -- Get the editor contents.-            contents <- getEditContents <$> use (csEditState.cedEditor)+            tId <- use csCurrentTeamId+            contents <- getEditContents <$> use (csTeam(tId).tsEditState.cedEditor)             doAsyncWith Preempt $ do                 -- For each line in the editor, submit an aspell request.                 let query = concat <$> mapM (askAspell checker) contents@@ -403,7 +407,7 @@                         let getMistakes AllCorrect = []                             getMistakes (Mistakes ms) = mistakeWord <$> ms                             allMistakes = S.fromList $ concat $ getMistakes <$> responses-                        csEditState.cedMisspellings .= allMistakes+                        csTeam(tId).tsEditState.cedMisspellings .= allMistakes                  tryMM query (return . Just . postMistakes) @@ -452,19 +456,20 @@  cancelAutocompleteOrReplyOrEdit :: MH () cancelAutocompleteOrReplyOrEdit = do-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     mh $ invalidateCacheEntry $ ChannelMessages cId-    ac <- use (csEditState.cedAutocomplete)+    ac <- use (csCurrentTeam.tsEditState.cedAutocomplete)     case ac of         Just _ -> do             resetAutocomplete         Nothing -> do-            mode <- use (csEditState.cedEditMode)+            mode <- use (csCurrentTeam.tsEditState.cedEditMode)             case mode of                 NewPost -> return ()                 _ -> do-                    csEditState.cedEditMode .= NewPost-                    csEditState.cedEditor %= applyEdit Z.clearZipper+                    csCurrentTeam.tsEditState.cedEditMode .= NewPost+                    csCurrentTeam.tsEditState.cedEditor %= applyEdit Z.clearZipper                     resetAttachmentList  replyToLatestMessage :: MH ()@@ -474,9 +479,10 @@     Just msg | isReplyable msg ->         do rootMsg <- getReplyRootMessage msg            setMode Main-           cId <- use csCurrentChannelId+           tId <- use csCurrentTeamId+           cId <- use (csCurrentChannelId tId)            mh $ invalidateCacheEntry $ ChannelMessages cId-           csEditState.cedEditMode .= Replying rootMsg (fromJust $ rootMsg^.mOriginalPost)+           csCurrentTeam.tsEditState.cedEditMode .= Replying rootMsg (fromJust $ rootMsg^.mOriginalPost)     _ -> return ()  data Direction = Forwards | Backwards@@ -496,9 +502,9 @@                        (L.listSelected list == Nothing && len > 0)                     then L.listMoveTo (len - 1) list                     else L.listMoveBy (-1) list-    csEditState.cedAutocomplete._Just.acCompletionList %= transform+    csCurrentTeam.tsEditState.cedAutocomplete._Just.acCompletionList %= transform -    mac <- use (csEditState.cedAutocomplete)+    mac <- use (csCurrentTeam.tsEditState.cedAutocomplete)     case mac of         Nothing -> do             let ctx = AutocompleteContext { autocompleteManual = True@@ -514,10 +520,10 @@                             if maybe True isSpace (Z.currentChar z)                             then z                             else Z.moveWordRight z-                    csEditState.cedEditor %=+                    csCurrentTeam.tsEditState.cedEditor %=                         applyEdit (Z.insertChar ' ' . Z.insertMany replacement . Z.deletePrevWord .                                    maybeEndOfWord)-                    csEditState.cedJustCompleted .= True+                    csCurrentTeam.tsEditState.cedJustCompleted .= True                      -- If there was only one completion alternative,                     -- hide the autocomplete listing now that we've

@@ -9,6 +9,7 @@  import           Data.Function ( on ) import qualified Data.Set as Set+import qualified Data.HashMap.Strict as HM import           Lens.Micro.Platform  import           Network.Mattermost.Types@@ -38,29 +39,42 @@   msgMb <- use (csPostMap.at(pId))   case msgMb of     Just msg-      | Just cId <- msg^.mChannelId -> do+      | Just cId <- msg^.mChannelId -> withChannel cId $ \chan -> do       let isTargetMessage m = m^.mMessageId == Just (MessagePostId pId)       csChannel(cId).ccContents.cdMessages.traversed.filtered isTargetMessage.mFlagged .= f       csPostMap.ix(pId).mFlagged .= f-      -- We also want to update the post overlay if this happens while-      -- we're we're observing it-      mode <- gets appMode-      case mode of-        PostListOverlay PostListFlagged-          | f ->-              csPostListOverlay.postListPosts %=-                addMessage (msg & mFlagged .~ True)-          -- deleting here is tricky, because it means that we need to-          -- move the focus somewhere: we'll try moving it _up_ unless-          -- we can't, in which case we'll try moving it down.-          | otherwise -> do-              selId <- use (csPostListOverlay.postListSelected)-              posts <- use (csPostListOverlay.postListPosts)-              let nextId = case getNextPostId selId posts of-                    Nothing -> getPrevPostId selId posts-                    Just x  -> Just x-              csPostListOverlay.postListSelected .= nextId-              csPostListOverlay.postListPosts %=-                filterMessages (((/=) `on` _mMessageId) msg)-        _ -> return ()++      let mTId = chan^.ccInfo.cdTeamId+          updatePostOverlay :: TeamId -> MH ()+          updatePostOverlay tId = do+              -- We also want to update the post overlay if this happens+              -- while we're we're observing it+              mode <- use (csTeam tId.tsMode)+              case mode of+                PostListOverlay PostListFlagged+                  | f ->+                      csTeam tId.tsPostListOverlay.postListPosts %=+                        addMessage (msg & mFlagged .~ True)++                  -- deleting here is tricky, because it means that we+                  -- need to move the focus somewhere: we'll try moving+                  -- it _up_ unless we can't, in which case we'll try+                  -- moving it down.+                  | otherwise -> do+                      selId <- use (csTeam tId.tsPostListOverlay.postListSelected)+                      posts <- use (csTeam tId.tsPostListOverlay.postListPosts)+                      let nextId = case getNextPostId selId posts of+                            Nothing -> getPrevPostId selId posts+                            Just x  -> Just x+                      csTeam tId.tsPostListOverlay.postListSelected .= nextId+                      csTeam tId.tsPostListOverlay.postListPosts %=+                        filterMessages (((/=) `on` _mMessageId) msg)+                _ -> return ()++      case mTId of+          Nothing -> do+              ts <- use csTeams+              forM_ (HM.keys ts) updatePostOverlay+          Just tId -> updatePostOverlay tId+     _ -> return ()

@@ -13,7 +13,7 @@  showHelpScreen :: HelpTopic -> MH () showHelpScreen topic = do-    curMode <- gets appMode+    curMode <- use (csCurrentTeam.tsMode)     case curMode of         ShowHelp {} -> return ()         _ -> do

@@ -54,9 +54,9 @@  getSelectedMessage :: ChatState -> Maybe Message getSelectedMessage st-    | not (appMode st `elem` messageSelectCompatibleModes) = Nothing+    | not (st^.csCurrentTeam.tsMode `elem` messageSelectCompatibleModes) = Nothing     | otherwise = do-        selMsgId <- selectMessageId $ st^.csMessageSelect+        selMsgId <- selectMessageId $ st^.csCurrentTeam.tsMessageSelect         let chanMsgs = st ^. csCurrentChannel . ccContents . cdMessages         findMessage selMsgId chanMsgs @@ -74,7 +74,7 @@      when (isJust recentMsg) $ do         setMode MessageSelect-        csMessageSelect .= MessageSelectState (recentMsg >>= _mMessageId)+        csCurrentTeam.tsMessageSelect .= MessageSelectState (recentMsg >>= _mMessageId)  -- | Tell the server that the message we currently have selected -- should have its flagged state toggled.@@ -111,14 +111,16 @@   selected <- use (to getSelectedMessage)   case selected of     Just msg-      | isGap msg -> do cId <- use csCurrentChannelId+      | isGap msg -> do tId <- use csCurrentTeamId+                        cId <- use (csCurrentChannelId tId)                         asyncFetchMessagesForGap cId msg     _        -> return ()  viewMessage :: Message -> MH () viewMessage m = do-    let w = tabbedWindow VMTabMessage viewMessageWindowTemplate MessageSelect (78, 25)-    csViewedMessage .= Just (m, w)+    tId <- use csCurrentTeamId+    let w = tabbedWindow VMTabMessage (viewMessageWindowTemplate tId) MessageSelect (78, 25)+    csCurrentTeam.tsViewedMessage .= Just (m, w)     runTabShowHandlerFor (twValue w) w     setMode ViewMessage @@ -168,23 +170,23 @@  messageSelectUp :: MH () messageSelectUp = do-    mode <- gets appMode-    selected <- use (csMessageSelect.to selectMessageId)+    mode <- use (csCurrentTeam.tsMode)+    selected <- use (csCurrentTeam.tsMessageSelect.to selectMessageId)     case selected of         Just _ | mode == MessageSelect -> do             chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)             let nextMsgId = getPrevMessageId selected chanMsgs-            csMessageSelect .= MessageSelectState (nextMsgId <|> selected)+            csCurrentTeam.tsMessageSelect .= MessageSelectState (nextMsgId <|> selected)         _ -> return ()  messageSelectDown :: MH () messageSelectDown = do-    selected <- use (csMessageSelect.to selectMessageId)+    selected <- use (csCurrentTeam.tsMessageSelect.to selectMessageId)     case selected of         Just _ -> whenMode MessageSelect $ do             chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)             let nextMsgId = getNextMessageId selected chanMsgs-            csMessageSelect .= MessageSelectState (nextMsgId <|> selected)+            csCurrentTeam.tsMessageSelect .= MessageSelectState (nextMsgId <|> selected)         _ -> return ()  messageSelectDownBy :: Int -> MH ()@@ -201,25 +203,25 @@  messageSelectFirst :: MH () messageSelectFirst = do-    selected <- use (csMessageSelect.to selectMessageId)+    selected <- use (csCurrentTeam.tsMessageSelect.to selectMessageId)     case selected of         Just _ -> whenMode MessageSelect $ do             chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)             case getEarliestSelectableMessage chanMsgs of               Just firstMsg ->-                csMessageSelect .= MessageSelectState (firstMsg^.mMessageId <|> selected)+                csCurrentTeam.tsMessageSelect .= MessageSelectState (firstMsg^.mMessageId <|> selected)               Nothing -> mhLog LogError "No first message found from current message?!"         _ -> return ()  messageSelectLast :: MH () messageSelectLast = do-    selected <- use (csMessageSelect.to selectMessageId)+    selected <- use (csCurrentTeam.tsMessageSelect.to selectMessageId)     case selected of         Just _ -> whenMode MessageSelect $ do             chanMsgs <- use (csCurrentChannel.ccContents.cdMessages)             case getLatestSelectableMessage chanMsgs of               Just lastSelMsg ->-                csMessageSelect .= MessageSelectState (lastSelMsg^.mMessageId <|> selected)+                csCurrentTeam.tsMessageSelect .= MessageSelectState (lastSelMsg^.mMessageId <|> selected)               Nothing -> mhLog LogError "No last message found from current message?!"         _ -> return () @@ -227,7 +229,8 @@ deleteSelectedMessage = do     selectedMessage <- use (to getSelectedMessage)     st <- use id-    cId <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     case selectedMessage of         Just msg | isMine st msg && isDeletable msg ->             case msg^.mOriginalPost of@@ -235,7 +238,7 @@                   doAsyncChannelMM Preempt cId                       (\s _ -> MM.mmDeletePost (postId p) s)                       (\_ _ -> Just $ do-                          csEditState.cedEditMode .= NewPost+                          csCurrentTeam.tsEditState.cedEditMode .= NewPost                           setMode Main)               Nothing -> return ()         _ -> return ()@@ -248,7 +251,7 @@             rootMsg <- getReplyRootMessage msg             let Just p = rootMsg^.mOriginalPost             setMode Main-            csEditState.cedEditMode .= Replying rootMsg p+            csCurrentTeam.tsEditState.cedEditMode .= Replying rootMsg p         _ -> return ()  beginEditMessage :: MH ()@@ -259,7 +262,7 @@         Just msg | isMine st msg && isEditable msg -> do             let Just p = msg^.mOriginalPost             setMode Main-            csEditState.cedEditMode .= Editing p (msg^.mType)+            csCurrentTeam.tsEditState.cedEditMode .= Editing p (msg^.mType)             -- If the post that we're editing is an emote, we need             -- to strip the formatting because that's only there to             -- indicate that the post is an emote. This is annoying and@@ -271,7 +274,7 @@             let toEdit = if isEmote msg                          then removeEmoteFormatting sanitized                          else sanitized-            csEditState.cedEditor %= applyEdit (insertMany toEdit . clearZipper)+            csCurrentTeam.tsEditState.cedEditor %= applyEdit (insertMany toEdit . clearZipper)         _ -> return ()  -- | Tell the server that we have flagged or unflagged a message.

@@ -151,22 +151,27 @@ editMessage :: Post -> MH () editMessage new = do     myId <- gets myUserId-    baseUrl <- getServerBaseUrl-    let isEditedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL)-        (msg, mentionedUsers) = clientPostToMessage (toClientPost baseUrl new (new^.postRootIdL))-        chan = csChannel (new^.postChannelIdL)-    chan . ccContents . cdMessages . traversed . filtered isEditedMessage .= msg-    mh $ invalidateCacheEntry (ChannelMessages $ new^.postChannelIdL)+    withChannel (new^.postChannelIdL) $ \chan -> do+        let mTId = chan^.ccInfo.cdTeamId+        mBaseUrl <- case mTId of+            Nothing -> return Nothing+            Just tId -> Just <$> getServerBaseUrl tId -    fetchMentionedUsers mentionedUsers+        let (msg, mentionedUsers) = clientPostToMessage (toClientPost mBaseUrl new (new^.postRootIdL))+            isEditedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL) -    when (postUserId new /= Just myId) $-        chan %= adjustEditedThreshold new+        csChannel (new^.postChannelIdL) . ccContents . cdMessages . traversed . filtered isEditedMessage .= msg+        mh $ invalidateCacheEntry (ChannelMessages $ new^.postChannelIdL) -    csPostMap.ix(postId new) .= msg-    asyncFetchReactionsForPost (postChannelId new) new-    asyncFetchAttachments new+        fetchMentionedUsers mentionedUsers +        when (postUserId new /= Just myId) $+            csChannel (new^.postChannelIdL) %= adjustEditedThreshold new++        csPostMap.ix(postId new) .= msg+        asyncFetchReactionsForPost (postChannelId new) new+        asyncFetchAttachments new+ deleteMessage :: Post -> MH () deleteMessage new = do     let isDeletedMessage m = m^.mMessageId == Just (MessagePostId $ new^.postIdL) ||@@ -210,6 +215,7 @@     -- case the new block should be surrounded by UnknownGaps.     withChannelOrDefault cId NoAction $ \chan -> do         let pIdList = toList (posts^.postsOrderL)+            mTId = chan^.ccInfo.cdTeamId             -- the first and list PostId in the batch to be added             earliestPId = last pIdList             latestPId = head pIdList@@ -300,7 +306,7 @@         -- usernames in the text of the messages which we need to use to         -- submit a single batch request for user metadata so we don't         -- submit one request per mention.-        void $ installMessagesFromPosts posts+        void $ installMessagesFromPosts mTId posts          -- Add all the new *unique* posts into the existing channel         -- corpus, generating needed fetches of data associated with@@ -338,82 +344,88 @@           csChannels %= modifyChannelById cId             (ccContents.cdMessages .~ resultMessages) -          -- Determine if the current selected message was one of the-          -- removed messages.+          let processTeam tId = do+                -- Determine if the current selected message was one of the+                -- removed messages.+                selMsgId <- use (csTeam(tId).tsMessageSelect.to selectMessageId)+                let rmvdSel = do+                      i <- selMsgId -- :: Maybe MessageId+                      findMessage i removedMessages+                    rmvdSelType = _mType <$> rmvdSel -          selMsgId <- use (csMessageSelect.to selectMessageId)-          let rmvdSel = do-                i <- selMsgId -- :: Maybe MessageId-                findMessage i removedMessages-              rmvdSelType = _mType <$> rmvdSel+                case rmvdSel of+                  Nothing -> return ()+                  Just rm ->+                    if isGap rm+                    then return ()  -- handled during gap insertion below+                    else do+                      -- Replaced a selected message that wasn't a gap.+                      -- This is unlikely, but may occur if the previously+                      -- selected message was just deleted by another user+                      -- and is in the fetched region.  The choices here are+                      -- to move the selection, or cancel the selection.+                      -- Both will be unpleasant surprises for the user, but+                      -- cancelling the selection is probably the better+                      -- choice than allowing the user to perform select+                      -- actions on a message that isn't the one they just+                      -- selected.+                      setMode Main+                      csTeam(tId).tsMessageSelect .= MessageSelectState Nothing -          case rmvdSel of-            Nothing -> return ()-            Just rm ->-              if isGap rm-              then return ()  -- handled during gap insertion below-              else do-                -- Replaced a selected message that wasn't a gap.-                -- This is unlikely, but may occur if the previously-                -- selected message was just deleted by another user-                -- and is in the fetched region.  The choices here are-                -- to move the selection, or cancel the selection.-                -- Both will be unpleasant surprises for the user, but-                -- cancelling the selection is probably the better-                -- choice than allowing the user to perform select-                -- actions on a message that isn't the one they just-                -- selected.-                setMode Main-                csMessageSelect .= MessageSelectState Nothing+                -- Add a gap at each end of the newly fetched data, unless:+                --   1. there is an overlap+                --   2. there is no more in the indicated direction+                --      a. indicated by adding messages later than any currently+                --         held messages (see note above re 'addingAtEnd').+                --      b. the amount returned was less than the amount requested -          -- Add a gap at each end of the newly fetched data, unless:-          --   1. there is an overlap-          --   2. there is no more in the indicated direction-          --      a. indicated by adding messages later than any currently-          --         held messages (see note above re 'addingAtEnd').-          --      b. the amount returned was less than the amount requested+                if reAddGapBefore+                  then+                    -- No more gaps.  If the selected gap was removed, move+                    -- select to first (earliest) message)+                    case rmvdSelType of+                      Just (C UnknownGapBefore) ->+                        csTeam(tId).tsMessageSelect .= MessageSelectState (pure $ MessagePostId earliestPId)+                      _ -> return ()+                  else do+                    -- add a gap at the start of the newly fetched block and+                    -- make that the active selection if this fetch removed+                    -- the previously selected gap in this direction.+                    gapMsg <- newGapMessage (justBefore earliestDate) True+                    csChannels %= modifyChannelById cId+                      (ccContents.cdMessages %~ addMessage gapMsg)+                    -- Move selection from old gap to new gap+                    case rmvdSelType of+                      Just (C UnknownGapBefore) -> do+                        csTeam(tId).tsMessageSelect .= MessageSelectState (gapMsg^.mMessageId)+                      _ -> return () -          if reAddGapBefore-            then-              -- No more gaps.  If the selected gap was removed, move-              -- select to first (earliest) message)-              case rmvdSelType of-                Just (C UnknownGapBefore) ->-                  csMessageSelect .= MessageSelectState (pure $ MessagePostId earliestPId)-                _ -> return ()-            else do-              -- add a gap at the start of the newly fetched block and-              -- make that the active selection if this fetch removed-              -- the previously selected gap in this direction.-              gapMsg <- newGapMessage (justBefore earliestDate) True-              csChannels %= modifyChannelById cId-                (ccContents.cdMessages %~ addMessage gapMsg)-              -- Move selection from old gap to new gap-              case rmvdSelType of-                Just (C UnknownGapBefore) -> do-                  csMessageSelect .= MessageSelectState (gapMsg^.mMessageId)-                _ -> return ()+                if reAddGapAfter+                  then+                    -- No more gaps.  If the selected gap was removed, move+                    -- select to last (latest) message.+                    case rmvdSelType of+                      Just (C UnknownGapAfter) ->+                        csTeam(tId).tsMessageSelect .= MessageSelectState (pure $ MessagePostId latestPId)+                      _ -> return ()+                  else do+                    -- add a gap at the end of the newly fetched block and+                    -- make that the active selection if this fetch removed+                    -- the previously selected gap in this direction.+                    gapMsg <- newGapMessage (justAfter latestDate) False+                    csChannels %= modifyChannelById cId+                      (ccContents.cdMessages %~ addMessage gapMsg)+                    -- Move selection from old gap to new gap+                    case rmvdSelType of+                      Just (C UnknownGapAfter) ->+                        csTeam(tId).tsMessageSelect .= MessageSelectState (gapMsg^.mMessageId)+                      _ -> return () -          if reAddGapAfter-            then-              -- No more gaps.  If the selected gap was removed, move-              -- select to last (latest) message.-              case rmvdSelType of-                Just (C UnknownGapAfter) ->-                  csMessageSelect .= MessageSelectState (pure $ MessagePostId latestPId)-                _ -> return ()-            else do-              -- add a gap at the end of the newly fetched block and-              -- make that the active selection if this fetch removed-              -- the previously selected gap in this direction.-              gapMsg <- newGapMessage (justAfter latestDate) False-              csChannels %= modifyChannelById cId-                (ccContents.cdMessages %~ addMessage gapMsg)-              -- Move selection from old gap to new gap-              case rmvdSelType of-                Just (C UnknownGapAfter) ->-                  csMessageSelect .= MessageSelectState (gapMsg^.mMessageId)-                _ -> return ()+          case mTId of+              Nothing -> do+                  ts <- use csTeams+                  forM_ (HM.keys ts) processTeam+              Just tId -> processTeam tId          -- Now initiate fetches for use information for any         -- as-yet-unknown users related to this new set of messages@@ -498,9 +510,13 @@                             postProcessMessageAdd              return NoAction-        Just _ -> do-            baseUrl <- getServerBaseUrl-            let cp = toClientPost baseUrl new (new^.postRootIdL)+        Just ch -> do+            let mTId = ch^.ccInfo.cdTeamId+            mBaseUrl <- case mTId of+                Nothing -> return Nothing+                Just tId -> Just <$> getServerBaseUrl tId++            let cp = toClientPost mBaseUrl new (new^.postRootIdL)                 fromMe = (cp^.cpUser == (Just $ myUserId st)) &&                          (isNothing $ cp^.cpUserOverride)                 userPrefs = st^.csResources.crUserPreferences@@ -521,7 +537,8 @@                             when (isNothing authorResult) $                                 handleNewUsers (Seq.singleton authorId) (return ()) -                    currCId <- use csCurrentChannelId+                    curTId <- use csCurrentTeamId+                    currCId <- use (csCurrentChannelId curTId)                     flags <- use (csResources.crFlaggedPosts)                     let (msg', mentionedUsers) = clientPostToMessage cp                                  & _1.mFlagged .~ ((cp^.cpPostId) `Set.member` flags)@@ -560,7 +577,7 @@                                 Nothing -> do                                     doAsyncChannelMM Preempt cId                                         (\s _ -> MM.mmGetThread parentId s)-                                        (\_ p -> Just $ updatePostMap p)+                                        (\_ p -> Just $ updatePostMap mTId p)                                 _ -> return ()                         _ -> return () @@ -568,7 +585,8 @@                  postedChanMessage =                   withChannelOrDefault (postChannelId new) NoAction $ \chan -> do-                      currCId <- use csCurrentChannelId+                      currTid <- use csCurrentTeamId+                      currCId <- use (csCurrentChannelId currTid)                        let notifyPref = notifyPreference (myUser st) chan                           curChannelAction = if postChannelId new == currCId@@ -627,7 +645,7 @@  maybeRingBell :: MH () maybeRingBell = do-    doBell <- use (csResources.crConfiguration.to configActivityBell)+    doBell <- use (csResources.crConfiguration.configActivityBellL)     when doBell $ do         vty <- mh getVtyHandle         liftIO $ ringTerminalBell $ outputIface vty@@ -651,7 +669,7 @@ runNotifyCommand post mentioned = do     outputChan <- use (csResources.crSubprocessLog)     st <- use id-    notifyCommand <- use (csResources.crConfiguration.to configActivityNotifyCommand)+    notifyCommand <- use (csResources.crConfiguration.configActivityNotifyCommandL)     case notifyCommand of         Nothing -> return ()         Just cmd ->@@ -704,7 +722,8 @@ -- channels and empty channels. asyncFetchMoreMessages :: MH () asyncFetchMoreMessages = do-    cId  <- use csCurrentChannelId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)     withChannel cId $ \chan ->         let offset = max 0 $ length (chan^.ccContents.cdMessages) - 2             page = offset `div` pageAmount@@ -829,7 +848,8 @@ fetchVisibleIfNeeded = do     sts <- use csConnectionStatus     when (sts == Connected) $ do-        cId <- use csCurrentChannelId+        tId <- use csCurrentTeamId+        cId <- use (csCurrentChannelId tId)         withChannel cId $ \chan ->             let msgs = chan^.ccContents.cdMessages.to reverseMessages                 (numRemaining, gapInDisplayable, _, rel'pId, overlap) =@@ -904,7 +924,7 @@                   Just _ -> do                       setFocus cId                       setMode MessageSelect-                      csMessageSelect .= MessageSelectState (msg^.mMessageId)+                      csCurrentTeam.tsMessageSelect .= MessageSelectState (msg^.mMessageId)           Nothing ->             error "INTERNAL: selected Post ID not associated with a channel"       Nothing -> do

@@ -10,6 +10,7 @@ import Matterhorn.Prelude  import Network.Mattermost.Types ( ChannelNotifyProps+                                , TeamId                                 , User(..)                                 , UserNotifyProps(..)                                 , Type(..)@@ -61,14 +62,14 @@                                   ]     in radioField l (defaultField : nonDefault) -notifyPrefsForm :: UserNotifyProps -> ChannelNotifyProps -> Form ChannelNotifyProps e Name-notifyPrefsForm globalDefaults =-    newForm [ checkboxField muteLens MuteToggleField "Mute channel"-            , (padTop $ Pad 1) @@= checkboxField channelMentionLens ChannelMentionsField "Ignore channel mentions"+notifyPrefsForm :: TeamId -> UserNotifyProps -> ChannelNotifyProps -> Form ChannelNotifyProps e Name+notifyPrefsForm tId globalDefaults =+    newForm [ checkboxField muteLens (MuteToggleField tId) "Mute channel"+            , (padTop $ Pad 1) @@= checkboxField channelMentionLens (ChannelMentionsField tId) "Ignore channel mentions"             , radioStyle "Desktop notifications" @@=-                mkNotifyButtons DesktopNotificationsField channelNotifyPropsDesktopL (userNotifyPropsDesktop globalDefaults)+                mkNotifyButtons (DesktopNotificationsField tId) channelNotifyPropsDesktopL (userNotifyPropsDesktop globalDefaults)             , radioStyle "Push notifications" @@=-                mkNotifyButtons PushNotificationsField channelNotifyPropsPushL (userNotifyPropsPush globalDefaults)+                mkNotifyButtons (PushNotificationsField tId) channelNotifyPropsPushL (userNotifyPropsPush globalDefaults)             ]     where radioStyle label = (padTop $ Pad 1 ) . (str label <=>) . (padLeft $ Pad 1) @@ -80,7 +81,8 @@       _ -> do         let props = chanInfo^.cdNotifyProps         user <- use csMe-        csNotifyPrefs .= (Just (notifyPrefsForm (userNotifyProps user) props))+        tId <- use csCurrentTeamId+        csCurrentTeam.tsNotifyPrefs .= (Just (notifyPrefsForm tId (userNotifyProps user) props))         setMode EditNotifyPrefs  exitEditNotifyPrefsMode :: MH ()

@@ -33,11 +33,11 @@ -- with a specified list of messages. enterPostListMode ::  PostListContents -> Messages -> MH () enterPostListMode contents msgs = do-  csPostListOverlay.postListPosts .= msgs+  csCurrentTeam.tsPostListOverlay.postListPosts .= msgs   let mlatest = getLatestPostMsg msgs       pId = mlatest >>= messagePostId       cId = mlatest >>= \m -> m^.mChannelId-  csPostListOverlay.postListSelected .= pId+  csCurrentTeam.tsPostListOverlay.postListSelected .= pId   setMode $ PostListOverlay contents   case (pId, cId) of     (Just p, Just c) -> asyncFetchMessagesSurrounding c p@@ -46,18 +46,18 @@ -- | Clear out the state of a PostListOverlay exitPostListMode :: MH () exitPostListMode = do-  csPostListOverlay.postListPosts .= emptyDirSeq-  csPostListOverlay.postListSelected .= Nothing+  csCurrentTeam.tsPostListOverlay.postListPosts .= emptyDirSeq+  csCurrentTeam.tsPostListOverlay.postListSelected .= Nothing   setMode Main  -createPostList :: PostListContents -> (Session -> IO Posts) -> MH ()-createPostList contentsType fetchOp = do+createPostList :: TeamId -> PostListContents -> (Session -> IO Posts) -> MH ()+createPostList tId contentsType fetchOp = do   session <- getSession   doAsyncWith Preempt $ do     posts <- fetchOp session     return $ Just $ do-      messages <- installMessagesFromPosts posts+      messages <- installMessagesFromPosts (Just tId) posts       -- n.b. do not use addNewPostedMessage because these messages       -- are not new, and so no notifications or channel highlighting       -- or other post-processing should be performed.@@ -71,15 +71,18 @@  -- | Create a PostListOverlay with flagged messages from the server. enterFlaggedPostListMode :: MH ()-enterFlaggedPostListMode = createPostList PostListFlagged $-                           mmGetListOfFlaggedPosts UserMe defaultFlaggedPostsQuery+enterFlaggedPostListMode = do+    tId <- use csCurrentTeamId+    createPostList tId PostListFlagged $+        mmGetListOfFlaggedPosts UserMe defaultFlaggedPostsQuery  -- | Create a PostListOverlay with pinned messages from the server for -- the current channel. enterPinnedPostListMode :: MH () enterPinnedPostListMode = do-    cId <- use csCurrentChannelId-    createPostList (PostListPinned cId) $ mmGetChannelPinnedPosts cId+    tId <- use csCurrentTeamId+    cId <- use (csCurrentChannelId tId)+    createPostList tId (PostListPinned cId) $ mmGetChannelPinnedPosts cId  -- | Create a PostListOverlay with post search result messages from the -- server.@@ -88,8 +91,8 @@   | T.null (T.strip terms) = postInfoMessage "Search command requires at least one search term."   | otherwise = do       enterPostListMode (PostListSearch terms True) noMessages-      tId <- gets myTeamId-      createPostList (PostListSearch terms False) $+      tId <- use csCurrentTeamId+      createPostList tId (PostListSearch terms False) $         mmSearchForTeamPosts tId (SearchPosts terms False)  @@ -97,14 +100,14 @@ -- to finding a chronologically /newer/ message. postListSelectUp :: MH () postListSelectUp = do-  selId <- use (csPostListOverlay.postListSelected)-  posts <- use (csPostListOverlay.postListPosts)+  selId <- use (csCurrentTeam.tsPostListOverlay.postListSelected)+  posts <- use (csCurrentTeam.tsPostListOverlay.postListPosts)   let nextMsg = getNextMessage (MessagePostId <$> selId) posts   case nextMsg of     Nothing -> return ()     Just m -> do       let pId = m^.mMessageId >>= messageIdPostId-      csPostListOverlay.postListSelected .= pId+      csCurrentTeam.tsPostListOverlay.postListSelected .= pId       case (m^.mChannelId, pId) of         (Just c, Just p) -> asyncFetchMessagesSurrounding c p         o -> mhLog LogError@@ -115,14 +118,14 @@ -- to finding a chronologically /old/ message. postListSelectDown :: MH () postListSelectDown = do-  selId <- use (csPostListOverlay.postListSelected)-  posts <- use (csPostListOverlay.postListPosts)+  selId <- use (csCurrentTeam.tsPostListOverlay.postListSelected)+  posts <- use (csCurrentTeam.tsPostListOverlay.postListPosts)   let prevMsg = getPrevMessage (MessagePostId <$> selId) posts   case prevMsg of     Nothing -> return ()     Just m -> do       let pId = m^.mMessageId >>= messageIdPostId-      csPostListOverlay.postListSelected .= pId+      csCurrentTeam.tsPostListOverlay.postListSelected .= pId       case (m^.mChannelId, pId) of         (Just c, Just p) -> asyncFetchMessagesSurrounding c p         o -> mhLog LogError@@ -132,7 +135,7 @@ -- | Unflag the post currently selected in the PostListOverlay, if any postListUnflagSelected :: MH () postListUnflagSelected = do-  msgId <- use (csPostListOverlay.postListSelected)+  msgId <- use (csCurrentTeam.tsPostListOverlay.postListSelected)   case msgId of     Nothing  -> return ()     Just pId -> flagMessage pId False@@ -142,7 +145,7 @@ -- display and changes to MessageSelectState. postListJumpToCurrent :: MH () postListJumpToCurrent = do-  msgId <- use (csPostListOverlay.postListSelected)+  msgId <- use (csCurrentTeam.tsPostListOverlay.postListSelected)   case msgId of     Nothing  -> return ()     Just pId -> jumpToPost pId

@@ -37,9 +37,10 @@     case selectedMessage of         Nothing -> return ()         Just msg -> do+            tId <- use csCurrentTeamId             em <- use (csResources.crEmoji)             myId <- gets myUserId-            enterListOverlayMode csReactionEmojiListOverlay ReactionEmojiListOverlay+            enterListOverlayMode (csTeam(tId).tsReactionEmojiListOverlay) ReactionEmojiListOverlay                 () enterHandler (fetchResults myId msg em)  enterHandler :: (Bool, T.Text) -> MH Bool@@ -118,7 +119,7 @@ -- cursor, and then check to see whether the modification warrants a -- prefetch of more search results. reactionEmojiListMove :: (L.List Name (Bool, T.Text) -> L.List Name (Bool, T.Text)) -> MH ()-reactionEmojiListMove = listOverlayMove csReactionEmojiListOverlay+reactionEmojiListMove = listOverlayMove (csCurrentTeam.tsReactionEmojiListOverlay)  -- | The number of emoji in a "page" for cursor movement purposes. reactionEmojiListPageSize :: Int

@@ -10,8 +10,9 @@ import           Brick.BChan ( newBChan ) import           Brick.Themes ( themeToAttrMap, loadCustomizations ) import qualified Control.Concurrent.STM as STM+import qualified Data.Foldable as F+import qualified Data.HashMap.Strict as HM import           Data.Maybe ( fromJust )-import qualified Data.Sequence as Seq import qualified Data.Text as T import           Data.Time.Clock ( getCurrentTime ) import qualified Graphics.Vty as Vty@@ -24,19 +25,16 @@  import           Matterhorn.Config import           Matterhorn.InputHistory-import           Matterhorn.LastRunState import           Matterhorn.Login import           Matterhorn.State.Flagging-import           Matterhorn.State.Messages ( fetchVisibleIfNeeded )+import           Matterhorn.State.Teams ( buildTeamState ) import           Matterhorn.State.Setup.Threads-import           Matterhorn.TeamSelect import           Matterhorn.Themes import           Matterhorn.TimeUtils ( lookupLocalTimeZone ) import           Matterhorn.Types import           Matterhorn.Types.Common import           Matterhorn.Emoji import           Matterhorn.FilePaths ( userEmojiJsonPath, bundledEmojiJsonPath )-import qualified Matterhorn.Zipper as Z   incompleteCredentials :: Config -> ConnectionInfo@@ -103,25 +101,15 @@           -- with setup.           return (sess, user, cd, mbTeam) -  teams <- mmGetUsersTeams UserMe session-  when (Seq.null teams) $ do+  teams <- F.toList <$> mmGetUsersTeams UserMe session+  when (null teams) $ do       putStrLn "Error: your account is not a member of any teams"       exitFailure -  (myTeam, teamSelVty) <- do-      let foundTeam = do-             tName <- mbTeam <|> configTeam config-             let matchingTeam = listToMaybe $ filter matches $ toList teams-                 matches t = (sanitizeUserText $ teamName t) == tName-             matchingTeam--      case foundTeam of-          Just t -> return (t, loginVty)-          Nothing -> do-              (mTeam, vty) <- interactiveTeamSelection loginVty mkVty $ toList teams-              case mTeam of-                  Nothing -> shutdown vty-                  Just team -> return (team, vty)+  let initialTeamId = fromMaybe (teamId $ head $ sortTeams teams) $ do+          tName <- mbTeam <|> configTeam config+          let matchingTeam = listToMaybe $ filter (matchesTeam tName) teams+          teamId <$> matchingTeam    userStatusChan <- STM.newTChanIO   slc <- STM.newTChanIO@@ -151,7 +139,7 @@                  result <- loadCustomizations absPath baseTheme                  case result of                      Left e -> do-                         Vty.shutdown teamSelVty+                         Vty.shutdown loginVty                          putStrLn $ "Error loading theme customization from " <> show absPath <> ": " <> e                          exitFailure                      Right t -> return t@@ -181,43 +169,23 @@                          , _crEmoji               = emoji                          } -  st <- initializeState cr myTeam me+  st <- initializeState cr initialTeamId teams me -  return (st, teamSelVty)+  return (st, loginVty) -initializeState :: ChatResources -> Team -> User -> IO ChatState-initializeState cr myTeam me = do+matchesTeam :: T.Text -> Team -> Bool+matchesTeam tName t =+    let normalizeUserText = normalize . sanitizeUserText+        normalize = T.strip . T.toLower+        urlName = normalizeUserText $ teamName t+        displayName = normalizeUserText $ teamDisplayName t+    in normalize tName `elem` [displayName, urlName]++initializeState :: ChatResources -> TeamId -> [Team] -> User -> IO ChatState+initializeState cr initialTeamId teams me = do   let session = getResourceSession cr       requestChan = cr^.crRequestQueue-      myTId = getId myTeam -  -- Create a predicate to find the last selected channel by reading the-  -- run state file. If unable to read or decode or validate the file, this-  -- predicate is just `isTownSquare`.-  isLastSelectedChannel <- do-    result <- readLastRunState $ teamId myTeam-    case result of-      Right lrs | isValidLastRunState cr me lrs -> return $ \c ->-           channelId c == lrs^.lrsSelectedChannelId-      _ -> return isTownSquare--  -- Get all channels, but filter down to just the one we want to start-  -- in. We get all, rather than requesting by name or ID, because-  -- we don't know whether the server will give us a last-viewed preference.-  -- We first try to find a channel matching with the last selected channel ID,-  -- failing which we look for the Town Square channel by name.-  userChans <- mmGetChannelsForUser UserMe myTId session-  let lastSelectedChans = Seq.filter isLastSelectedChannel userChans-      chans = if Seq.null lastSelectedChans-                then Seq.filter isTownSquare userChans-                else lastSelectedChans--  -- Since the only channel we are dealing with is by construction the-  -- last channel, we don't have to consider other cases here:-  chanPairs <- forM (toList chans) $ \c -> do-      cChannel <- makeClientChannel (userId me) c-      return (getId c, cChannel)-   tz <- lookupLocalTimeZone   hist <- do       result <- readHistory@@ -247,35 +215,26 @@   --  * Subprocess logger   startSubprocessLoggerThread (cr^.crSubprocessLog) requestChan -  --  * Spell checker and spell check timer, if configured-  spResult <- maybeStartSpellChecker (cr^.crConfiguration) (cr^.crEventQueue)-   -- End thread startup ---------------------------------------------- -  now <- getCurrentTime-  let chanIds = mkChannelZipperList now (cr^.crConfiguration) Nothing (cr^.crUserPreferences) clientChans noUsers-      chanZip = Z.fromList chanIds-      clientChans = foldr (uncurry addChannel) noChannels chanPairs-      startupState =+  -- For each team, build a team state and load the last-run state.+  (teamStates, chanLists) <- unzip <$> mapM (buildTeamState cr me) teams++  let startupState =           StartupStateInfo { startupStateResources      = cr-                           , startupStateChannelZipper  = chanZip                            , startupStateConnectedUser  = me-                           , startupStateTeam           = myTeam                            , startupStateTimeZone       = tz                            , startupStateInitialHistory = hist-                           , startupStateSpellChecker   = spResult+                           , startupStateInitialTeam    = initialTeamId+                           , startupStateTeams          = teamMap                            }--  initialState <- newState startupState-  let st = initialState & csChannels .~ clientChans+      clientChans = mconcat chanLists+      st = newState startupState & csChannels .~ clientChans+      teamMap = HM.fromList $ (\ts -> (teamId $ _tsTeam ts, ts)) <$> F.toList teamStates    loadFlaggedMessages (cr^.crUserPreferences.userPrefFlaggedPostList) st    -- Trigger an initial websocket refresh   writeBChan (cr^.crEventQueue) RefreshWebsocketEvent--  -- Refresh initial channel(s)-  writeBChan (cr^.crEventQueue) $ RespEvent $ do-      fetchVisibleIfNeeded    return st

@@ -0,0 +1,217 @@+module Matterhorn.State.Teams+  ( nextTeam+  , prevTeam+  , handleJoinTeam+  , handleLeaveTeam+  , handleUpdateTeam+  , buildTeamState+  , moveCurrentTeamLeft+  , moveCurrentTeamRight+  )+where++import           Prelude ()+import           Matterhorn.Prelude++import           Brick.Main ( invalidateCache )+import qualified Data.Sequence as Seq+import qualified Data.Text as T+import           Data.Time.Clock ( getCurrentTime )+import qualified Data.HashMap.Strict as HM+import           Lens.Micro.Platform ( (%=), (.=), at )++import           Network.Mattermost.Lenses ( userIdL )+import           Network.Mattermost.Types ( TeamId, Team, User, userId+                                          , getId, channelId, teamId, UserParam(..)+                                          , teamOrderPref+                                          )+import qualified Network.Mattermost.Endpoints as MM++import           Matterhorn.Types+import           Matterhorn.LastRunState+import           Matterhorn.State.Async+import           Matterhorn.State.ChannelList+import           Matterhorn.State.Channels+import           Matterhorn.State.Messages+import           Matterhorn.State.Setup.Threads ( maybeStartSpellChecker )+import qualified Matterhorn.Zipper as Z+++-- | Move right in the channel list to select the next team.+nextTeam :: MH ()+nextTeam = setTeamFocusWith Z.right++-- | Move left in the channel list to select the previous team.+prevTeam :: MH ()+prevTeam = setTeamFocusWith Z.left++-- | Change the selected team with the specified team zipper+-- transformation. This function also takes care of book-keeping+-- necessary during team switching.+setTeamFocusWith :: (Z.Zipper () TeamId -> Z.Zipper () TeamId) -> MH ()+setTeamFocusWith f = do+    csTeamZipper %= f+    postChangeTeamCommon++-- | Book-keeping common to all team selection changes.+postChangeTeamCommon :: MH ()+postChangeTeamCommon = do+    updateViewed False+    fetchVisibleIfNeeded++-- | Fetch the specified team and add it to the application state.+--+-- This is called in response to a server event indicating that the+-- current user was added to the team.+handleJoinTeam :: TeamId -> MH ()+handleJoinTeam tId = do+    session <- getSession+    cr <- use csResources+    me <- use csMe++    mhLog LogGeneral $ T.pack $ "Joining team " <> show tId+    doAsyncWith Normal $ do+        t <- MM.mmGetTeam tId session+        (ts, chans) <- buildTeamState cr me t+        return $ Just $ do+            curTs <- use csTeams+            let myTIds = HM.keys curTs+            when (not $ tId `elem` myTIds) $ do+                addTeamState ts chans+                updateSidebar $ Just tId+                updateWindowTitle+                refreshTeamZipper++-- | Remove the specified team to the application state.+--+-- This is called in response to a server event indicating that the+-- current user was removed from the team.+handleLeaveTeam :: TeamId -> MH ()+handleLeaveTeam tId =+    doAsyncWith Normal $ return $ Just $ do+        mhLog LogGeneral $ T.pack $ "Leaving team " <> show tId+        removeTeam tId+        updateWindowTitle+        -- Invalidating the cache here expunges any cached message+        -- renderings from the team we are leaving.+        mh invalidateCache++-- | Fetch the specified team's metadata and update it in the+-- application state.+--+-- This is called in response to a server event indicating that the+-- specified team was updated in some way.+handleUpdateTeam :: TeamId -> MH ()+handleUpdateTeam tId = do+    session <- getSession+    mhLog LogGeneral $ T.pack $ "Updating team " <> show tId+    doAsyncWith Normal $ do+        t <- MM.mmGetTeam tId session+        return $ Just $ do+            updateTeam t+            -- Invalidate the cache since we happen to know that the+            -- team name is in the cached sidebar.+            mh invalidateCache++-- | Set the team zipper ordering with the specified transformation,+-- which is expected to be either 'moveLeft' or 'moveRight'.+setTeamOrderWith :: (TeamId -> [TeamId] -> [TeamId]) -> MH ()+setTeamOrderWith sortFunc = do+    session <- getSession+    me <- use csMe++    tId <- use csCurrentTeamId+    z <- use csTeamZipper+    let tIds = teamZipperIds z+        newList = sortFunc tId tIds++    doAsyncWith Normal $ do+        let pref = teamOrderPref (me^.userIdL) newList+        MM.mmSaveUsersPreferences UserMe (Seq.singleton pref) session+        return Nothing++-- | Move the selected team left in the team list.+moveCurrentTeamLeft :: MH ()+moveCurrentTeamLeft = setTeamOrderWith moveLeft++-- | Move the selected team right in the team list.+moveCurrentTeamRight :: MH ()+moveCurrentTeamRight = setTeamOrderWith moveRight++-- | Build a new 'TeamState' for the specified team.+--+-- This function starts a new spell checker thread for the team's+-- message editor, loads the last-run state for the team (to ensure that+-- the initially-selected channel is honored), and fetches the channel+-- metadata for the team.+--+-- This returns the resulting team state as well as the channels+-- associated with the team. The caller is responsible for adding the+-- channels and the team state to the application state.+buildTeamState :: ChatResources -> User -> Team -> IO (TeamState, ClientChannels)+buildTeamState cr me team = do+    let tId = teamId team+        session = getResourceSession cr++    -- Create a predicate to find the last selected channel by reading+    -- the run state file. If unable to read or decode or validate the+    -- file, this predicate is just `isTownSquare`.+    isLastSelectedChannel <- do+        result <- readLastRunState tId+        case result of+            Right lrs | isValidLastRunState cr me lrs -> return $ \c ->+                 channelId c == lrs^.lrsSelectedChannelId+            _ -> return isTownSquare++    -- Get all channels, but filter down to just the one we want+    -- to start in. We get all, rather than requesting by name or+    -- ID, because we don't know whether the server will give us a+    -- last-viewed preference. We first try to find a channel matching+    -- with the last selected channel ID, failing which we look for the+    -- Town Square channel by name.+    userChans <- MM.mmGetChannelsForUser UserMe tId session+    let lastSelectedChans = Seq.filter isLastSelectedChannel userChans+        chans = if Seq.null lastSelectedChans+                  then Seq.filter isTownSquare userChans+                  else lastSelectedChans++    -- Since the only channel we are dealing with is by construction the+    -- last channel, we don't have to consider other cases here:+    chanPairs <- forM (toList chans) $ \c -> do+        cChannel <- makeClientChannel (userId me) c+        return (getId c, cChannel)++    -- Start the spell checker and spell check timer, if configured+    spResult <- maybeStartSpellChecker (cr^.crConfiguration) (cr^.crEventQueue)++    now <- getCurrentTime+    let chanIds = mkChannelZipperList now (cr^.crConfiguration) tId+                                          Nothing (cr^.crUserPreferences)+                                          clientChans noUsers+        chanZip = Z.fromList chanIds+        clientChans = foldr (uncurry addChannel) noChannels chanPairs++    return (newTeamState team chanZip spResult, clientChans)++-- | Add a new 'TeamState' and corresponding channels to the application+-- state.+addTeamState :: TeamState -> ClientChannels -> MH ()+addTeamState ts chans = do+    let tId = teamId $ _tsTeam ts+    csTeams.at tId .= Just ts+    csChannels %= (chans <>)++-- | Update the specified team metadata in the application state (only+-- if we are already a member of that team).+updateTeam :: Team -> MH ()+updateTeam t = do+    let tId = teamId t+    ts <- use csTeams+    when (tId `elem` HM.keys ts) $ do+        csTeam(tId).tsTeam .= t++-- | Remove the specified team from the application state.+removeTeam :: TeamId -> MH ()+removeTeam tId = do+    csTeams.at tId .= Nothing+    setTeamFocusWith $ Z.filterZipper (/= tId)