matterhorn 40800.0.2 → 40900.0.0

raw patch · 66 files changed

+1607/−1016 lines, 66 filesdep +skylighting-coredep −skylightingdep ~brick-skylightingdep ~config-inidep ~mattermost-api

Dependencies added: skylighting-core

Dependencies removed: skylighting

Dependency ranges changed: brick-skylighting, config-ini, mattermost-api, mattermost-api-qc

Files

• CHANGELOG.md +44/−0
• LICENSE +1/−1
• PRACTICES.md +41/−0
• README.md +2/−0
• matterhorn.cabal +9/−8
• notification-scripts/notify +38/−0
• src/App.hs +8/−7
• src/Command.hs +18/−20
• src/Completion.hs +27/−10
• src/Config.hs +67/−7
• src/Connection.hs +9/−7
• src/Constants.hs +1/−0
• src/Draw.hs +6/−5
• src/Draw/ChannelList.hs +6/−3
• src/Draw/DeleteChannelConfirm.hs +4/−3
• src/Draw/JoinChannel.hs +15/−13
• src/Draw/LeaveChannelConfirm.hs +4/−3
• src/Draw/Main.hs +40/−34
• src/Draw/Messages.hs +3/−3
• src/Draw/PostListOverlay.hs +13/−12
• src/Draw/ShowHelp.hs +52/−25
• src/Draw/UserListOverlay.hs +11/−11
• src/Draw/Util.hs +10/−9
• src/Events.hs +45/−19
• src/Events/ChannelScroll.hs +7/−6
• src/Events/ChannelSelect.hs +7/−6
• src/Events/DeleteChannelConfirm.hs +5/−4
• src/Events/JoinChannel.hs +8/−7
• src/Events/Keybindings.hs +6/−3
• src/Events/LeaveChannelConfirm.hs +5/−4
• src/Events/Main.hs +38/−23
• src/Events/MessageSelect.hs +7/−6
• src/Events/PostListOverlay.hs +6/−4
• src/Events/ShowHelp.hs +7/−6
• src/Events/UrlSelect.hs +7/−6
• src/Events/UserListOverlay.hs +6/−5
• src/FilePaths.hs +22/−7
• src/HelpTopics.hs +7/−1
• src/IOUtil.hs +4/−2
• src/InputHistory.hs +14/−11
• src/LastRunState.hs +15/−12
• src/Login.hs +20/−17
• src/Main.hs +8/−7
• src/Markdown.hs +19/−20
• src/Options.hs +6/−5
• src/Prelude/MH.hs +14/−13
• src/Scripts.hs +14/−13
• src/State.hs +142/−72
• src/State/Common.hs +9/−11
• src/State/Editing.hs +10/−10
• src/State/Messages.hs +8/−6
• src/State/PostListOverlay.hs +11/−9
• src/State/Setup.hs +18/−14
• src/State/Setup/Threads.hs +39/−28
• src/State/UserListOverlay.hs +15/−15
• src/TeamSelect.hs +13/−11
• src/Themes.hs +16/−13
• src/TimeUtils.hs +10/−8
• src/Types.hs +522/−393
• src/Types/Channels.hs +15/−9
• src/Types/DirectionalSeq.hs +2/−2
• src/Types/KeyEvents.hs +3/−2
• src/Types/Messages.hs +10/−5
• src/Types/Posts.hs +9/−6
• src/Types/Users.hs +26/−11
• src/Zipper.hs +3/−3

@@ -1,4 +1,48 @@ +40900.0.0+=========++This release supports Mattermost server version 4.9.++New features:+ * Matterhorn now supports activity notifications by ivoking a+   user-configured external command. The external command is configured+   with the `activityNotifyCommand` setting. Matterhorn also includes+   an example notification script for Linux-based systems in the+   `notification-scripts` directory. Thanks to Jason Miller for this+   feature!+ * Matterhorn now bundles syntax highlighting language descriptions+   rather compiling them into the binary. This resolves issue #372.+   The XML descriptions are in the Kate project's language description+   format and are provided with their accompanying GPL license.+   Syntax description files are loaded from a prioritized list+   of directories. The list of directories is configurable using+   the optional `syntaxDirectories` configuration setting. See+   `sample_config.ini` for details.+ * Matterhorn now tab-completes available syntax highlighting language+   options on lines starting with the code block Markdown syntax (three+   backticks) (#354).++Other changes:+ * Tab-completion now always fills in user sigil on username and+   nickname completions, and fills in channel sigils on channel name+   completions.+ * Usernames in posts are now only highlighted when a user sigil is+   present.++Bug fixes:+ * Matterhorn now switches to a channel after it has been joined (#355).+ * Fixed emote editing (#388).++40800.0.3+=========++Bug fixes:+ * Fixed a bug that prevented DM channel changes when the DM channels+   were named with user nicknames (#384)+ * "Resource vanished" exceptions will no longer be silenced during+   async work.+ 40800.0.2 ========= 

@@ -1,4 +1,4 @@-Copyright (c) 2016, Getty Ritter+Copyright (c) 2016-2018, AUTHORS.txt All rights reserved.  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

@@ -13,6 +13,47 @@  * We want to manage inevitable software evolution, and  * We want to reduce waste through good team coordination. +Aesthetics+----------++When working with the code, we do not have a "style guide" and do not+want to enumerate all the different ways that the code can or should+be formatted.  We also recognize that the specific formatting+decisions are often affected by editor behaviors and individual typing+habits.++The ultimate goal is readability and so in general, we recommend that+you loosely follow existing formatting by default (eyes like to see+familiar patterns), but feel free to implement specific practices where+these match the editor tooling and or your personal aesthetics.++The following are some of the aesthetic choices we've made; these are+not hard rules but help to explain the current overall appearance:++  * Imports are usually in alphabetical order and separated into 4-5+    sections from the most global/generic to the most local/specific.+    Because there can be a number of sections, we separate the imports+    from the module body with two lines to help visually locate this+    point.  See Events.hs as an example.+    +  * We have collected the most common Prelude elements into a local+    file included by all modules (and therefore hiding the normal+    Prelude).  This helps to reduce the number of overall imports, and+    we keep this as the first import section to draw attention to the+    fact that the normal Prelude is not in context by default.+    +  * We prefer not to mix the `.` and `$` operators on the same line:++    ```haskell+    let foo = func . chain . call $ parse $ input+    let foo = func $ chain $ call $ parse $ input  -- preferred+    ```++  * Top-level functions have haddock documentation to help describe+    what the function is used for (and sometimes ways in which it+    shouldn't be used).+    + Branching --------- 

@@ -159,6 +159,8 @@   and `HTTPS_PROXY` environment variables. (Plain HTTP proxies are not   yet supported.) * Multiple color themes with color theme customization support+* Custom notifications via notification scripts (see the+  `activityNotifyCommand` configuration setting).  # Spell Checking Support 

@@ -1,5 +1,5 @@ name:                matterhorn-version:             40800.0.2+version:             40900.0.0 synopsis:            Terminal client for the Mattermost chat system description:         This is a terminal client for the Mattermost chat                      system. Please see the README for a list of@@ -20,6 +20,7 @@                      scripts/cowsay                      scripts/figlet                      scripts/rot13+                     notification-scripts/notify  source-repository    head   type: git@@ -93,7 +94,7 @@                        NoImplicitPrelude   ghc-options:         -Wall -threaded -with-rtsopts=-I0   build-depends:       base                 >=4.8     && <5-                     , mattermost-api       == 40800.0.1+                     , mattermost-api       == 40900.0.0                      , base-compat          >= 0.9    && < 0.10                      , unordered-containers >= 0.2    && < 0.3                      , containers           >= 0.5.7  && < 0.6@@ -102,11 +103,11 @@                      , text                 >= 1.2    && < 1.3                      , bytestring           >= 0.10   && < 0.11                      , stm                  >= 2.4    && < 2.5-                     , config-ini           >= 0.1.2  && < 0.2+                     , config-ini           >= 0.2.2.0 && < 0.3                      , process              >= 1.4    && < 1.7                      , microlens-platform   >= 0.3    && < 0.4                      , brick                >= 0.36   && < 0.37-                     , brick-skylighting    >= 0.1    && < 0.2+                     , brick-skylighting    >= 0.2    && < 0.3                      , vty                  >= 5.20   && < 5.21                      , word-wrap            >= 0.4.0  && < 0.5                      , transformers         >= 0.4    && < 0.6@@ -127,7 +128,7 @@                      , aspell-pipe          >= 0.3    && < 0.4                      , stm-delay            >= 0.1    && < 0.2                      , unix                 >= 2.7.1.0 && < 2.7.3.0-                     , skylighting          >= 0.6    && < 0.7+                     , skylighting-core     >= 0.7    && < 0.8                      , timezone-olson       >= 0.1.7   && < 0.2                      , timezone-series      >= 0.1.6.1 && < 0.2                      , aeson                >= 1.2.3.0 && < 1.3@@ -155,15 +156,15 @@                     , bytestring           >= 0.10   && < 0.11                     , cheapskate           >= 0.1    && < 0.2                     , checkers             >= 0.4    && < 0.5-                    , config-ini           >= 0.1.2  && < 0.2+                    , config-ini           >= 0.2.2.0 && < 0.3                     , connection           >= 0.2    && < 0.3                     , containers           >= 0.5.7  && < 0.6                     , directory            >= 1.3    && < 1.4                     , filepath             >= 1.4    && < 1.5                     , hashable             >= 1.2    && < 1.3                     , Hclip                >= 3.0    && < 3.1-                    , mattermost-api       == 40800.0.1-                    , mattermost-api-qc    == 40800.0.1+                    , mattermost-api       == 40900.0.0+                    , mattermost-api-qc    == 40900.0.0                     , microlens-platform   >= 0.3    && < 0.4                     , mtl                  >= 2.2    && < 2.3                     , process              >= 1.4    && < 1.7

@@ -0,0 +1,38 @@+#!/bin/sh+#############################################################+# Sample shell-script for using notify-send with matterhorn #+#############################################################++# Positional parameters+mentioned="${1?}"+sender="${2?}"+message="${3?}"++# Script options++# notify_URGENCIES+# First word is urgency for items where you are not mentioned, the second is+# urgency for items where you are mentioned.  Use "none" to not be notified,+# otherwise low, normal, critical are options+notify_URGENCIES="normal normal"+#notify_URGENCIES="none normal"+# The desktop notification category+notify_CATEGORY="im.received"+# Notification header+notify_HEAD="Matterhorn message from $sender"+# Notification body+notify_BODY="$message"++getUrgencyHelper() {+    shift "$mentioned"+    echo "$1"+}++getUrgency() {+    # we are using arguments as a poor-mans bash array for portability+    # shellcheck disable=SC2086+    getUrgencyHelper $notify_URGENCIES+}++test "$(getUrgency)" = "none" ||+    notify-send -u "$(getUrgency)" -c "$notify_CATEGORY" "$notify_HEAD" "$notify_BODY"

@@ -8,22 +8,23 @@ import           Prelude.MH  import           Brick-import           Control.Monad.Trans.Except (runExceptT)+import           Control.Monad.Trans.Except ( runExceptT ) import qualified Graphics.Vty as Vty-import           System.IO (IOMode(WriteMode), openFile, hClose)-import           Text.Aspell (stopAspell)+import           System.IO ( IOMode(WriteMode), openFile, hClose )+import           Text.Aspell ( stopAspell )  import           Network.Mattermost  import           Config-import           Options-import           InputHistory+import           Draw+import           Events import           IOUtil+import           InputHistory import           LastRunState+import           Options import           State.Setup-import           Events-import           Draw import           Types+  app :: App ChatState MHEvent Name app = App

@@ -2,25 +2,27 @@ {-# LANGUAGE OverloadedStrings #-} module Command where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import qualified Control.Exception as Exn import qualified Data.Char as Char import qualified Data.Text as T+ import qualified Network.Mattermost.Endpoints as MM-import qualified Network.Mattermost.Types as MM import qualified Network.Mattermost.Exceptions as MM+import qualified Network.Mattermost.Types as MM -import State-import State.Editing (toggleMessagePreview)-import State.Common-import State.PostListOverlay-import State.UserListOverlay-import Types-import HelpTopics-import Scripts+import           HelpTopics+import           Scripts+import           State+import           State.Common+import           State.Editing ( toggleMessagePreview )+import           State.PostListOverlay+import           State.UserListOverlay+import           Types + -- | This function skips any initial whitespace and returns the first -- 'token' (i.e. any sequence of non-whitespace characters) as well as -- the trailing rest of the string, after any whitespace. This is used@@ -108,11 +110,7 @@   , Cmd "help" "Show help about a particular topic"       (TokenArg "topic" NoArg) $ \ (topicName, ()) ->           case lookupHelpTopic topicName of-              Nothing -> do-                  let msg = ("Unknown help topic: `" <> topicName <> "`. " <>-                            (T.unlines $ "Available topics are:" : knownTopics))-                      knownTopics = ("  - " <>) <$> helpTopicName <$> helpTopics-                  mhError msg+              Nothing -> mhError $ NoSuchHelpTopic topicName               Just topic -> showHelpScreen topic    , Cmd "sh" "List the available shell scripts" NoArg $ \ () ->@@ -152,11 +150,11 @@              , MM.minComCommand   = "/" <> name <> " " <> rest              , MM.minComParentId  = case em of                  Replying _ p -> Just $ MM.getId p-                 Editing p    -> MM.postParentId p+                 Editing p _  -> MM.postParentId p                  _            -> Nothing              , MM.minComRootId  = case em of                  Replying _ p -> MM.postRootId p <|> (Just $ MM.postId p)-                 Editing p    -> MM.postRootId p+                 Editing p _  -> MM.postRootId p                  _            -> Nothing              , MM.minComTeamId = tId              }@@ -180,7 +178,7 @@   case errMsg of     Nothing -> return ()     Just err ->-      mhError ("Error running command: " <> err)+      mhError $ GenericError ("Error running command: " <> err)  dispatchCommand :: Text -> MH () dispatchCommand cmd =@@ -195,7 +193,7 @@             go errs [] = do               let msg = ("error running command /" <> x <> ":\n" <>                          mconcat [ "    " <> e | e <- errs ])-              mhError msg+              mhError $ GenericError msg             go errs (Cmd _ _ spec exe : cs) =               case matchArgs spec xs of                 Left e -> go (e:errs) cs

@@ -2,6 +2,7 @@ -- https://github.com/glguy/irc-core/blob/v2/src/Client/Commands/WordCompletion.hs module Completion   ( Completer(..)+  , CompletionAlternative(..)   , wordComplete   , currentAlternative   , nextCompletion@@ -18,31 +19,47 @@  import qualified Zipper as Z + -- A completer stores the stateful selection of a completion alternative--- from a sequence of alternatives. Each item in the sequence is a pair:--- the first element of the pair is the string corresonding to the user--- input and the second element of the pair is what will ultimately--- replace the user's input. The two are decoupled specifically to deal--- with permitting nickname completions to "resolve" to usernames.+-- from a sequence of alternatives. data Completer =-    Completer { completionAlternatives :: Z.Zipper (Text, Text)+    Completer { completionAlternatives :: Z.Zipper CompletionAlternative               } +-- A completion alternative is made up of various representations:+-- the string corresonding to the user input, the string that will+-- ultimately replace the user's input, and the the string that we will+-- display in the alternative list. The representations are decoupled+-- specifically to deal with permitting nickname completions to+-- "resolve" to usernames and to permit completions in context-sensitive+-- settings where the completion replacement and display differ greatly+-- from the input.+data CompletionAlternative =+    CompletionAlternative { completionInput :: Text+                          , completionReplacement :: Text+                          , completionDisplay :: Text+                          }+                          deriving (Ord, Eq)++matchesAlternative :: Text -> CompletionAlternative -> Bool+matchesAlternative input alt =+    T.toLower input `T.isPrefixOf` (T.toLower $ completionInput alt)+ -- Nothing: no completions. -- Just Left: a single completion. -- Just Right: more than one completion.-wordComplete :: Set (Text, Text) -> Text -> Maybe (Either Text Completer)+wordComplete :: Set CompletionAlternative -> Text -> Maybe (Either Text Completer) wordComplete options input =     let curWord = currentWord input-        alts = sort $ Set.toList $ Set.filter ((curWord `T.isPrefixOf`) . fst) options+        alts = sort $ Set.toList $ Set.filter (matchesAlternative curWord) options     in if null alts || T.null curWord        then Nothing        else if length alts == 1-            then Just $ Left $ snd $ head alts+            then Just $ Left $ completionReplacement $ head alts             else Just $ Right $ Completer { completionAlternatives = Z.fromList alts                                           } -currentAlternative :: Completer -> (Text, Text)+currentAlternative :: Completer -> CompletionAlternative currentAlternative = Z.focus . completionAlternatives  nextCompletion :: Completer -> Completer

@@ -1,12 +1,13 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE MultiWayIf #-} module Config   ( Config(..)   , PasswordSource(..)   , findConfig   , getCredentials-  , defaultConfig-  ) where+  )+where  import           Prelude () import           Prelude.MH@@ -16,17 +17,50 @@ import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.IO as T-import           System.Directory (makeAbsolute)-import           System.Process (readProcess)+import           System.Directory ( makeAbsolute )+import           System.Environment ( getExecutablePath )+import           System.FilePath ( (</>), takeDirectory, splitPath, joinPath )+import           System.Process ( readProcess ) -import           IOUtil import           FilePaths+import           IOUtil import           Types import           Types.KeyEvents + defaultPort :: Int defaultPort = 443 +bundledSyntaxPlaceholderName :: String+bundledSyntaxPlaceholderName = "BUNDLED_SYNTAX"++userSyntaxPlaceholderName :: String+userSyntaxPlaceholderName = "USER_SYNTAX"++defaultSkylightingPaths :: IO [FilePath]+defaultSkylightingPaths = do+    xdg <- xdgSyntaxDir+    adjacent <- getBundledSyntaxPath+    return [xdg, adjacent]++getBundledSyntaxPath :: IO FilePath+getBundledSyntaxPath = do+    selfPath <- getExecutablePath+    let distDir = "dist-newstyle/"+        pathBits = splitPath selfPath++    return $ if distDir `elem` pathBits+             then+                 -- We're in development, so use the development+                 -- executable path to locate the XML path in the+                 -- development tree.+                 (joinPath $ takeWhile (/= distDir) pathBits) </> syntaxDirName+             else+                 -- In this case we assume the binary is being run from+                 -- a release, in which case the syntax directory is a+                 -- sibling of the executable path.+                 takeDirectory selfPath </> syntaxDirName+ fromIni :: IniParser Config fromIni = do   conf <- section "mattermost" $ do@@ -55,6 +89,8 @@       (configShowTypingIndicator defaultConfig)     configEnableAspell <- fieldFlagDef "enableAspell"       (configEnableAspell defaultConfig)+    configSyntaxDirs <- fieldDefOf "syntaxDirectories" syntaxDirsField []+    configActivityNotifyCommand <- fieldMb "activityNotifyCommand"     configActivityBell <- fieldFlagDef "activityBell"       (configActivityBell defaultConfig)     configHyperlinkingMode <- fieldFlagDef "hyperlinkURLs"@@ -76,6 +112,9 @@         Just binding -> return (Just (ev, binding))   return conf { configUserKeys = fromMaybe mempty keys } +syntaxDirsField :: Text -> Either String [FilePath]+syntaxDirsField = listWithSeparator ":" string+ backgroundField :: Text -> Either String BackgroundInfo backgroundField t =   case t of@@ -120,6 +159,7 @@            , configSmartBacktick             = True            , configURLOpenCommand            = Nothing            , configURLOpenCommandInteractive = False+           , configActivityNotifyCommand     = Nothing            , configActivityBell              = False            , configShowBackground            = Disabled            , configShowMessagePreview        = False@@ -131,15 +171,35 @@            , configUserKeys                  = mempty            , configShowTypingIndicator       = False            , configHyperlinkingMode          = True+           , configSyntaxDirs                = []            }  findConfig :: Maybe FilePath -> IO (Either String Config) findConfig Nothing = do     cfg <- locateConfig configFileName-    case cfg of+    fixupSyntaxDirs =<< case cfg of         Nothing -> return $ Right defaultConfig         Just path -> getConfig path-findConfig (Just path) = getConfig path+findConfig (Just path) = fixupSyntaxDirs =<< getConfig path++-- | If the configuration has no syntax directories specified (the+-- default if the user did not provide the setting), fill in the+-- list with the defaults. Otherwise replace any bundled directory+-- placeholders in the config's syntax path list.+fixupSyntaxDirs :: Either String Config -> IO (Either String Config)+fixupSyntaxDirs (Left e) = return $ Left e+fixupSyntaxDirs (Right c) =+    if configSyntaxDirs c == []+    then do+        dirs <- defaultSkylightingPaths+        return $ Right c { configSyntaxDirs = dirs }+    else do+        newDirs <- forM (configSyntaxDirs c) $ \dir ->+            if | dir == bundledSyntaxPlaceholderName -> getBundledSyntaxPath+               | dir == userSyntaxPlaceholderName    -> xdgSyntaxDir+               | otherwise                           -> return dir++        return $ Right $ c { configSyntaxDirs = newDirs }  getConfig :: FilePath -> IO (Either String Config) getConfig fp = runExceptT $ do

@@ -4,20 +4,22 @@ import           Prelude.MH  import           Brick.BChan-import           Control.Concurrent (forkIO, threadDelay)+import           Control.Concurrent ( forkIO, threadDelay ) import qualified Control.Concurrent.STM as STM-import           Control.Exception (SomeException, catch)-import           Data.Int (Int64)+import           Control.Exception ( SomeException, catch ) import qualified Data.HashMap.Strict as HM-import           Data.Semigroup (Max(..))-import           Data.Time (UTCTime(..), secondsToDiffTime, getCurrentTime, diffUTCTime)-import           Data.Time.Calendar (Day(..))+import           Data.Int (Int64)+import           Data.Semigroup ( Max(..) )+import           Data.Time ( UTCTime(..), secondsToDiffTime, getCurrentTime+                           , diffUTCTime )+import           Data.Time.Calendar ( Day(..) ) -import           Network.Mattermost.Types (ChannelId)+import           Network.Mattermost.Types ( ChannelId ) import qualified Network.Mattermost.WebSocket as WS  import           Constants import           Types+  connectWebsockets :: MH () connectWebsockets = do

@@ -7,6 +7,7 @@ import Prelude () import Prelude.MH + -- | The number of rows to consider a "page" when scrolling pageAmount :: Int pageAmount = 15

@@ -4,14 +4,15 @@  import Brick -import Types-import Draw.Main-import Draw.ShowHelp-import Draw.LeaveChannelConfirm import Draw.DeleteChannelConfirm+import Draw.JoinChannel+import Draw.LeaveChannelConfirm+import Draw.Main import Draw.PostListOverlay+import Draw.ShowHelp import Draw.UserListOverlay-import Draw.JoinChannel+import Types+  draw :: ChatState -> [Widget Name] draw st =

@@ -18,19 +18,22 @@  module Draw.ChannelList (renderChannelList) where +import           Prelude ()+import           Prelude.MH+ import           Brick import           Brick.Widgets.Border import qualified Data.Sequence as Seq import qualified Data.Foldable as F import qualified Data.HashMap.Strict as HM import qualified Data.Text as T-import           Draw.Util import           Lens.Micro.Platform (Getting, at, non)++import           Draw.Util import           State import           Themes import           Types-import           Prelude ()-import           Prelude.MH+  type GroupName = Text 

@@ -8,12 +8,13 @@ import Prelude.MH  import Brick-import Brick.Widgets.Center import Brick.Widgets.Border+import Brick.Widgets.Center -import Types-import Themes import Draw.Main+import Themes+import Types+  drawDeleteChannelConfirm :: ChatState -> [Widget Name] drawDeleteChannelConfirm st =

@@ -4,23 +4,25 @@     ) where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick-import Brick.Widgets.List-import Brick.Widgets.Center-import Brick.Widgets.Border+import           Brick+import           Brick.Widgets.Border+import           Brick.Widgets.Center+import           Brick.Widgets.List import qualified Data.Text as T import qualified Data.Vector as V-import Text.Wrap ( defaultWrapSettings, preserveIndentation )-import Network.Mattermost.Types (Channel)-import Network.Mattermost.Lenses ( channelDisplayNameL , channelNameL-                                 , channelPurposeL )+import           Text.Wrap ( defaultWrapSettings, preserveIndentation ) -import Types-import Themes-import Draw.Main+import           Network.Mattermost.Lenses ( channelDisplayNameL , channelNameL+                                           , channelPurposeL )+import           Network.Mattermost.Types ( Channel )++import           Draw.Main+import           Themes+import           Types+  drawJoinChannel :: ChatState -> [Widget Name] drawJoinChannel st = (joinBorders $ joinChannelBox st) : (forceAttr "invalid" <$> drawMain st)

@@ -8,12 +8,13 @@ import Prelude.MH  import Brick-import Brick.Widgets.Center import Brick.Widgets.Border+import Brick.Widgets.Center -import Types-import Themes import Draw.Main+import Themes+import Types+  drawLeaveChannelConfirm :: ChatState -> [Widget Name] drawLeaveChannelConfirm st =

@@ -7,42 +7,44 @@ import           Brick import           Brick.Widgets.Border import           Brick.Widgets.Border.Style-import           Brick.Widgets.Center (hCenter)-import           Brick.Widgets.Edit (editContentsL, renderEditor, getEditContents)-import           Brick.Widgets.List (renderList)-import           Control.Arrow ((>>>))-import           Control.Monad.Trans.Reader (withReaderT)-import           Data.Time.Clock (UTCTime(..))-import           Data.Time.Calendar (fromGregorian)+import           Brick.Widgets.Center ( hCenter )+import           Brick.Widgets.Edit ( editContentsL, renderEditor, getEditContents )+import           Brick.Widgets.List ( renderList )+import           Control.Arrow ( (>>>) )+import           Control.Monad.Trans.Reader ( withReaderT )+import           Data.Char ( isSpace, isPunctuation )+import qualified Data.Foldable as F+import           Data.List ( intersperse ) import qualified Data.Sequence as Seq import qualified Data.Set as S-import qualified Data.Foldable as F-import           Data.List (intersperse) import qualified Data.Text as T-import           Data.Text.Zipper (cursorPosition, insertChar, getText, gotoEOL)-import           Data.Char (isSpace, isPunctuation)-import           Lens.Micro.Platform ((.~), (^?!), to, view, folding)+import           Data.Text.Zipper ( cursorPosition, insertChar, getText, gotoEOL )+import           Data.Time.Calendar ( fromGregorian )+import           Data.Time.Clock ( UTCTime(..) )+import qualified Graphics.Vty as Vty+import           Lens.Micro.Platform ( (.~), (^?!), to, view, folding ) -import           Network.Mattermost.Types (ChannelId, Type(Direct), ServerTime(..), UserId)+import           Network.Mattermost.Types ( ChannelId, Type(Direct)+                                          , ServerTime(..), UserId ) -import qualified Graphics.Vty as Vty -import           Draw.ChannelList (renderChannelList)+import           Completion ( Completer(..), CompletionAlternative(..), currentAlternative )+import           Draw.ChannelList ( renderChannelList ) import           Draw.Messages import           Draw.Util+import           Events.Keybindings+import           Events.MessageSelect import           Markdown-import           Completion (Completer(..), currentAlternative) import           State import           Themes-import           TimeUtils (justAfter, justBefore)+import           TimeUtils ( justAfter, justBefore ) import           Types import           Types.KeyEvents-import           Events.Keybindings-import           Events.MessageSelect -previewFromInput :: UserId -> Text -> Maybe Message-previewFromInput _ s | s == T.singleton cursorSentinel = Nothing-previewFromInput uId s =++previewFromInput :: Maybe MessageType -> UserId -> Text -> Maybe Message+previewFromInput _ _ s | s == T.singleton cursorSentinel = Nothing+previewFromInput overrideTy uId s =     -- If it starts with a slash but not /me, this has no preview     -- representation     let isCommand = "/" `T.isPrefixOf` s@@ -50,7 +52,7 @@         content = if isEmote                   then T.stripStart $ T.drop 3 s                   else s-        msgTy = if isEmote then CP Emote else CP NormalPost+        msgTy = fromMaybe (if isEmote then CP Emote else CP NormalPost) overrideTy     in if isCommand && not isEmote        then Nothing        else Just $ Message { _mText          = getBlocks content@@ -58,8 +60,9 @@                            , _mDate          = ServerTime $ UTCTime (fromGregorian 1970 1 1) 0                            -- The date is not used for preview                            -- rendering, but we need to provide one.-                           -- Ideally we'd just today's date, but the-                           -- rendering function is pure so we can't.+                           -- Ideally we'd just use today's date, but+                           -- the rendering function is pure so we+                           -- can't.                            , _mType          = msgTy                            , _mPending       = False                            , _mDeleted       = False@@ -217,7 +220,7 @@ renderUserCommandBox st hs =     let prompt = txt $ case st^.csEditState.cedEditMode of             Replying _ _ -> "reply> "-            Editing _    ->  "edit> "+            Editing _ _  ->  "edit> "             NewPost      ->      "> "         inputBox = renderEditor (drawEditorContents st hs) True (st^.csEditState.cedEditor)         curContents = getEditContents $ st^.csEditState.cedEditor@@ -273,7 +276,7 @@         chnName = chan^.ccInfo.cdName         topicStr = chan^.ccInfo.cdHeader         userHeader u = let s = T.intercalate " " $ filter (not . T.null) parts-                           parts = [ u^.uiName+                           parts = [ userSigil <> u^.uiName                                    , if (all T.null names)                                      then mempty                                      else "is"@@ -416,8 +419,8 @@           newMessagesMsg d = newMessageOfType (T.pack "New Messages")                              (C NewMessagesTransition) d -renderChannelSelect :: ChatState -> Widget Name-renderChannelSelect st =+renderChannelSelectPrompt :: ChatState -> Widget Name+renderChannelSelectPrompt st =     let cstr = st^.csChannelSelectState.channelSelectInput     in withDefAttr channelSelectPromptAttr $        (txt "Switch to channel [use ^ and $ to anchor]: ") <+>@@ -489,11 +492,11 @@ drawCompletionAlternatives :: Completer -> Widget Name drawCompletionAlternatives c =     let alternatives = intersperse (txt " ") $ mkAlternative <$> toList (completionAlternatives c)-        mkAlternative (displayVal, _) =-            let format = if displayVal == (fst $ currentAlternative c)+        mkAlternative alt =+            let format = if completionInput alt == (completionInput $ currentAlternative c)                          then visible . withDefAttr completionAlternativeCurrentAttr                          else id-            in format $ txt displayVal+            in format $ txt $ completionDisplay alt     in hBox [ borderElem bsHorizontal             , txt "["             , withDefAttr completionAlternativeListAttr $@@ -532,7 +535,10 @@     curContents = getText $ (gotoEOL >>> insertChar cursorSentinel) $                   st^.csEditState.cedEditor.editContentsL     curStr = T.intercalate "\n" curContents-    previewMsg = previewFromInput uId curStr+    overrideTy = case st^.csEditState.cedEditMode of+        Editing _ ty -> Just ty+        _ -> Nothing+    previewMsg = previewFromInput overrideTy uId curStr     thePreview = let noPreview = str "(No preview)"                      msgPreview = case previewMsg of                        Nothing -> noPreview@@ -556,7 +562,7 @@ userInputArea :: ChatState -> HighlightSet -> Widget Name userInputArea st hs =     case appMode st of-        ChannelSelect -> renderChannelSelect st+        ChannelSelect -> renderChannelSelectPrompt st         UrlSelect     -> hCenter $ hBox [ txt "Press "                                         , withDefAttr clientEmphAttr $ txt "Enter"                                         , txt " to open the selected URL or "

@@ -2,13 +2,13 @@  import           Brick import           Brick.Widgets.Border-import           Control.Monad.Trans.Reader (withReaderT)+import           Control.Monad.Trans.Reader ( withReaderT ) import qualified Data.Map.Strict as Map import qualified Data.Sequence as Seq import qualified Data.Text as T import qualified Graphics.Vty as Vty-import           Lens.Micro.Platform ((.~), to)-import           Network.Mattermost.Types (ServerTime(..))+import           Lens.Micro.Platform ( (.~), to )+import           Network.Mattermost.Types ( ServerTime(..) ) import           Prelude () import           Prelude.MH 

@@ -5,21 +5,22 @@ import           Prelude () import           Prelude.MH -import           Control.Monad.Trans.Reader (withReaderT)+import           Brick+import           Brick.Widgets.Border+import           Brick.Widgets.Center+import           Control.Monad.Trans.Reader ( withReaderT ) import qualified Data.Text as T-import           Lens.Micro.Platform ((^?), (%~), to)-import           Network.Mattermost.Types+import           Lens.Micro.Platform ( (^?), (%~), to )+ import           Network.Mattermost.Lenses+import           Network.Mattermost.Types -import Brick-import Brick.Widgets.Border-import Brick.Widgets.Center+import           Draw.Main+import           Draw.Messages+import           Draw.Util+import           Themes+import           Types -import Themes-import Types-import Draw.Main-import Draw.Messages-import Draw.Util  hLimitWithPadding :: Int -> Widget n -> Widget n hLimitWithPadding pad contents = Widget@@ -85,7 +86,7 @@                     | Just u <- userByDMChannelName (chan^.ccInfo.cdName)                                                     (myUserId st)                                                     st ->-                        (forceAttr channelNameAttr (txt (T.singleton '@' <> u^.uiName)) <=>+                        (forceAttr channelNameAttr (txt (userSigil <> u^.uiName)) <=>                           (str "  " <+> renderedMsg))                   _ -> (forceAttr channelNameAttr (txt (chan^.ccInfo.to mkChannelName)) <=>                          (str "  " <+> renderedMsg))

@@ -1,36 +1,38 @@ module Draw.ShowHelp (drawShowHelp) where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick-import Brick.Themes (themeDescriptions)-import Brick.Widgets.Border-import Brick.Widgets.Center (hCenter, centerLayer)-import Brick.Widgets.List (listSelectedFocusedAttr)+import           Brick+import           Brick.Themes ( themeDescriptions )+import           Brick.Widgets.Border+import           Brick.Widgets.Center ( hCenter, centerLayer )+import           Brick.Widgets.List ( listSelectedFocusedAttr ) import qualified Data.Map as M import qualified Data.Text as T import qualified Graphics.Vty as Vty-import Network.Mattermost.Version (mmApiVersion) -import Themes-import Types-import Types.KeyEvents (Binding(..), ppBinding, nonCharKeys, eventToBinding)-import Events.Keybindings-import Command-import Events.ShowHelp-import Events.ChannelScroll-import Events.ChannelSelect-import Events.UrlSelect-import Events.Main-import Events.MessageSelect-import Events.PostListOverlay-import Events.UserListOverlay-import State.Editing (editingKeybindings)-import Markdown (renderText)-import Options (mhVersion)-import HelpTopics (helpTopics)+import           Network.Mattermost.Version ( mmApiVersion ) +import           Command+import           Events.ChannelScroll+import           Events.ChannelSelect+import           Events.Keybindings+import           Events.Main+import           Events.MessageSelect+import           Events.PostListOverlay+import           Events.ShowHelp+import           Events.UrlSelect+import           Events.UserListOverlay+import           HelpTopics ( helpTopics )+import           Markdown ( renderText )+import           Options ( mhVersion )+import           State.Editing ( editingKeybindings )+import           Themes+import           Types+import           Types.KeyEvents ( Binding(..), ppBinding, nonCharKeys, eventToBinding )++ drawShowHelp :: HelpTopic -> ChatState -> [Widget Name] drawShowHelp topic st =     [helpBox (helpTopicViewportName topic) $ helpTopicDraw topic st]@@ -41,6 +43,7 @@         MainHelp -> mainHelp (configUserKeys (st^.csResources.crConfiguration))         ScriptHelp -> scriptHelp         ThemeHelp -> themeHelp+        SyntaxHighlightHelp -> syntaxHighlightHelp (configSyntaxDirs $ st^.csResources.crConfiguration)         KeybindingHelp -> keybindingHelp (configUserKeys (st^.csResources.crConfiguration))  mainHelp :: KeyConfig -> Widget Name@@ -212,6 +215,30 @@             , "."             ]           ]++para :: Text -> Widget a+para t = padTop (Pad 1) $ hCenter (hLimit 72 $ padRight Max $ renderText t)++syntaxHighlightHelp :: [FilePath] -> Widget a+syntaxHighlightHelp dirs = overrideAttr codeAttr helpEmphAttr $ vBox+  [ padTop (Pad 1) $ hCenter $ withDefAttr helpEmphAttr $ txt "Syntax Highlighting"+  , para $ "Matterhorn supports syntax highlighting in Markdown code blocks when the " <>+           "name of the code block language follows the block opening sytnax:"+  , para $ "```<language>"+  , para $ "The possible values of `language` are determined by the available syntax " <>+           "definitions. The available definitions are loaded from the following " <>+           "directories according to the configuration setting `syntaxDirectories`. " <>+           "If the setting is omitted, it defaults to the following sequence of directories:"+  , para $ T.pack $ intercalate "\n" $ (\d -> "`" <> d <> "`") <$> dirs+  , para $ "Syntax definitions are in the Kate XML format. Files with an " <>+           "`xml` extension are loaded from each directory, with directories earlier " <>+           "in the list taking precedence over later directories when more than one " <>+           "directory provides a definition file for the same syntax."+  , para $ "To place custom definitions in a directory, place a Kate " <>+           "XML syntax definition in the directory and ensure that a copy of " <>+           "`language.dtd` is also present. The file `language.dtd` can be found in " <>+           "the `syntax/` directory of your Matterhorn distribution."+  ]  themeHelp :: Widget a themeHelp = overrideAttr codeAttr helpEmphAttr $ vBox

@@ -6,22 +6,22 @@ import           Prelude () import           Prelude.MH -import           Control.Monad.Trans.Reader (withReaderT)+import           Brick+import           Brick.Widgets.Border+import           Brick.Widgets.Center+import           Brick.Widgets.Edit+import qualified Brick.Widgets.List as L+import           Control.Monad.Trans.Reader ( withReaderT ) import qualified Data.Foldable as F import qualified Data.Text as T import qualified Graphics.Vty as V-import           Lens.Micro.Platform ((%~))+import           Lens.Micro.Platform ( (%~) ) -import Brick-import Brick.Widgets.Border-import Brick.Widgets.Edit-import qualified Brick.Widgets.List as L-import Brick.Widgets.Center+import           Draw.Main+import           Draw.Util ( userSigilFromInfo )+import           Themes+import           Types -import Themes-import Types-import Draw.Main-import Draw.Util (userSigilFromInfo)  hLimitWithPadding :: Int -> Widget n -> Widget n hLimitWithPadding pad contents = Widget

@@ -1,17 +1,18 @@ module Draw.Util where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick-import qualified Data.Text as T+import           Brick import qualified Data.Set as Set-import Lens.Micro.Platform (to)-import Network.Mattermost.Types+import qualified Data.Text as T+import           Lens.Micro.Platform ( to )+import           Network.Mattermost.Types -import Types-import TimeUtils-import Themes+import           Themes+import           TimeUtils+import           Types+  defaultTimeFormat :: Text defaultTimeFormat = "%R"

@@ -6,36 +6,38 @@  import           Brick import qualified Data.Map as M-import qualified Data.Set as Set 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 ((.=))+import           Lens.Micro.Platform ( (.=) ) -import           Network.Mattermost.Types+import           Network.Mattermost.Exceptions ( mattermostErrorMessage ) import           Network.Mattermost.Lenses+import           Network.Mattermost.Types import           Network.Mattermost.WebSocket-import           Network.Mattermost.Exceptions (mattermostErrorMessage)  import           Connection+import           HelpTopics import           State import           State.Common import           Types import           Types.KeyEvents -import           Events.Keybindings-import           Events.ShowHelp-import           Events.Main-import           Events.JoinChannel import           Events.ChannelScroll import           Events.ChannelSelect-import           Events.LeaveChannelConfirm import           Events.DeleteChannelConfirm-import           Events.UrlSelect+import           Events.JoinChannel+import           Events.Keybindings+import           Events.LeaveChannelConfirm+import           Events.Main import           Events.MessageSelect import           Events.PostListOverlay+import           Events.ShowHelp+import           Events.UrlSelect import           Events.UserListOverlay + onEvent :: ChatState -> BrickEvent Name MHEvent -> EventM Name (Next ChatState) onEvent st ev = runMHEvent st (onEv >> fetchVisibleIfNeeded)     where onEv = do case ev of@@ -60,23 +62,47 @@ onAppEvent (WSEvent we) =   handleWSEvent we onAppEvent (RespEvent f) = f-onAppEvent (AsyncMattermostError e) = do-  mhError $ mattermostErrorMessage e-onAppEvent (AsyncErrEvent e) = do-  let msg = "An unexpected error has occurred! The exception encountered was:\n  " <>-            T.pack (show e) <>-            "\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"-  mhError msg onAppEvent (WebsocketParseError e) = do   let msg = "A websocket message could not be parsed:\n  " <>             T.pack e <>             "\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"-  mhError msg+  mhError $ GenericError msg onAppEvent (IEvent e) = do   handleIEvent e  handleIEvent :: InternalEvent -> MH ()-handleIEvent (DisplayError msg) = postErrorMessage' msg+handleIEvent (DisplayError e) = postErrorMessage' $ formatError e++formatError :: MHError -> T.Text+formatError (GenericError msg) =+    msg+formatError (NoSuchChannel chan) =+    T.pack $ "No such channel: " <> show chan+formatError (NoSuchUser user) =+    T.pack $ "No such user: " <> show user+formatError (AmbiguousName name) =+    (T.pack $ "The input " <> show name <> " matches both channels ") <>+    "and users. Try using '" <> userSigil <> "' or '" <>+    normalChannelSigil <> "' to disambiguate."+formatError (ServerError e) =+    mattermostErrorMessage e+formatError (ClipboardError msg) =+    msg+formatError (ConfigOptionMissing opt) =+    T.pack $ "Config option " <> show opt <> " missing"+formatError (ProgramExecutionFailed progName logPath) =+    T.pack $ "An error occurred when running " <> show progName <>+             "; see " <> show logPath <> " for details."+formatError (NoSuchScript name) =+    "No script named " <> name <> " was found"+formatError (NoSuchHelpTopic topic) =+    let knownTopics = ("  - " <>) <$> helpTopicName <$> helpTopics+    in "Unknown help topic: `" <> topic <> "`. " <>+       (T.unlines $ "Available topics are:" : knownTopics)+formatError (AsyncErrEvent e) =+    "An unexpected error has occurred! The exception encountered was:\n  " <>+    T.pack (show e) <>+    "\nPlease report this error at https://github.com/matterhorn-chat/matterhorn/issues"  onVtyEvent :: Vty.Event -> MH () onVtyEvent e = do

@@ -1,14 +1,15 @@ module Events.ChannelScroll where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick+import           Brick import qualified Graphics.Vty as Vty -import Types-import Events.Keybindings-import State+import           Events.Keybindings+import           State+import           Types+  channelScrollKeybindings :: KeyConfig -> [Keybinding] channelScrollKeybindings = mkKeybindings

@@ -1,15 +1,16 @@ module Events.ChannelSelect where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import qualified Data.Text as T import qualified Graphics.Vty as Vty-import Lens.Micro.Platform ((%=))+import           Lens.Micro.Platform ( (%=) ) -import Events.Keybindings-import Types-import State+import           Events.Keybindings+import           State+import           Types+  onEventChannelSelect :: Vty.Event -> MH () onEventChannelSelect =

@@ -1,12 +1,13 @@ module Events.DeleteChannelConfirm where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import qualified Graphics.Vty as Vty -import Types-import State+import           Types+import           State+  onEventDeleteChannelConfirm :: Vty.Event -> MH () onEventDeleteChannelConfirm (Vty.EvKey k []) = do

@@ -1,16 +1,17 @@ module Events.JoinChannel where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick.Widgets.List+import           Brick.Widgets.List import qualified Graphics.Vty as Vty-import Lens.Micro.Platform ((.=))+import           Lens.Micro.Platform ( (.=) ) -import Network.Mattermost.Types (getId)+import           Network.Mattermost.Types ( getId ) -import Types-import State (joinChannel)+import           State ( joinChannel )+import           Types+  joinChannelListKeys :: [Vty.Key] joinChannelListKeys =

@@ -18,15 +18,18 @@   , keyEventName   , keyEventFromName -  ) where+  )+where +import           Prelude ()+import           Prelude.MH+ import qualified Data.Map.Strict as M import qualified Graphics.Vty as Vty  import           Types import           Types.KeyEvents-import           Prelude ()-import           Prelude.MH+  -- * Keybindings 

@@ -1,12 +1,13 @@ module Events.LeaveChannelConfirm where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import qualified Graphics.Vty as Vty -import Types-import State+import           State+import           Types+  onEventLeaveChannelConfirm :: Vty.Event -> MH () onEventLeaveChannelConfirm (Vty.EvKey k []) = do

@@ -1,31 +1,34 @@ {-# LANGUAGE MultiWayIf #-} module Events.Main where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick hiding (Direction)-import Brick.Widgets.Edit+import           Brick hiding ( Direction )+import           Brick.Widgets.Edit+import qualified Data.Map as M import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Zipper as Z import qualified Data.Text.Zipper.Generic.Words as Z import qualified Graphics.Vty as Vty-import Lens.Micro.Platform ((%=), (.=), to, at)+import           Lens.Micro.Platform ( (%=), (.=), to, at )+import qualified Skylighting.Types as Sky -import Types-import Events.Keybindings-import State-import State.PostListOverlay (enterFlaggedPostListMode)-import State.Editing-import Command-import Completion-import InputHistory-import HelpTopics (mainHelpTopic)-import Constants+import           Network.Mattermost.Types ( Type(..) ) -import Network.Mattermost.Types (Type(..))+import           Command+import           Completion+import           Constants+import           Events.Keybindings+import           HelpTopics ( mainHelpTopic )+import           InputHistory+import           State+import           State.Editing+import           State.PostListOverlay ( enterFlaggedPostListMode )+import           Types + onEventMain :: Vty.Event -> MH () onEventMain =   handleKeyboardEvent mainKeybindings $ \ ev -> case ev of@@ -183,7 +186,9 @@           ch <- channelByName cname st           case ch^.ccInfo.cdType of               Group -> Nothing-              _     -> Just [dupe cname, dupe $ normalChannelSigil <> cname]+              _     -> Just [ CompletionAlternative cname (normalChannelSigil <> cname) cname+                            , mkAlt $ normalChannelSigil <> cname+                            ]           )        userCompletions = concat $ catMaybes (flip map allUIds $ \uId ->@@ -193,13 +198,18 @@               Just u | u^.uiDeleted -> Nothing               Just u ->                   let mNick = case u^.uiNickName of-                        Just nick | displayNick -> [(userSigil <> nick, userSigil <> u^.uiName), (nick, u^.uiName)]+                        Just nick | displayNick ->+                            [ CompletionAlternative (userSigil <> nick) (userSigil <> u^.uiName) (userSigil <> nick)+                            , CompletionAlternative nick (userSigil <> u^.uiName) nick+                            ]                         _ -> []-                  in Just $ [dupe $ u^.uiName, dupe $ userSigil <> u^.uiName] <> mNick+                  in Just $ [ CompletionAlternative (u^.uiName) (userSigil <> u^.uiName) (u^.uiName)+                            , mkAlt $ userSigil <> u^.uiName+                            ] <> mNick           ) -      commandCompletions = dupe <$> map ("/" <>) (commandName <$> commandList)-      dupe a = (a, a)+      commandCompletions = mkAlt <$> map ("/" <>) (commandName <$> commandList)+      mkAlt a = CompletionAlternative a a a       completions = Set.fromList (userCompletions ++                                   channelCompletions ++                                   commandCompletions)@@ -217,7 +227,12 @@           -- There is no completion in progress, so start a new           -- completion from the current input.           let line = Z.currentLine $ st^.csEditState.cedEditor.editContentsL-          case wordComplete completions line of+              completionsToUse =+                  if | "```" `T.isPrefixOf` line ->+                         Set.fromList $ (\k -> (CompletionAlternative ("```" <> k) ("```" <> k) k)) <$>+                             (Sky.sShortname <$> (M.elems $ st^.csResources.crSyntaxMap))+                     | otherwise -> completions+          case wordComplete completionsToUse line of               Nothing ->                   -- No matches were found, so do nothing.                   return ()@@ -237,5 +252,5 @@   case mComp of       Nothing -> return ()       Just comp -> do-          let replacement = snd $ currentAlternative comp+          let replacement = completionReplacement $ currentAlternative comp           csEditState.cedEditor %= applyEdit (Z.insertMany replacement . Z.deletePrevWord)

@@ -1,15 +1,16 @@ module Events.MessageSelect where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import qualified Data.Text as T import qualified Graphics.Vty as Vty -import Types-import Events.Keybindings-import State+import           Events.Keybindings+import           State+import           Types + messagesPerPageOperation :: Int messagesPerPageOperation = 10 @@ -47,7 +48,7 @@          beginReplyCompose      , mkKb EditMessageEvent "Begin editing the selected message"-         beginUpdateMessage+         beginEditMessage      , mkKb DeleteMessageEvent "Delete the selected message (with confirmation)"          beginConfirmDeleteSelectedMessage

@@ -1,12 +1,14 @@ module Events.PostListOverlay where -import qualified Graphics.Vty as Vty import           Prelude () import           Prelude.MH -import Types-import Events.Keybindings-import State.PostListOverlay+import qualified Graphics.Vty as Vty++import           Types+import           Events.Keybindings+import           State.PostListOverlay+  onEventPostListOverlay :: Vty.Event -> MH () onEventPostListOverlay =

@@ -1,14 +1,15 @@ module Events.ShowHelp where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick+import           Brick import qualified Graphics.Vty as Vty -import Types-import Events.Keybindings-import Constants+import           Constants+import           Events.Keybindings+import           Types+  onEventShowHelp :: Vty.Event -> MH () onEventShowHelp =

@@ -1,14 +1,15 @@ module Events.UrlSelect where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick.Widgets.List+import           Brick.Widgets.List import qualified Graphics.Vty as Vty -import Types-import Events.Keybindings-import State+import           Events.Keybindings+import           State+import           Types+  onEventUrlSelect :: Vty.Event -> MH () onEventUrlSelect =

@@ -1,14 +1,15 @@ module Events.UserListOverlay where -import qualified Graphics.Vty as Vty import           Prelude () import           Prelude.MH -import Brick.Widgets.Edit (handleEditorEvent)+import           Brick.Widgets.Edit ( handleEditorEvent )+import qualified Graphics.Vty as Vty -import Types-import Events.Keybindings-import State.UserListOverlay+import           Events.Keybindings+import           State.UserListOverlay+import           Types+  onEventUserListOverlay :: Vty.Event -> MH () onEventUserListOverlay =

@@ -10,25 +10,32 @@    , xdgName   , locateConfig+  , xdgSyntaxDir+  , syntaxDirName    , Script(..)   , locateScriptPath   , getAllScripts-  ) where+  )+where  import Prelude () import Prelude.MH -import Data.Text (unpack)+import Data.Text ( unpack ) import System.Directory ( doesFileExist                         , doesDirectoryExist                         , getDirectoryContents                         , getPermissions                         , executable                         )-import System.Environment.XDG.BaseDir (getUserConfigFile, getAllConfigFiles)-import System.FilePath (takeBaseName)+import System.Environment.XDG.BaseDir ( getUserConfigFile+                                      , getAllConfigFiles+                                      , getUserConfigDir+                                      )+import System.FilePath ( (</>), takeBaseName ) + xdgName :: String xdgName = "matterhorn" @@ -48,11 +55,19 @@ lastRunStateFilePath teamId =   getUserConfigFile xdgName (lastRunStateFileName teamId) +-- | Get the XDG path to the user-specific syntax definition directory.+-- The path does not necessarily exist.+xdgSyntaxDir :: IO FilePath+xdgSyntaxDir = (</> syntaxDirName) <$> getUserConfigDir xdgName++syntaxDirName :: FilePath+syntaxDirName = "syntax"+ -- | Find a specified configuration file by looking in all of the -- supported locations. locateConfig :: FilePath -> IO (Maybe FilePath) locateConfig filename = do-  xdgLocations <- getAllConfigFiles "matterhorn" filename+  xdgLocations <- getAllConfigFiles xdgName filename   let confLocations = ["./" <> filename] ++                       xdgLocations ++                       ["/etc/matterhorn/" <> filename]@@ -84,7 +99,7 @@ locateScriptPath name   | head name == '.' = return ScriptNotFound   | otherwise = do-    xdgLocations <- getAllConfigFiles "matterhorn" scriptDirName+    xdgLocations <- getAllConfigFiles xdgName scriptDirName     let cmdLocations = [ xdgLoc ++ "/" ++ name                        | xdgLoc <- xdgLocations                        ] ++ [ "/etc/matterhorn/scripts/" <> name ]@@ -98,7 +113,7 @@ --   scripts. getAllScripts :: IO ([FilePath], [FilePath]) getAllScripts = do-  xdgLocations <- getAllConfigFiles "matterhorn" scriptDirName+  xdgLocations <- getAllConfigFiles xdgName scriptDirName   let cmdLocations = xdgLocations ++ ["/etc/matterhorn/scripts"]   let getCommands dir = do         exists <- doesDirectoryExist dir

@@ -3,7 +3,6 @@   ( helpTopics   , lookupHelpTopic   , themeHelpTopic-   , mainHelpTopic   ) where@@ -13,12 +12,14 @@  import Types + helpTopics :: [HelpTopic] helpTopics =     [ mainHelpTopic     , scriptHelpTopic     , themeHelpTopic     , keybindingHelpTopic+    , syntaxHighlightingHelpTopic     ]  mainHelpTopic :: HelpTopic@@ -37,6 +38,11 @@ keybindingHelpTopic =     HelpTopic "keybindings" "Help on overriding keybindings"       KeybindingHelp KeybindingHelpText++syntaxHighlightingHelpTopic :: HelpTopic+syntaxHighlightingHelpTopic =+    HelpTopic "syntax" "Help on syntax highlighing"+      SyntaxHighlightHelp SyntaxHighlightHelpText  lookupHelpTopic :: Text -> Maybe HelpTopic lookupHelpTopic topic =

@@ -1,13 +1,15 @@ module IOUtil   ( convertIOException-  ) where+  )+where  import Prelude () import Prelude.MH  import Control.Exception import Control.Monad.Trans.Except-import System.IO.Error (ioeGetErrorString)+import System.IO.Error ( ioeGetErrorString )+  convertIOException :: IO a -> ExceptT String IO a convertIOException act = do

@@ -7,24 +7,27 @@   , addHistoryEntry   , getHistoryEntry   , removeChannelHistory-  ) where+  )+where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Control.Monad.Trans.Except-import Lens.Micro.Platform ((.~), (^?), (%~), at, ix, makeLenses)+import           Control.Monad.Trans.Except import qualified Data.HashMap.Strict as HM-import System.Directory (createDirectoryIfMissing)-import System.FilePath (dropFileName)-import qualified System.IO.Strict as S import qualified Data.Vector as V+import           Lens.Micro.Platform ( (.~), (^?), (%~), at, ix, makeLenses )+import           System.Directory ( createDirectoryIfMissing )+import           System.FilePath ( dropFileName )+import qualified System.IO.Strict as S import qualified System.Posix.Files as P import qualified System.Posix.Types as P -import IOUtil-import FilePaths-import Network.Mattermost.Types (ChannelId)+import           Network.Mattermost.Types ( ChannelId )++import           FilePaths+import           IOUtil+  data InputHistory =     InputHistory { _historyEntries :: HashMap ChannelId (V.Vector Text)

@@ -8,26 +8,29 @@   , writeLastRunState   , readLastRunState   , isValidLastRunState-  ) where+  )+where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Control.Monad.Trans.Except+import           Control.Monad.Trans.Except import qualified Data.Aeson as A import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS-import Lens.Micro.Platform (makeLenses)-import System.Directory (createDirectoryIfMissing)-import System.FilePath (dropFileName)+import           Lens.Micro.Platform ( makeLenses )+import           System.Directory ( createDirectoryIfMissing )+import           System.FilePath ( dropFileName ) import qualified System.Posix.Files as P import qualified System.Posix.Types as P -import IOUtil-import FilePaths-import Network.Mattermost.Types-import Network.Mattermost.Lenses-import Types+import           Network.Mattermost.Lenses+import           Network.Mattermost.Types++import           FilePaths+import           IOUtil+import           Types+  -- | Run state of the program. This is saved in a file on program exit and -- | looked up from the file on program startup.

@@ -3,29 +3,32 @@ {-# LANGUAGE RankNTypes #-} module Login   ( interactiveGatherCredentials-  ) where+  )+where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick-import Brick.Forms-import Brick.Focus-import Brick.Widgets.Edit-import Brick.Widgets.Center-import Brick.Widgets.Border-import Lens.Micro.Platform ((.~), Lens', makeLenses)+import           Brick+import           Brick.Focus+import           Brick.Forms+import           Brick.Widgets.Border+import           Brick.Widgets.Center+import           Brick.Widgets.Edit import qualified Data.Text as T-import Graphics.Vty-import System.Exit (exitSuccess)+import           Graphics.Vty+import           Lens.Micro.Platform ( (.~), Lens', makeLenses )+import           System.Exit ( exitSuccess ) import qualified System.IO.Error as Err -import Network.Mattermost.Exceptions (LoginFailureException(..))+import           Network.Mattermost.Exceptions ( LoginFailureException(..) ) -import Markdown-import Types ( ConnectionInfo(..), ciPassword, ciUsername, ciHostname-             , ciPort, AuthenticationException(..)-             )+import           Markdown+import           Types ( ConnectionInfo(..)+                       , ciPassword, ciUsername, ciHostname+                       , ciPort, AuthenticationException(..)+                       )+  data Name = Hostname | Port | Username | Password deriving (Ord, Eq, Show) 

@@ -1,14 +1,15 @@ module Main where -import           Prelude ()-import           Prelude.MH+import Prelude ()+import Prelude.MH -import           System.Exit (exitFailure)+import System.Exit ( exitFailure ) -import           Config-import           Options-import           App-import           Events (ensureKeybindingConsistency)+import Config+import Options+import App+import Events ( ensureKeybindingConsistency )+  main :: IO () main = do

@@ -16,21 +16,20 @@   ) where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import           Brick ( (<+>), Widget, textWidth )+import qualified Brick as B import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Border.Style as B import qualified Brick.Widgets.Skylighting as BS-import qualified Brick as B+import qualified Cheapskate as C import           Cheapskate.Types ( Block                                   , Blocks                                   , Inlines                                   , ListType                                   )-import qualified Cheapskate as C-import qualified Data.Text as T import qualified Data.Foldable as F import           Data.Monoid (First(..)) import           Data.Sequence ( ViewL(..)@@ -40,19 +39,22 @@                                , viewl                                , viewr) import qualified Data.Sequence as S-import qualified Skylighting as Sky 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(..))+import           Network.Mattermost.Lenses ( postEditAtL, postCreateAtL )+import           Network.Mattermost.Types ( ServerTime(..) )+ import           Themes-import           Types (HighlightSet(..), userSigil, normalChannelSigil)+import           Types ( HighlightSet(..), userSigil, normalChannelSigil ) import           Types.Posts import           Types.Messages + emptyHSet :: HighlightSet-emptyHSet = HighlightSet Set.empty Set.empty+emptyHSet = HighlightSet Set.empty Set.empty mempty  omitUsernameTypes :: [MessageType] omitUsernameTypes =@@ -273,9 +275,9 @@ blockToWidget hSet (C.Blockquote is) =     addQuoting (vBox $ fmap (blockToWidget hSet) is) blockToWidget hSet (C.List _ l bs) = blocksToList l bs hSet-blockToWidget _ (C.CodeBlock ci tx) =-      let f = maybe rawCodeBlockToWidget codeBlockToWidget mSyntax-          mSyntax = Sky.lookupSyntax (C.codeLang ci) Sky.defaultSyntaxMap+blockToWidget hSet (C.CodeBlock ci tx) =+      let f = maybe rawCodeBlockToWidget (codeBlockToWidget (hSyntaxMap hSet)) mSyntax+          mSyntax = Sky.lookupSyntax (C.codeLang ci) (hSyntaxMap hSet)       in f tx blockToWidget _ (C.HtmlBlock txt) = textWithCursor txt blockToWidget _ (C.HRule) = B.vLimit 1 (B.fill '*')@@ -296,10 +298,10 @@                           , B.Widget B.Fixed B.Fixed $ return childResult                           ] -codeBlockToWidget :: Sky.Syntax -> Text -> Widget a-codeBlockToWidget syntax tx =+codeBlockToWidget :: Sky.SyntaxMap -> Sky.Syntax -> Text -> Widget a+codeBlockToWidget syntaxMap syntax tx =     let result = Sky.tokenize cfg syntax tx-        cfg = Sky.TokenizerConfig Sky.defaultSyntaxMap False+        cfg = Sky.TokenizerConfig syntaxMap False     in case result of         Left _ -> rawCodeBlockToWidget tx         Right tokLines ->@@ -428,8 +430,7 @@         gatherStrings s n rs =           let s' = removeCursor s           in case viewl rs of-            _ | s' `Set.member` uSet ||-                (userSigil `T.isPrefixOf` s' && (T.drop 1 s' `Set.member` uSet)) ->+            _ | (userSigil `T.isPrefixOf` s' && (T.drop 1 s' `Set.member` uSet)) ->                 buildString s n <| separate hSet rs             _ | (normalChannelSigil `T.isPrefixOf` s' && (T.drop 1 s' `Set.member` cSet)) ->                 buildString s n <| separate hSet rs@@ -447,8 +448,6 @@                     ":" `T.isSuffixOf` s' &&                     textWidth s' > 2 ->                       Fragment (TStr s) Emoji-                  | removeCursor s' `Set.member` uSet ->-                      Fragment (TStr s) (User s)                   | Just uname <- userSigil `T.stripPrefix` removeCursor s                     , removeCursor uname `Set.member` uSet ->                       Fragment (TStr s) (User uname)

@@ -5,13 +5,14 @@ import Prelude () import Prelude.MH -import Data.Version (showVersion)+import Data.Version ( showVersion ) import Development.GitRev-import Network.Mattermost.Version (mmApiVersion)-import Paths_matterhorn (version)+import Network.Mattermost.Version ( mmApiVersion )+import Paths_matterhorn ( version ) import System.Console.GetOpt-import System.Environment (getArgs)-import System.Exit (exitFailure, exitSuccess)+import System.Environment ( getArgs )+import System.Exit ( exitFailure, exitSuccess )+  data Behaviour   = Normal

@@ -56,29 +56,30 @@ , Time.UTCTime , Time.TimeZoneSeries , Time.NominalDiffTime-) where+)+where   #if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup ((<>))+import           Data.Semigroup ( (<>) ) #endif-import qualified Prelude.Compat as P-import           Prelude.Compat-import           Control.Applicative ((<|>))++import           Control.Applicative ( (<|>) ) import qualified Control.Monad as Monad import qualified Control.Monad.IO.Class as Monad import qualified Data.Foldable as Foldable import qualified Data.List as List import qualified Data.Maybe as Maybe+import qualified Data.Time as Time+import qualified Data.Time.LocalTime.TimeZone.Series as Time import qualified GHC.Exts as Exts-import qualified Text.Read as Read import qualified Lens.Micro.Platform as Lens+import           Prelude.Compat+import qualified Prelude.Compat as P+import qualified Text.Read as Read  -- these below we import only for type aliases-import           Data.Text (Text)-import           Data.HashMap.Strict (HashMap)-import           Data.Sequence (Seq)-import           Data.Set (Set)--import qualified Data.Time as Time-import qualified Data.Time.LocalTime.TimeZone.Series as Time+import           Data.HashMap.Strict ( HashMap )+import           Data.Sequence ( Seq )+import           Data.Set ( Set )+import           Data.Text ( Text )

@@ -4,18 +4,20 @@   ) where -import qualified Data.Text as T-import Control.Concurrent (takeMVar, newEmptyMVar)+import           Prelude ()+import           Prelude.MH++import           Control.Concurrent ( takeMVar, newEmptyMVar ) import qualified Control.Concurrent.STM as STM-import System.Exit (ExitCode(..))-import Prelude ()-import Prelude.MH+import qualified Data.Text as T+import           System.Exit ( ExitCode(..) ) -import Types-import State (sendMessage, runLoggedCommand)-import State.Common-import FilePaths (Script(..), getAllScripts, locateScriptPath)+import           FilePaths ( Script(..), getAllScripts, locateScriptPath )+import           State ( sendMessage, runLoggedCommand )+import           State.Common+import           Types + findAndRunScript :: Text -> Text -> MH () findAndRunScript scriptName input = do     fpMb <- liftIO $ locateScriptPath (T.unpack scriptName)@@ -30,10 +32,9 @@              "$ chmod u+x " <> T.pack scriptPath <> "\n" <>              "```\n" <>              "to correct this error. " <> scriptHelpAddendum)-        mhError msg+        mhError $ GenericError msg       ScriptNotFound -> do-        let msg = ("No script named " <> scriptName <> " was found")-        mhError msg+        mhError $ NoSuchScript scriptName  runScript :: STM.TChan ProgramOutput -> FilePath -> Text -> IO (MH ()) runScript outputChan fp text = do@@ -68,7 +69,7 @@                     mconcat [ "  - " <> T.pack cmd <> "\n"                             | cmd <- nonexecs                             ] <> "\n" <> scriptHelpAddendum)-      mhError errMsg+      mhError $ GenericError errMsg  scriptHelpAddendum :: Text scriptHelpAddendum =

@@ -88,7 +88,7 @@   , messageSelectDownBy   , deleteSelectedMessage   , beginReplyCompose-  , beginUpdateMessage+  , beginEditMessage   , getSelectedMessage   , cancelReplyOrEdit   , replyToLatestMessage@@ -110,58 +110,59 @@ import           Prelude () import           Prelude.MH -import           Brick (invalidateCacheEntry)-import           Brick.Themes (themeToAttrMap)-import           Brick.Widgets.Edit (getEditContents, editContentsL)-import           Brick.Widgets.List (list, listMoveTo, listSelectedElement)-import           Control.Concurrent.Async (runConcurrently, Concurrently(..), concurrently)-import           Control.Concurrent (MVar, putMVar, forkIO)+import           Brick ( invalidateCacheEntry )+import           Brick.Main ( getVtyHandle, viewportScroll, vScrollToBeginning, vScrollBy, vScrollToEnd )+import           Brick.Themes ( themeToAttrMap )+import           Brick.Widgets.Edit ( applyEdit )+import           Brick.Widgets.Edit ( getEditContents, editContentsL )+import           Brick.Widgets.List ( list, listMoveTo, listSelectedElement )+import           Control.Concurrent ( MVar, putMVar, forkIO )+import           Control.Concurrent.Async ( runConcurrently, Concurrently(..), concurrently ) import qualified Control.Concurrent.STM as STM-import           Control.Exception (SomeException, try)-import           Data.Char (isAlphaNum)-import           Brick.Main (getVtyHandle, viewportScroll, vScrollToBeginning, vScrollBy, vScrollToEnd)-import           Brick.Widgets.Edit (applyEdit)+import           Control.Exception ( SomeException, try ) import qualified Data.ByteString as BS-import           Data.Function (on)-import           Data.Text.Zipper (textZipper, clearZipper, insertMany, gotoEOL)+import           Data.Char ( isAlphaNum )+import           Data.Function ( on ) import qualified Data.HashMap.Strict as HM+import           Data.List ( findIndex )+import           Data.Maybe ( fromJust ) import qualified Data.Sequence as Seq-import           Data.List (findIndex)-import           Data.Maybe (fromJust) import qualified Data.Set as Set import qualified Data.Text as T-import           Data.Time (getCurrentTime)+import           Data.Text.Zipper ( textZipper, clearZipper, insertMany, gotoEOL )+import           Data.Time ( getCurrentTime ) import qualified Data.Vector as V-import           Graphics.Vty (outputIface)-import           Graphics.Vty.Output.Interface (ringTerminalBell)+import           Graphics.Vty ( outputIface )+import           Graphics.Vty.Output.Interface ( ringTerminalBell ) import           Lens.Micro.Platform-import           System.Exit (ExitCode(..))-import           System.Process (proc, std_in, std_out, std_err, StdStream(..),-                                 createProcess, waitForProcess)-import           System.IO (hGetContents, hFlush, hPutStrLn)-import           System.Directory (createDirectoryIfMissing)-import           System.Environment.XDG.BaseDir (getUserCacheDir)+import           System.Directory ( createDirectoryIfMissing )+import           System.Environment.XDG.BaseDir ( getUserCacheDir )+import           System.Exit ( ExitCode(..) ) import           System.FilePath+import           System.IO ( hGetContents, hFlush, hPutStrLn )+import           System.Process ( proc, std_in, std_out, std_err, StdStream(..)+                                , createProcess, waitForProcess )  import qualified Network.Mattermost.Endpoints as MM-import           Network.Mattermost.Types import           Network.Mattermost.Lenses+import           Network.Mattermost.Types  import           Config+import           Constants import           FilePaths-import           TimeUtils (justBefore, justAfter)-import           Types import           InputHistory+import           Markdown ( blockGetURLs, findVerbatimChunk ) import           Themes-import           Zipper (Zipper)+import           TimeUtils ( justBefore, justAfter )+import           Types+import           Zipper ( Zipper ) import qualified Zipper as Z-import           Constants-import           Markdown (blockGetURLs, findVerbatimChunk)  import           State.Common import           State.Messages-import           State.Setup.Threads (updateUserStatuses)+import           State.Setup.Threads ( updateUserStatuses ) + -- * Refreshing Channel Data  -- | Refresh information about a specific channel.  The channel@@ -206,7 +207,7 @@         findUserIds (n:ns) = do             case userByUsername n st of                 Nothing -> do-                    mhError $ "No such user: " <> n+                    mhError $ NoSuchUser n                     return []                 Just u -> (u^.uiId:) <$> findUserIds ns @@ -424,7 +425,7 @@         let chType = chan^.ccInfo.cdType         if chType /= Direct             then setMode DeleteChannelConfirm-            else mhError "Direct message channels cannot be deleted."+            else mhError $ GenericError "Direct message channels cannot be deleted."  deleteCurrentChannel :: MH () deleteCurrentChannel = do@@ -459,18 +460,37 @@         flagMessage pId (not (msg^.mFlagged))     _        -> return () -beginUpdateMessage :: MH ()-beginUpdateMessage = do+beginEditMessage :: MH ()+beginEditMessage = do     selected <- use (to getSelectedMessage)     st <- use id     case selected of         Just msg | isMine st msg && isEditable msg -> do             let Just p = msg^.mOriginalPost             setMode Main-            csEditState.cedEditMode .= Editing p-            csEditState.cedEditor %= applyEdit (clearZipper >> (insertMany $ postMessage p))+            csEditState.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+            -- can go away one day when there is an actual post type+            -- value of "emote" that we can look at. Note that the+            -- removed formatting needs to be reinstated just prior to+            -- issuing the API call to update the post.+            let toEdit = if msg^.mType == CP Emote+                         then removeEmoteFormatting $ postMessage p+                         else postMessage p+            csEditState.cedEditor %= applyEdit (clearZipper >> (insertMany toEdit))         _ -> return () +removeEmoteFormatting :: T.Text -> T.Text+removeEmoteFormatting t+    | "*" `T.isPrefixOf` t &&+      "*" `T.isSuffixOf` t = T.init $ T.drop 1 t+    | otherwise = t++addEmoteFormatting :: T.Text -> T.Text+addEmoteFormatting t = "*" <> t <> "*"+ replyToLatestMessage :: MH () replyToLatestMessage = do   msgs <- use (csCurrentChannel . ccContents . cdMessages)@@ -519,7 +539,7 @@     doAsyncWith Preempt $ do         result <- try $ MM.mmGetChannelByName tId (trimChannelSigil rawName) session         return $ case result of-            Left (_::SomeException) -> mhError $ T.pack $ "No such channel: " <> (show rawName)+            Left (_::SomeException) -> mhError $ NoSuchChannel rawName             Right chan -> joinChannel $ getId chan  startJoinChannel :: MH ()@@ -546,12 +566,19 @@     setMode JoinChannel     csJoinChannelList .= Nothing +-- | If the user is not a member of the specified channel, submit a+-- request to join it. Otherwise switch to the channel. joinChannel :: ChannelId -> MH () joinChannel chanId = do     setMode Main-    myId <- gets myUserId-    let member = MinChannelMember myId chanId-    doAsyncChannelMM Preempt chanId (\ s _ c -> MM.mmAddUser c member s) endAsyncNOP+    mChan <- preuse (csChannel(chanId))+    case mChan of+        Just _ -> setFocus chanId+        Nothing -> do+            myId <- gets myUserId+            let member = MinChannelMember myId chanId+            csLastJoinRequest .= Just chanId+            doAsyncChannelMM Preempt chanId (\ s _ c -> MM.mmAddUser c member s) endAsyncNOP  -- | When another user adds us to a channel, we need to fetch the -- channel info for that channel.@@ -576,7 +603,7 @@                 tryMM (void $ MM.mmAddUser cId channelMember session)                       (const $ return (return ()))         _ -> do-            mhError ("No such user: " <> uname)+            mhError $ NoSuchUser uname  removeUserFromCurrentChannel :: Text -> MH () removeUserFromCurrentChannel uname = do@@ -590,14 +617,14 @@                 tryMM (void $ MM.mmRemoveUserFromChannel cId (UserById $ u^.uiId) session)                       (const $ return (return ()))         _ -> do-            mhError ("No such user: " <> uname)+            mhError $ NoSuchUser uname  startLeaveCurrentChannel :: MH () startLeaveCurrentChannel = do     cInfo <- use (csCurrentChannel.ccInfo)     case canLeaveChannel cInfo of         True -> setMode LeaveChannelConfirm-        False -> mhError "The /leave command cannot be used with this channel."+        False -> mhError $ GenericError "The /leave command cannot be used with this channel."  leaveCurrentChannel :: MH () leaveCurrentChannel = use csCurrentChannelId >>= leaveChannel@@ -1072,8 +1099,7 @@ changeChannel name = do     result <- gets (channelIdByName name)     user <- gets (userByUsername name)-    let err = mhError $ T.pack $ "The input " <> show name <> " matches both channels " <>-                                 "and users. Try using '@' or '~' to disambiguate."+    let err = mhError $ AmbiguousName name      case result of       (Nothing, Nothing)@@ -1081,7 +1107,7 @@           -- channel, so create one.           | Just _ <- user -> attemptCreateDMChannel name           -- There were no matches of any kind.-          | otherwise -> mhError $ T.pack $ "No such channel: " <> show name+          | otherwise -> mhError $ NoSuchChannel name       (Just cId, Nothing)           -- We matched a channel and there was an explicit sigil, so we           -- don't care about the username match.@@ -1125,9 +1151,7 @@   let myName = if displayNick && not (T.null $ userNickname me)                then userNickname me                else me^.userUsernameL-  if name == myName-    then mhError "Cannot create a DM channel with yourself"-    else do+  when (name /= myName) $ do       let uName = if displayNick                   then                       maybe name (view uiName)@@ -1147,7 +1171,7 @@           member <- MM.mmGetChannelMember (getId nc) UserMe session           return $ handleNewChannel True cwd member       else-        mhError ("No channel or user named " <> name)+        mhError $ NoSuchUser name  createOrdinaryChannel :: Text -> MH () createOrdinaryChannel name  = do@@ -1258,9 +1282,19 @@                 refreshChannelZipper                  -- Finally, set our focus to the newly created channel-                -- if the caller requested a change of channel.-                when switch $ setFocus (getId nc)+                -- if the caller requested a change of channel. Also+                -- consider the last join request state field in case+                -- this is an asynchronous channel addition triggered by+                -- a /join.+                lastReq <- use csLastJoinRequest+                wasLast <- case lastReq of+                    Just cId | cId == getId nc -> do+                        csLastJoinRequest .= Nothing+                        return True+                    _ -> return False +                when (switch || wasLast) $ setFocus (getId nc)+ editMessage :: Post -> MH () editMessage new = do   myId <- gets myUserId@@ -1289,6 +1323,34 @@   cId <- use csCurrentChannelId   when (postChannelId new == cId) updateViewed +maybePostUsername :: ChatState -> Post -> T.Text+maybePostUsername st p =+    fromMaybe T.empty $ do+    uId <- postUserId p+    usernameForUserId uId st++runNotifyCommand :: Post -> Bool -> MH ()+runNotifyCommand post mentioned = do+    outputChan <- use (csResources.crSubprocessLog)+    st <- use id+    notifyCommand <- use (csResources.crConfiguration.to configActivityNotifyCommand)+    case notifyCommand of+        Nothing -> return ()+        Just cmd ->+            doAsyncWith Preempt $ do+                let messageString = T.unpack $ postMessage post+                    notified = if mentioned then "1" else "2"+                    sender = T.unpack $ maybePostUsername st post+                runLoggedCommand False outputChan (T.unpack cmd)+                                 [notified, sender, messageString] Nothing Nothing+                return $ return ()++maybeNotify :: PostToAdd -> MH ()+maybeNotify (OldPost _) = do+    return ()+maybeNotify (RecentPost post mentioned) = runNotifyCommand post mentioned++ maybeRingBell :: MH () maybeRingBell = do     doBell <- use (csResources.crConfiguration.to configActivityBell)@@ -1302,28 +1364,33 @@ -- viewed).  This is a monoid so that it can be folded over when there -- are multiple inbound posts to be processed. data PostProcessMessageAdd = NoAction-                           | NotifyUser+                           | NotifyUser [PostToAdd]                            | UpdateServerViewed-                           | NotifyUserAndServer+                           | NotifyUserAndServer [PostToAdd]  andProcessWith   :: PostProcessMessageAdd -> PostProcessMessageAdd -> PostProcessMessageAdd-andProcessWith NotifyUserAndServer _         = NotifyUserAndServer-andProcessWith _ NotifyUserAndServer         = NotifyUserAndServer-andProcessWith NotifyUser UpdateServerViewed = NotifyUserAndServer-andProcessWith UpdateServerViewed NotifyUser = NotifyUserAndServer-andProcessWith x NoAction                    = x-andProcessWith _ x                           = x+andProcessWith NoAction x                                        = x+andProcessWith x NoAction                                        = x+andProcessWith (NotifyUserAndServer p) UpdateServerViewed        = NotifyUserAndServer p+andProcessWith (NotifyUserAndServer p1) (NotifyUser p2)          = NotifyUserAndServer (p1 <> p2)+andProcessWith (NotifyUserAndServer p1) (NotifyUserAndServer p2) = NotifyUserAndServer (p1 <> p2)+andProcessWith (NotifyUser p1) (NotifyUserAndServer p2)          = NotifyUser (p1 <> p2)+andProcessWith (NotifyUser p1) (NotifyUser p2)                   = NotifyUser (p1 <> p2)+andProcessWith (NotifyUser p) UpdateServerViewed                 = NotifyUserAndServer p+andProcessWith UpdateServerViewed UpdateServerViewed             = UpdateServerViewed+andProcessWith UpdateServerViewed (NotifyUserAndServer p)        = NotifyUserAndServer p+andProcessWith UpdateServerViewed (NotifyUser p)                 = NotifyUserAndServer p  -- | postProcessMessageAdd performs the actual actions indicated by -- the corresponding input value. postProcessMessageAdd :: PostProcessMessageAdd -> MH () postProcessMessageAdd ppma = postOp ppma  where-   postOp NoAction            = return ()-   postOp UpdateServerViewed  = updateViewed-   postOp NotifyUser          = maybeRingBell-   postOp NotifyUserAndServer = updateViewed >> maybeRingBell+   postOp NoAction                = return ()+   postOp UpdateServerViewed      = updateViewed+   postOp (NotifyUser p)          = maybeRingBell >> mapM_ maybeNotify p+   postOp (NotifyUserAndServer p) = updateViewed >> maybeRingBell >> mapM_ maybeNotify p  -- | When we add posts to the application state, we either get them -- from the server during scrollback fetches (here called 'OldPost') or@@ -1454,9 +1521,9 @@                         originUserAction =                           if | fromMe                            -> NoAction                              | ignoredJoinLeaveMessage           -> NoAction-                             | notifyPref == NotifyOptionAll     -> NotifyUser+                             | notifyPref == NotifyOptionAll     -> NotifyUser [newPostData]                              | notifyPref == NotifyOptionMention-                                 && wasMentioned                 -> NotifyUser+                                 && wasMentioned                 -> NotifyUser [newPostData]                              | otherwise                         -> NoAction                      return $ curChannelAction `andProcessWith` originUserAction@@ -1783,7 +1850,7 @@         Just (_, link) -> do             opened <- openURL link             when (not opened) $ do-                mhError "Config option 'urlOpenCommand' missing; cannot open URL."+                mhError $ ConfigOptionMissing "urlOpenCommand"                 setMode Main  openURL :: LinkChoice -> MH Bool@@ -1927,7 +1994,7 @@         case openedAll of             True -> setMode Main             False ->-                mhError "Config option 'urlOpenCommand' missing; cannot open URL."+                mhError $ ConfigOptionMissing "urlOpenCommand"  shouldSkipMessage :: Text -> Bool shouldSkipMessage "" = True@@ -1943,7 +2010,7 @@             case status of                 Disconnected -> do                     let m = "Cannot send messages while disconnected."-                    mhError m+                    mhError $ GenericError m                 Connected -> do                     let chanId = st^.csCurrentChannelId                     session <- getSession@@ -1955,8 +2022,11 @@                         Replying _ p -> do                             let pendingPost = (rawPost msg chanId) { rawPostRootId = postRootId p <|> (Just $ postId p) }                             void $ MM.mmCreatePost pendingPost session-                        Editing p -> do-                            void $ MM.mmUpdatePost (postId p) (postUpdate msg) session+                        Editing p ty -> do+                            let body = if ty == CP Emote+                                       then addEmoteFormatting msg+                                       else msg+                            void $ MM.mmPatchPost (postId p) (postUpdateBody body) session  handleNewUserDirect :: User -> MH () handleNewUserDirect newUser = do

@@ -4,23 +4,23 @@ import           Prelude.MH  import qualified Control.Concurrent.STM as STM-import           Control.Exception (try)+import           Control.Exception ( try ) import qualified Data.Foldable as F import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as Map import qualified Data.Sequence as Seq import qualified Data.Set as Set import qualified Data.Text as T-import           Lens.Micro.Platform ((%=), (%~), (.~), traversed)-import           System.Hclip (setClipboard, ClipboardException(..))+import           Lens.Micro.Platform ( (%=), (%~), (.~), traversed )+import           System.Hclip ( setClipboard, ClipboardException(..) )  import           Network.Mattermost.Endpoints-import           Network.Mattermost.Types import           Network.Mattermost.Lenses-import           Network.Mattermost.Exceptions+import           Network.Mattermost.Types  import           Types + -- * Mattermost API  -- | Try to run a computation, posting an informative error@@ -33,8 +33,7 @@ tryMM act onSuccess = do     result <- liftIO $ try act     case result of-        Left (MattermostError { mattermostErrorMessage = msg }) ->-          return $ mhError msg+        Left e -> return $ mhError $ ServerError e         Right value -> liftIO $ onSuccess value  -- * Background Computation@@ -235,9 +234,8 @@ postErrorMessage' err = addClientMessage =<< newClientMessage Error err  -- | Raise a rich error-mhError :: Text -> MH ()-mhError err = do-  raiseInternalEvent (DisplayError err)+mhError :: MHError -> MH ()+mhError err = raiseInternalEvent (DisplayError err)  postErrorMessageIO :: Text -> ChatState -> IO ChatState postErrorMessageIO err st = do@@ -283,6 +281,6 @@             MissingCommands cmds ->               "Could not set clipboard due to missing one of the " <>               "required program(s): " <> (T.pack $ show cmds)-      mhError errMsg+      mhError $ ClipboardError errMsg     Right () ->       return ()

@@ -1,13 +1,13 @@ {-# LANGUAGE MultiWayIf #-}-{-#LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards #-}  module State.Editing where  import           Prelude () import           Prelude.MH -import           Brick.Widgets.Edit (Editor, handleEditorEvent, getEditContents, editContentsL)-import           Brick.Widgets.Edit (applyEdit)+import           Brick.Widgets.Edit ( Editor, applyEdit , handleEditorEvent+                                    , getEditContents, editContentsL ) import qualified Codec.Binary.UTF8.Generic as UTF8 import           Control.Arrow import qualified Control.Concurrent.STM as STM@@ -17,23 +17,23 @@ import qualified Data.Text.Encoding as T import qualified Data.Text.Zipper as Z import qualified Data.Text.Zipper.Generic.Words as Z-import           Data.Time (getCurrentTime)-import           Graphics.Vty (Event(..), Key(..), Modifier(..))-import           Lens.Micro.Platform ((%=), (.=), (.~), to)+import           Data.Time ( getCurrentTime )+import           Graphics.Vty ( Event(..), Key(..), Modifier(..) )+import           Lens.Micro.Platform ( (%=), (.=), (.~), to ) import qualified System.Environment as Sys import qualified System.Exit as Sys import qualified System.IO as Sys import qualified System.IO.Temp as Sys import qualified System.Process as Sys-import           Text.Aspell (AspellResponse(..), mistakeWord, askAspell)+import           Text.Aspell ( AspellResponse(..), mistakeWord, askAspell ) +import           Network.Mattermost.Types (Post(..))+ import           Config-import           Types import           Events.Keybindings- import           State.Common+import           Types -import           Network.Mattermost.Types (Post(..))  startMultilineEditing :: MH () startMultilineEditing = csEditState.cedMultiline .= True

@@ -4,21 +4,23 @@     , updateMessageFlag     , lastMsg     )-    where+where +import           Prelude ()+import           Prelude.MH -import           Data.Function (on)+import           Data.Function ( on ) import qualified Data.Set as Set import qualified Data.Text as T-import           Lens.Micro.Platform ((.=), (%=), (%~), (.~), to, at,-                                     traversed, filtered, ix)+import           Lens.Micro.Platform ( (.=), (%=), (%~), (.~), to, at+                                     , traversed, filtered, ix )+ import           Network.Mattermost import           Network.Mattermost.Types+ import           State.Common import           TimeUtils import           Types-import           Prelude ()-import           Prelude.MH   -- ----------------------------------------------------------------------

@@ -1,16 +1,18 @@ module State.PostListOverlay where +import           Prelude ()+import           Prelude.MH+ import qualified Data.Text as T-import Lens.Micro.Platform ((.=))-import Network.Mattermost.Endpoints-import Network.Mattermost.Types-import Prelude ()-import Prelude.MH+import           Lens.Micro.Platform ( (.=) )+import           Network.Mattermost.Endpoints+import           Network.Mattermost.Types -import State-import State.Common-import Types-import Types.DirectionalSeq (emptyDirSeq)+import           State+import           State.Common+import           Types+import           Types.DirectionalSeq (emptyDirSeq)+  -- | Create a PostListOverlay with the given content description and -- with a specified list of messages.

@@ -8,35 +8,36 @@ import           Prelude.MH  import           Brick.BChan-import           Brick.Themes (themeToAttrMap, loadCustomizations)+import           Brick.Themes ( themeToAttrMap, loadCustomizations )+import           Control.Concurrent.MVar ( newMVar ) import qualified Control.Concurrent.STM as STM-import           Control.Concurrent.MVar (newMVar)-import           Control.Exception (catch)-import           Data.Maybe (fromJust)+import           Control.Exception ( catch )+import           Data.Maybe ( fromJust ) import qualified Data.Sequence as Seq import qualified Data.Text as T-import           Lens.Micro.Platform ((%~))-import           System.Exit (exitFailure)-import           System.FilePath ((</>), isRelative, dropFileName)-import           System.IO (Handle)-import           System.IO.Error (catchIOError)+import           Lens.Micro.Platform ( (%~) )+import           System.Exit ( exitFailure )+import           System.FilePath ( (</>), isRelative, dropFileName )+import           System.IO ( Handle )+import           System.IO.Error ( catchIOError )  import           Network.Mattermost.Endpoints+import           Network.Mattermost.Logging ( mmLoggerDebug ) import           Network.Mattermost.Types-import           Network.Mattermost.Logging (mmLoggerDebug)  import           Config import           InputHistory-import           Login import           LastRunState+import           Login import           State.Messages+import           State.Setup.Threads import           TeamSelect import           Themes-import           TimeUtils (lookupLocalTimeZone)-import           State.Setup.Threads+import           TimeUtils ( lookupLocalTimeZone ) import           Types import qualified Zipper as Z + incompleteCredentials :: Config -> ConnectionInfo incompleteCredentials config = ConnectionInfo hStr (configPort config) uStr pStr     where@@ -162,7 +163,7 @@    let cr = ChatResources session cd requestChan eventChan              slc wac (themeToAttrMap custTheme) userStatusLock-             userIdSet config mempty userPrefs+             userIdSet config mempty userPrefs mempty    initializeState cr myTeam me @@ -210,6 +211,9 @@   --------------------------------------------------------------------   -- Start background worker threads:   --+  -- * Syntax definition loader+  startSyntaxMapLoaderThread (cr^.crConfiguration) (cr^.crEventQueue)+   -- * Main async queue worker thread   startAsyncWorkerThread (cr^.crConfiguration) (cr^.crRequestQueue) (cr^.crEventQueue) 

@@ -6,6 +6,7 @@   , startTimezoneMonitorThread   , maybeStartSpellChecker   , startAsyncWorkerThread+  , startSyntaxMapLoaderThread   ) where @@ -13,30 +14,32 @@ import           Prelude.MH  import           Brick.BChan-import           Control.Concurrent (threadDelay, forkIO, MVar, putMVar, tryTakeMVar)+import           Control.Concurrent ( threadDelay, forkIO, MVar, putMVar, tryTakeMVar ) import qualified Control.Concurrent.STM as STM import           Control.Concurrent.STM.Delay-import           Control.Exception (SomeException, try, finally, fromException)-import           Data.List (isInfixOf)+import           Control.Exception ( SomeException, try, finally, fromException ) import qualified Data.Foldable as F+import qualified Data.Map as M import qualified Data.Text as T-import           Data.Time (getCurrentTime, addUTCTime)-import           Lens.Micro.Platform ((.=), (%=), (%~), mapped)-import           System.Exit (ExitCode(ExitSuccess))-import           System.IO (hPutStrLn, hFlush)-import           System.IO.Temp (openTempFile)-import           System.Directory (getTemporaryDirectory)-import           Text.Aspell (Aspell, AspellOption(..), startAspell)+import           Data.Time ( getCurrentTime, addUTCTime )+import           Lens.Micro.Platform ( (.=), (%=), (%~), mapped )+import           Skylighting.Loader ( loadSyntaxesFromDir )+import           System.Directory ( getTemporaryDirectory )+import           System.Exit ( ExitCode(ExitSuccess) )+import           System.IO ( hPutStrLn, hFlush )+import           System.IO.Temp ( openTempFile )+import           Text.Aspell ( Aspell, AspellOption(..), startAspell )  import           Network.Mattermost.Endpoints import           Network.Mattermost.Types  import           Constants import           State.Common-import           State.Editing (requestSpellCheck)-import           TimeUtils (lookupLocalTimeZone)+import           State.Editing ( requestSpellCheck )+import           TimeUtils ( lookupLocalTimeZone ) import           Types + updateUserStatuses :: STM.TVar (Seq UserId) -> MVar () -> Session -> IO (MH ()) updateUserStatuses usersVar lock session = do   lockResult <- tryTakeMVar lock@@ -113,11 +116,7 @@                   hFlush logHandle                    STM.atomically $ STM.writeTChan requestChan $ do-                      return $ do-                          let msg = T.pack $-                                "An error occurred when running " <> show progName <>-                                "; see " <> logPath <> " for details."-                          mhError msg+                      return $ mhError $ ProgramExecutionFailed (T.pack progName) (T.pack logPath)                    logMonitor (Just (logPath, logHandle)) @@ -230,6 +229,24 @@    return delayWakeupChan +startSyntaxMapLoaderThread :: Config -> BChan MHEvent -> IO ()+startSyntaxMapLoaderThread config eventChan = void $ forkIO $ do+    -- Iterate over the configured syntax directories, loading syntax+    -- maps. Ensure that entries loaded in earlier directories in the+    -- sequence take precedence over entries loaded later.+    mMaps <- forM (configSyntaxDirs config) $ \dir -> do+        result <- try $ loadSyntaxesFromDir dir+        case result of+            Left (_::SomeException) -> return Nothing+            Right (Left _)          -> return Nothing+            Right (Right m)         -> return $ Just m++    let maps = catMaybes mMaps+        finalMap = foldl M.union mempty maps++    writeBChan eventChan $ RespEvent $ do+        csResources.crSyntaxMap .= finalMap+ ------------------------------------------------------------------- -- Async worker thread @@ -266,16 +283,10 @@     startWork     res <- try req     case res of-      Left e ->-          when (not $ shouldIgnore e) $-              case fromException e of-                  Nothing -> writeBChan eventChan (AsyncErrEvent e)-                  Just mmErr -> writeBChan eventChan (AsyncMattermostError mmErr)+      Left e -> do+          let err = case fromException e of+                Nothing -> AsyncErrEvent e+                Just mmErr -> ServerError mmErr+          writeBChan eventChan $ IEvent $ DisplayError err       Right upd ->           writeBChan eventChan (RespEvent upd)---- Filter for exceptions that we don't want to report to the user,--- probably because they are not actionable and/or contain no useful--- information.-shouldIgnore :: SomeException -> Bool-shouldIgnore e = "resource vanished" `isInfixOf` show e

@@ -15,25 +15,27 @@   ) where -import qualified Data.Vector as Vec-import qualified Data.Foldable as F-import qualified Data.Text as T-import qualified Data.Sequence as Seq-import qualified Data.HashMap.Strict as HM-import Lens.Micro.Platform ((.=), (%=), (.~), to)-import qualified Network.Mattermost.Endpoints as MM-import Network.Mattermost.Types-import qualified Data.Text.Zipper as Z import           Prelude () import           Prelude.MH -import qualified Brick.Widgets.List as L import qualified Brick.Widgets.Edit as E+import qualified Brick.Widgets.List as L+import qualified Data.Foldable as F+import qualified Data.HashMap.Strict as HM+import qualified Data.Sequence as Seq+import qualified Data.Text as T+import qualified Data.Text.Zipper as Z+import qualified Data.Vector as Vec+import           Lens.Micro.Platform ( (.=), (%=), (.~), to ) -import Types-import State.Common-import State (changeChannel, addUserToCurrentChannel)+import qualified Network.Mattermost.Endpoints as MM+import           Network.Mattermost.Types +import           State ( changeChannel, addUserToCurrentChannel )+import           State.Common+import           Types++ -- | Show the user list overlay for searching/showing members of the -- current channel. enterChannelMembersUserList :: MH ()@@ -89,7 +91,6 @@ enterUserListMode :: UserSearchScope -> (UserInfo -> MH Bool) -> MH () enterUserListMode scope enterHandler = do   csUserListOverlay.userListSearchScope .= scope-  csUserListOverlay.userListSelected .= Nothing   csUserListOverlay.userListSearchInput.E.editContentsL %= Z.clearZipper   csUserListOverlay.userListEnterHandler .= enterHandler   csUserListOverlay.userListSearching .= False@@ -135,7 +136,6 @@ exitUserListMode :: MH () exitUserListMode = do   csUserListOverlay.userListSearchResults .= listFromUserSearchResults mempty-  csUserListOverlay.userListSelected .= Nothing   csUserListOverlay.userListEnterHandler .= (const $ return False)   setMode Main 

@@ -1,21 +1,23 @@ module TeamSelect   ( interactiveTeamSelection-  ) where+  )+where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH -import Brick-import Brick.Widgets.List-import Brick.Widgets.Center-import Brick.Widgets.Border+import           Brick+import           Brick.Widgets.Border+import           Brick.Widgets.Center+import           Brick.Widgets.List import qualified Data.Vector as V-import Graphics.Vty-import System.Exit (exitSuccess)+import           Graphics.Vty+import           System.Exit ( exitSuccess ) -import Network.Mattermost.Types+import           Network.Mattermost.Types -import Markdown+import           Markdown+  type State = List () Team 

@@ -47,23 +47,26 @@    -- * Username formatting   , colorUsername-  ) where+  )+where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH +import           Brick+import           Brick.Themes+import           Brick.Widgets.List+import           Brick.Widgets.Skylighting ( attrNameForTokenType+                                           , attrMappingsForStyle+                                           , highlightedCodeBlockAttr+                                           )+import           Data.Hashable ( hash ) import qualified Data.Map as M-import Data.Hashable (hash)-import Graphics.Vty-import Brick-import Brick.Themes-import Brick.Widgets.List-import Brick.Widgets.Skylighting ( attrNameForTokenType, attrMappingsForStyle-                                 , highlightedCodeBlockAttr-                                 ) import qualified Data.Text as T-import qualified Skylighting as Sky-import Skylighting (TokenType(..))+import           Graphics.Vty+import qualified Skylighting.Styles as Sky+import           Skylighting.Types ( TokenType(..) )+  helpAttr :: AttrName helpAttr = "help"

@@ -6,19 +6,21 @@     , localTimeText     , originTime     )-    where+where +import           Prelude ()+import           Prelude.MH+ import qualified Data.Text as T-import           Data.Time.Clock (UTCTime(..))-import           Data.Time.Format (formatTime, defaultTimeLocale)-import           Data.Time.LocalTime (LocalTime(..), TimeOfDay(..))-import           Data.Time.LocalTime.TimeZone.Olson (getTimeZoneSeriesFromOlsonFile)+import           Data.Time.Clock ( UTCTime(..) )+import           Data.Time.Format ( formatTime, defaultTimeLocale )+import           Data.Time.LocalTime ( LocalTime(..), TimeOfDay(..) )+import           Data.Time.LocalTime.TimeZone.Olson ( getTimeZoneSeriesFromOlsonFile ) import           Data.Time.LocalTime.TimeZone.Series ( localTimeToUTC'                                                      , utcToLocalTime')-import           Network.Mattermost.Types (ServerTime(..)) -import           Prelude ()-import           Prelude.MH+import           Network.Mattermost.Types ( ServerTime(..) )+   -- | Get the timezone series that should be used for converting UTC

@@ -4,6 +4,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-} module Types   ( ConnectionStatus(..)   , HelpTopic(..)@@ -15,6 +16,7 @@   , ChannelSelectMatch(..)   , MatchValue(..)   , StartupStateInfo(..)+  , MHError(..)   , ConnectionInfo(..)   , ciHostname   , ciPort@@ -37,7 +39,6 @@   , refreshChannelZipper   , getChannelIdsInOrder -  , trimUserSigil   , trimChannelSigil    , LinkChoice(LinkChoice)@@ -76,6 +77,7 @@   , csChannelSelectState   , csEditState   , csClientConfig+  , csLastJoinRequest   , timeZone   , whenMode   , setMode@@ -102,7 +104,6 @@   , UserSearchScope(..)    , UserListOverlayState-  , userListSelected   , userListSearchResults   , userListSearchInput   , userListSearchScope@@ -125,6 +126,7 @@   , crFlaggedPosts   , crConn   , crConfiguration+  , crSyntaxMap   , getSession   , getResourceSession @@ -185,7 +187,6 @@   , displaynameForUserId   , raiseInternalEvent -  , userSigil   , normalChannelSigil    , HighlightSet(..)@@ -203,48 +204,49 @@ import           Prelude () import           Prelude.MH -import           Brick (EventM, Next) import qualified Brick+import           Brick ( EventM, Next )+import           Brick.AttrMap ( AttrMap ) import           Brick.BChan-import           Brick.AttrMap (AttrMap)-import           Brick.Widgets.Edit (Editor, editor)-import           Brick.Widgets.List (List, list)+import           Brick.Widgets.Edit ( Editor, editor )+import           Brick.Widgets.List ( List, list )+import           Control.Concurrent.MVar ( MVar ) import qualified Control.Concurrent.STM as STM-import           Control.Concurrent.MVar (MVar)-import           Control.Exception (SomeException)+import           Control.Exception ( SomeException ) import qualified Control.Monad.State as St import qualified Data.Foldable as F-import qualified Data.Sequence as Seq-import qualified Data.Vector as Vec import qualified Data.HashMap.Strict as HM-import           Data.List (partition, sortBy)+import           Data.List ( partition, sortBy )+import qualified Data.Sequence as Seq import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Vector as Vec import           Lens.Micro.Platform ( at, makeLenses, lens, (%~), (^?!), (.=)                                      , (%=), (^?), (.~)                                      , _Just, Traversal', preuse, (^..), folded, to, view )-import           Network.Mattermost (ConnectionData)+import           Network.Connection ( HostNotResolved, HostCannotConnect )+import           Skylighting.Types ( SyntaxMap )+import           System.Exit ( ExitCode )+import           Text.Aspell ( Aspell )++import           Network.Mattermost ( ConnectionData ) import           Network.Mattermost.Exceptions import           Network.Mattermost.Lenses import           Network.Mattermost.Types import           Network.Mattermost.Types.Config-import           Network.Mattermost.WebSocket (WebsocketEvent)-import           Network.Connection (HostNotResolved, HostCannotConnect)-import qualified Data.Text as T-import           System.Exit (ExitCode)-import           Text.Aspell (Aspell)--import           Zipper (Zipper, focusL, updateList)+import           Network.Mattermost.WebSocket ( WebsocketEvent ) +import           Completion ( Completer ) import           InputHistory- import           Types.Channels-import           Types.DirectionalSeq(emptyDirSeq)+import           Types.DirectionalSeq ( emptyDirSeq ) import           Types.KeyEvents-import           Types.Posts import           Types.Messages+import           Types.Posts import           Types.Users-import           Completion (Completer)+import           Zipper ( Zipper, focusL, updateList ) + -- * Configuration  -- | A user password is either given to us directly, or a command@@ -254,68 +256,113 @@     | PasswordCommand Text     deriving (Eq, Read, Show) --- | These are all the values that can be read in our configuration--- file.-data Config = Config-  { configUser                      :: Maybe Text-  , configHost                      :: Maybe Text-  , configTeam                      :: Maybe Text-  , configPort                      :: Int-  , configPass                      :: Maybe PasswordSource-  , configTimeFormat                :: Maybe Text-  , configDateFormat                :: Maybe Text-  , configTheme                     :: Maybe Text-  , configThemeCustomizationFile    :: Maybe Text-  , configSmartBacktick             :: Bool-  , configURLOpenCommand            :: Maybe Text-  , configURLOpenCommandInteractive :: Bool-  , configActivityBell              :: Bool-  , configShowBackground            :: BackgroundInfo-  , configShowMessagePreview        :: Bool-  , configEnableAspell              :: Bool-  , configAspellDictionary          :: Maybe Text-  , configUnsafeUseHTTP             :: Bool-  , configChannelListWidth          :: Int-  , configShowOlderEdits            :: Bool-  , configShowTypingIndicator       :: Bool-  , configAbsPath                   :: Maybe FilePath-  , configUserKeys                  :: KeyConfig-  , configHyperlinkingMode          :: Bool-  } deriving (Eq, Show)+-- | This is how we represent the user's configuration. Most fields+-- correspond to configuration file settings (see Config.hs) but some+-- are for internal book-keeping purposes only.+data Config =+    Config { configUser :: Maybe Text+           -- ^ The username to use when connecting.+           , configHost :: Maybe Text+           -- ^ The hostname to use when connecting.+           , configTeam :: Maybe Text+           -- ^ The team name to use when connecting.+           , configPort :: Int+           -- ^ The port to use when connecting.+           , configPass :: Maybe PasswordSource+           -- ^ The password source to use when connecting.+           , configTimeFormat :: Maybe Text+           -- ^ The format string for timestamps.+           , configDateFormat :: Maybe Text+           -- ^ The format string for dates.+           , configTheme :: Maybe Text+           -- ^ The name of the theme to use.+           , configThemeCustomizationFile :: Maybe Text+           -- ^ The path to the theme customization file, if any.+           , configSmartBacktick :: Bool+           -- ^ Whether to enable smart quoting characters.+           , configURLOpenCommand :: Maybe Text+           -- ^ The command to use to open URLs.+           , configURLOpenCommandInteractive :: Bool+           -- ^ Whether the URL-opening command is interactive (i.e.+           -- whether it should be given control of the terminal).+           , configActivityNotifyCommand :: Maybe T.Text+           -- ^ The command to run for activity notifications.+           , configActivityBell :: Bool+           -- ^ Whether to ring the terminal bell on activity.+           , configShowBackground :: BackgroundInfo+           -- ^ Whether to show async background worker thread info.+           , configShowMessagePreview :: Bool+           -- ^ Whether to show the message preview area.+           , configEnableAspell :: Bool+           -- ^ Whether to enable Aspell spell checking.+           , configAspellDictionary :: Maybe Text+           -- ^ A specific Aspell dictionary name to use.+           , configUnsafeUseHTTP :: Bool+           -- ^ Whether to permit an insecure HTTP connection.+           , configChannelListWidth :: Int+           -- ^ The width, in columns, of the channel list sidebar.+           , configShowOlderEdits :: Bool+           -- ^ Whether to highlight the edit indicator on edits made+           -- prior to the beginning of the current session.+           , configShowTypingIndicator :: Bool+           -- ^ Whether to show the typing indicator for other users,+           -- and whether to send typing notifications to other users.+           , configAbsPath :: Maybe FilePath+           -- ^ A book-keeping field for the absolute path to the+           -- configuration. (Not a user setting.)+           , configUserKeys :: KeyConfig+           -- ^ The user's keybinding configuration.+           , configHyperlinkingMode :: Bool+           -- ^ Whether to enable terminal hyperlinking mode.+           , configSyntaxDirs :: [FilePath]+           -- ^ The search path for syntax description XML files.+           } deriving (Eq, Show) -data BackgroundInfo = Disabled | Active | ActiveCount deriving (Eq, Show)+-- | The state of the UI diagnostic indicator for the async worker+-- thread.+data BackgroundInfo =+    Disabled+    -- ^ Disable (do not show) the indicator.+    | Active+    -- ^ Show the indicator when the thread is working.+    | ActiveCount+    -- ^ Show the indicator when the thread is working, but include the+    -- thread's work queue length.+    deriving (Eq, Show)  -- * 'MMNames' structures --- | The 'MMNames' record is for listing human-readable---   names and mapping them back to internal IDs.-data MMNames = MMNames-  { _cnChans    :: [Text] -- ^ All channel names-  , _channelNameToChanId :: HashMap Text ChannelId-  -- ^ Mapping from channel names to 'ChannelId' values-  , _usernameToChanId :: HashMap Text ChannelId-  -- ^ Mapping from user names to 'ChannelId' values. Only contains-  -- entries for which DM channel IDs are known.-  , _cnUsers    :: [Text] -- ^ All users-  , _cnToUserId :: HashMap Text UserId-      -- ^ Mapping from user names to 'UserId' values-  }+-- | The 'MMNames' record is for listing human-readable names and+-- mapping them back to internal IDs.+data MMNames =+    MMNames { _cnChans :: [Text] -- ^ All channel names+            , _channelNameToChanId :: HashMap Text ChannelId+            -- ^ Mapping from channel names to 'ChannelId' values+            , _usernameToChanId :: HashMap Text ChannelId+            -- ^ Mapping from user names to 'ChannelId' values. Only+            -- contains entries for which DM channel IDs are known.+            , _cnUsers :: [Text] -- ^ All users+            , _cnToUserId :: HashMap Text UserId+            -- ^ Mapping from user names to 'UserId' values+            } +-- | MMNames constructor, seeded with an initial mapping of user ID to+-- user and channel metadata. mkNames :: User -> HashMap UserId User -> Seq Channel -> MMNames-mkNames myUser users chans = MMNames-  { _cnChans = sort-               [ preferredChannelName c-               | c <- toList chans, channelType c /= Direct ]-  , _channelNameToChanId = HM.fromList [ (preferredChannelName c, channelId c) | c <- toList chans ]-  , _usernameToChanId = HM.fromList $-                  [ (userUsername u, c)-                  | u <- HM.elems users-                  , c <- lookupChan (getDMChannelName (getId myUser) (getId u))-                  ]-  , _cnUsers = sort (map userUsername (HM.elems users))-  , _cnToUserId = HM.fromList-                  [ (userUsername u, getId u) | u <- HM.elems users ]-  }+mkNames myUser users chans =+    MMNames { _cnChans = sort+                         [ preferredChannelName c+                         | c <- toList chans, channelType c /= Direct ]+            , _channelNameToChanId = HM.fromList [ (preferredChannelName c, channelId c) | c <- toList chans ]+            , _usernameToChanId = HM.fromList $+                            [ (userUsername u, c)+                            | u <- HM.elems users+                            , c <- lookupChan (getDMChannelName (getId myUser) (getId u))+                            ]+            , _cnUsers = sort (map userUsername (HM.elems users))+            , _cnToUserId = HM.fromList+                            [ (userUsername u, getId u) | u <- HM.elems users ]+            }   where lookupChan n = [ c^.channelIdL                        | c <- toList chans, c^.channelNameL == n                        ]@@ -328,38 +375,40 @@  mkChannelZipperList :: MMNames -> [ChannelId] mkChannelZipperList chanNames =-  getChannelIdsInOrder chanNames ++-  getDMChannelIdsInOrder chanNames+    getChannelIdsInOrder chanNames +++    getDMChannelIdsInOrder chanNames  getChannelIdsInOrder :: MMNames -> [ChannelId] getChannelIdsInOrder n = [ (n ^. channelNameToChanId) HM.! i | i <- n ^. cnChans ]  getDMChannelIdsInOrder :: MMNames -> [ChannelId] getDMChannelIdsInOrder n =-  [ c | i <- n ^. cnUsers-      , c <- maybeToList (HM.lookup i (n ^. usernameToChanId))-  ]+    [ c | i <- n ^. cnUsers+    , c <- maybeToList (HM.lookup i (n ^. usernameToChanId))+    ]  -- * Internal Names and References --- | This 'Name' type is the value used in `brick` to identify the--- currently focused widget or state.-data Name = ChannelMessages ChannelId-          | MessageInput-          | ChannelList-          | HelpViewport-          | HelpText-          | ScriptHelpText-          | ThemeHelpText-          | KeybindingHelpText-          | ChannelSelectString-          | CompletionAlternatives-          | JoinChannelList-          | UrlList-          | MessagePreviewViewport-          | UserListSearchInput-          | UserListSearchResults-          deriving (Eq, Show, Ord)+-- | This 'Name' type is the type used in 'brick' to identify various+-- parts of the interface.+data Name =+    ChannelMessages ChannelId+    | MessageInput+    | ChannelList+    | HelpViewport+    | HelpText+    | ScriptHelpText+    | ThemeHelpText+    | SyntaxHighlightHelpText+    | KeybindingHelpText+    | ChannelSelectString+    | CompletionAlternatives+    | JoinChannelList+    | UrlList+    | MessagePreviewViewport+    | UserListSearchInput+    | UserListSearchResults+    deriving (Eq, Show, Ord)  -- | The sum type of exceptions we expect to encounter on authentication -- failure. We encode them explicitly here so that we can print them in@@ -373,7 +422,9 @@     deriving (Show)  -- | Our 'ConnectionInfo' contains exactly as much information as is--- necessary to start a connection with a Mattermost server+-- necessary to start a connection with a Mattermost server. This is+-- built up during interactive authentication and then is used to log+-- in. data ConnectionInfo =     ConnectionInfo { _ciHostname :: Text                    , _ciPort     :: Int@@ -383,24 +434,23 @@  makeLenses ''ConnectionInfo --- | We want to continue referring to posts by their IDs, but we don't want to--- have to synthesize new valid IDs for messages from the client--- itself (like error messages or informative client responses). To--- that end, a PostRef can be either a PostId or a newly-generated--- client ID+-- | We want to continue referring to posts by their IDs, but we don't+-- want to have to synthesize new valid IDs for messages from the client+-- itself (like error messages or informative client responses). To that+-- end, a PostRef can be either a PostId or a newly-generated client ID. data PostRef-  = MMId PostId-  | CLId Int+    = MMId PostId+    | CLId Int     deriving (Eq, Show) --- | For representing links to things in the 'open links' view-data LinkChoice = LinkChoice-  { _linkTime   :: ServerTime-  , _linkUser   :: UserRef-  , _linkName   :: Text-  , _linkURL    :: Text-  , _linkFileId :: Maybe FileId-  } deriving (Eq, Show)+-- | This type represents links to things in the 'open links' view.+data LinkChoice =+    LinkChoice { _linkTime   :: ServerTime+               , _linkUser   :: UserRef+               , _linkName   :: Text+               , _linkURL    :: Text+               , _linkFileId :: Maybe FileId+               } deriving (Eq, Show)  makeLenses ''LinkChoice @@ -408,16 +458,22 @@ normalChannelSigil :: Text normalChannelSigil = "~" -userSigil :: Text-userSigil = "@"- -- ** Channel-matching types +-- | A match in channel selection mode. data ChannelSelectMatch =     ChannelSelectMatch { nameBefore     :: Text+                       -- ^ The content of the match before the user's+                       -- matching input.                        , nameMatched    :: Text+                       -- ^ The potion of the name that matched the+                       -- user's input.                        , nameAfter      :: Text+                       -- ^ The portion of the name that came after the+                       -- user's matching input.                        , matchFull      :: Text+                       -- ^ The full string for this entry so it doesn't+                       -- have to be reassembled from the parts above.                        }                        deriving (Eq, Show) @@ -444,112 +500,118 @@                   , programExitCode :: ExitCode                   } -data UserPreferences = UserPreferences-  { _userPrefShowJoinLeave     :: Bool-  , _userPrefFlaggedPostList   :: Seq FlaggedPost-  , _userPrefGroupChannelPrefs :: HashMap ChannelId Bool-  }+data UserPreferences =+    UserPreferences { _userPrefShowJoinLeave     :: Bool+                    , _userPrefFlaggedPostList   :: Seq FlaggedPost+                    , _userPrefGroupChannelPrefs :: HashMap ChannelId Bool+                    }  defaultUserPreferences :: UserPreferences-defaultUserPreferences = UserPreferences-  { _userPrefShowJoinLeave     = True-  , _userPrefFlaggedPostList   = mempty-  , _userPrefGroupChannelPrefs = mempty-  }+defaultUserPreferences =+    UserPreferences { _userPrefShowJoinLeave     = True+                    , _userPrefFlaggedPostList   = mempty+                    , _userPrefGroupChannelPrefs = mempty+                    }  setUserPreferences :: Seq Preference -> UserPreferences -> UserPreferences setUserPreferences = flip (F.foldr go)-  where go p u-          | Just fp <- preferenceToFlaggedPost p =-            u { _userPrefFlaggedPostList =-                _userPrefFlaggedPostList u Seq.|> fp-              }-          | Just gp <- preferenceToGroupChannelPreference p =-            u { _userPrefGroupChannelPrefs =-                HM.insert-                  (groupChannelId gp)-                  (groupChannelShow gp)-                  (_userPrefGroupChannelPrefs u)-              }-          | preferenceName p == PreferenceName "join_leave" =-            u { _userPrefShowJoinLeave =-                preferenceValue p /= PreferenceValue "false" }-          | otherwise = u+    where go p u+            | Just fp <- preferenceToFlaggedPost p =+              u { _userPrefFlaggedPostList =+                  _userPrefFlaggedPostList u Seq.|> fp+                }+            | Just gp <- preferenceToGroupChannelPreference p =+              u { _userPrefGroupChannelPrefs =+                  HM.insert+                    (groupChannelId gp)+                    (groupChannelShow gp)+                    (_userPrefGroupChannelPrefs u)+                }+            | preferenceName p == PreferenceName "join_leave" =+              u { _userPrefShowJoinLeave =+                  preferenceValue p /= PreferenceValue "false" }+            | otherwise = u --- | 'ChatResources' represents configuration and--- connection-related information, as opposed to--- current model or view information. Information--- that goes in the 'ChatResources' value should be--- limited to information that we read or set up--- prior to setting up the bulk of the application state.-data ChatResources = ChatResources-  { _crSession             :: Session-  , _crConn                :: ConnectionData-  , _crRequestQueue        :: RequestChan-  , _crEventQueue          :: BChan MHEvent-  , _crSubprocessLog       :: STM.TChan ProgramOutput-  , _crWebsocketActionChan :: STM.TChan WebsocketAction-  , _crTheme               :: AttrMap-  , _crUserStatusLock      :: MVar ()-  , _crUserIdSet           :: STM.TVar (Seq UserId)-  , _crConfiguration       :: Config-  , _crFlaggedPosts        :: Set PostId-  , _crUserPreferences     :: UserPreferences-  }+-- | 'ChatResources' represents configuration and connection-related+-- information, as opposed to current model or view information.+-- Information that goes in the 'ChatResources' value should be limited+-- to information that we read or set up prior to setting up the bulk of+-- the application state.+data ChatResources =+    ChatResources { _crSession             :: Session+                  , _crConn                :: ConnectionData+                  , _crRequestQueue        :: RequestChan+                  , _crEventQueue          :: BChan MHEvent+                  , _crSubprocessLog       :: STM.TChan ProgramOutput+                  , _crWebsocketActionChan :: STM.TChan WebsocketAction+                  , _crTheme               :: AttrMap+                  , _crUserStatusLock      :: MVar ()+                  , _crUserIdSet           :: STM.TVar (Seq UserId)+                  , _crConfiguration       :: Config+                  , _crFlaggedPosts        :: Set PostId+                  , _crUserPreferences     :: UserPreferences+                  , _crSyntaxMap           :: SyntaxMap+                  }  --- | The 'ChatEditState' value contains the editor widget itself---   as well as history and metadata we need for editing-related---   operations.-data ChatEditState = ChatEditState-  { _cedEditor               :: Editor Text Name-  , _cedEditMode             :: EditMode-  , _cedMultiline            :: Bool-  , _cedInputHistory         :: InputHistory-  , _cedInputHistoryPosition :: HashMap ChannelId (Maybe Int)-  , _cedLastChannelInput     :: HashMap ChannelId (Text, EditMode)-  , _cedCompleter            :: Maybe Completer-  , _cedYankBuffer           :: Text-  , _cedSpellChecker         :: Maybe (Aspell, IO ())-  , _cedMisspellings         :: Set Text-  }+-- | The 'ChatEditState' value contains the editor widget itself as well+-- as history and metadata we need for editing-related operations.+data ChatEditState =+    ChatEditState { _cedEditor               :: Editor Text Name+                  , _cedEditMode             :: EditMode+                  , _cedMultiline            :: Bool+                  , _cedInputHistory         :: InputHistory+                  , _cedInputHistoryPosition :: HashMap ChannelId (Maybe Int)+                  , _cedLastChannelInput     :: HashMap ChannelId (Text, EditMode)+                  , _cedCompleter            :: Maybe Completer+                  , _cedYankBuffer           :: Text+                  , _cedSpellChecker         :: Maybe (Aspell, IO ())+                  , _cedMisspellings         :: Set Text+                  } +-- | The input mode. data EditMode =     NewPost-    | Editing Post+    -- ^ The input is for a new post.+    | Editing Post MessageType+    -- ^ The input is to be used as a new body for an existing post of+    -- the specified type.     | Replying Message Post-      deriving (Show)+    -- ^ The input is to be used as a new post in reply to the specified+    -- post.+    deriving (Show) --- | We can initialize a new 'ChatEditState' value with just an---   edit history, which we save locally.+-- | We can initialize a new 'ChatEditState' value with just an edit+-- history, which we save locally. emptyEditState :: InputHistory -> Maybe (Aspell, IO ()) -> ChatEditState-emptyEditState hist sp = ChatEditState-  { _cedEditor               = editor MessageInput Nothing ""-  , _cedMultiline            = False-  , _cedInputHistory         = hist-  , _cedInputHistoryPosition = mempty-  , _cedLastChannelInput     = mempty-  , _cedCompleter            = Nothing-  , _cedEditMode             = NewPost-  , _cedYankBuffer           = ""-  , _cedSpellChecker         = sp-  , _cedMisspellings         = mempty-  }+emptyEditState hist sp =+    ChatEditState { _cedEditor               = editor MessageInput Nothing ""+                  , _cedMultiline            = False+                  , _cedInputHistory         = hist+                  , _cedInputHistoryPosition = mempty+                  , _cedLastChannelInput     = mempty+                  , _cedCompleter            = Nothing+                  , _cedEditMode             = NewPost+                  , _cedYankBuffer           = ""+                  , _cedSpellChecker         = sp+                  , _cedMisspellings         = mempty+                  } --- | A 'RequestChan' is a queue of operations we have to perform---   in the background to avoid blocking on the main loop+-- | A 'RequestChan' is a queue of operations we have to perform in the+-- background to avoid blocking on the main loop type RequestChan = STM.TChan (IO (MH ()))  -- | The 'HelpScreen' type represents the set of possible 'Help'---   dialogues we have to choose from.-data HelpScreen-  = MainHelp-  | ScriptHelp-  | ThemeHelp-  | KeybindingHelp+-- dialogues we have to choose from.+data HelpScreen =+    MainHelp+    | ScriptHelp+    | ThemeHelp+    | SyntaxHighlightHelp+    | KeybindingHelp     deriving (Eq) --- |  Help topics+-- | Help topics data HelpTopic =     HelpTopic { helpTopicName         :: Text               , helpTopicDescription  :: Text@@ -559,11 +621,10 @@               deriving (Eq)  -- | Mode type for the current contents of the post list overlay-data PostListContents-  = PostListFlagged-  | PostListSearch Text Bool -- for the query and search status-  --   | PostListPinned ChannelId-  deriving (Eq)+data PostListContents =+    PostListFlagged+    | PostListSearch Text Bool -- for the query and search status+    deriving (Eq)  -- | The 'Mode' represents the current dominant UI activity data Mode =@@ -585,33 +646,73 @@ data ConnectionStatus = Connected | Disconnected  -- | This is the giant bundle of fields that represents the current---  state of our application at any given time. Some of this should---  be broken out further, but hasn't yet been.-data ChatState = ChatState-  { _csResources                   :: ChatResources-  , _csFocus                       :: Zipper ChannelId-  , _csNames                       :: MMNames-  , _csMe                          :: User-  , _csMyTeam                      :: Team-  , _csChannels                    :: ClientChannels-  , _csPostMap                     :: HashMap PostId Message-  , _csUsers                       :: Users-  , _timeZone                      :: TimeZoneSeries-  , _csEditState                   :: ChatEditState-  , _csMode                        :: Mode-  , _csShowMessagePreview          :: Bool-  , _csChannelSelectState          :: ChannelSelectState-  , _csRecentChannel               :: Maybe ChannelId-  , _csUrlList                     :: List Name LinkChoice-  , _csConnectionStatus            :: ConnectionStatus-  , _csWorkerIsBusy                :: Maybe (Maybe Int)-  , _csJoinChannelList             :: Maybe (List Name Channel)-  , _csMessageSelect               :: MessageSelectState-  , _csPostListOverlay             :: PostListOverlayState-  , _csUserListOverlay             :: UserListOverlayState-  , _csClientConfig                :: Maybe ClientConfig-  }+-- state of our application at any given time. Some of this should be+-- broken out further, but hasn't yet been.+data ChatState =+    ChatState { _csResources :: ChatResources+              -- ^ Global application-wide resources that don't change+              -- much.+              , _csFocus :: Zipper ChannelId+              -- ^ The channel sidebar zipper that tracks which channel+              -- is selected.+              , _csNames :: MMNames+              -- ^ Mappings between names and user/channel IDs.+              , _csMe :: User+              -- ^ The authenticated user.+              , _csMyTeam :: Team+              -- ^ The active team of the authenticated user.+              , _csChannels :: ClientChannels+              -- ^ The channels that we are showing, including their+              -- message lists.+              , _csPostMap :: HashMap PostId Message+              -- ^ The map of post IDs to messages. This allows us to+              -- access messages by ID without having to linearly scan+              -- channel message lists.+              , _csUsers :: Users+              -- ^ All of the users we know about.+              , _timeZone :: TimeZoneSeries+              -- ^ The client time zone.+              , _csEditState :: ChatEditState+              -- ^ The state of the input box used for composing and+              -- editing messages and commands.+              , _csMode :: Mode+              -- ^ The current application mode. This is used to+              -- dispatch to different rendering and event handling+              -- routines.+              , _csShowMessagePreview :: Bool+              -- ^ Whether to show the message preview area.+              , _csChannelSelectState :: ChannelSelectState+              -- ^ The state of the user's input and selection for+              -- channel selection mode.+              , _csRecentChannel :: Maybe ChannelId+              -- ^ The most recently-selected channel, if any.+              , _csUrlList :: List Name LinkChoice+              -- ^ The URL list used to show URLs drawn from messages in+              -- a channel.+              , _csConnectionStatus :: ConnectionStatus+              -- ^ Our view of the connection status.+              , _csWorkerIsBusy :: Maybe (Maybe Int)+              -- ^ Whether the async worker thread is busy, and its+              -- queue length if so.+              , _csJoinChannelList :: Maybe (List Name Channel)+              -- ^ The list of channels presented in the channel join+              -- window.+              , _csMessageSelect :: MessageSelectState+              -- ^ The state of message selection mode.+              , _csPostListOverlay :: PostListOverlayState+              -- ^ The state of the post list overlay.+              , _csUserListOverlay :: UserListOverlayState+              -- ^ The state of the user list overlay.+              , _csClientConfig :: Maybe ClientConfig+              -- ^ The Mattermost client configuration, as we understand it.+              , _csLastJoinRequest :: Maybe ChannelId+              -- ^ The most recently-joined channel ID that we look for+              -- in an asynchronous join notification, so that we can+              -- switch to it in the sidebar.+              } +-- | Startup state information that is constructed prior to building a+-- ChatState. data StartupStateInfo =     StartupStateInfo { startupStateResources      :: ChatResources                      , startupStateChannelZipper  :: Zipper ChannelId@@ -624,41 +725,41 @@                      }  newState :: StartupStateInfo -> ChatState-newState (StartupStateInfo rs i u m tz hist sp ns) = ChatState-  { _csResources                   = rs-  , _csFocus                       = i-  , _csMe                          = u-  , _csMyTeam                      = m-  , _csNames                       = ns-  , _csChannels                    = noChannels-  , _csPostMap                     = HM.empty-  , _csUsers                       = noUsers-  , _timeZone                      = tz-  , _csEditState                   = emptyEditState hist sp-  , _csMode                        = Main-  , _csShowMessagePreview          = configShowMessagePreview $ _crConfiguration rs-  , _csChannelSelectState          = emptyChannelSelectState-  , _csRecentChannel               = Nothing-  , _csUrlList                     = list UrlList mempty 2-  , _csConnectionStatus            = Connected-  , _csWorkerIsBusy                = Nothing-  , _csJoinChannelList             = Nothing-  , _csMessageSelect               = MessageSelectState Nothing-  , _csPostListOverlay             = PostListOverlayState emptyDirSeq Nothing-  , _csUserListOverlay             = nullUserListOverlayState-  , _csClientConfig                = Nothing-  }+newState (StartupStateInfo {..}) =+    ChatState { _csResources                   = startupStateResources+              , _csFocus                       = startupStateChannelZipper+              , _csMe                          = startupStateConnectedUser+              , _csMyTeam                      = startupStateTeam+              , _csNames                       = startupStateNames+              , _csChannels                    = noChannels+              , _csPostMap                     = HM.empty+              , _csUsers                       = noUsers+              , _timeZone                      = startupStateTimeZone+              , _csEditState                   = emptyEditState startupStateInitialHistory startupStateSpellChecker+              , _csMode                        = Main+              , _csShowMessagePreview          = configShowMessagePreview $ _crConfiguration startupStateResources+              , _csChannelSelectState          = emptyChannelSelectState+              , _csRecentChannel               = Nothing+              , _csUrlList                     = list UrlList mempty 2+              , _csConnectionStatus            = Connected+              , _csWorkerIsBusy                = Nothing+              , _csJoinChannelList             = Nothing+              , _csMessageSelect               = MessageSelectState Nothing+              , _csPostListOverlay             = PostListOverlayState emptyDirSeq Nothing+              , _csUserListOverlay             = nullUserListOverlayState+              , _csClientConfig                = Nothing+              , _csLastJoinRequest             = Nothing+              }  nullUserListOverlayState :: UserListOverlayState nullUserListOverlayState =-    UserListOverlayState { _userListSearchResults = listFromUserSearchResults mempty-                         , _userListSelected    = Nothing-                         , _userListSearchInput = editor UserListSearchInput (Just 1) ""-                         , _userListSearchScope = AllUsers-                         , _userListSearching = False+    UserListOverlayState { _userListSearchResults  = listFromUserSearchResults mempty+                         , _userListSearchInput    = editor UserListSearchInput (Just 1) ""+                         , _userListSearchScope    = AllUsers+                         , _userListSearching      = False                          , _userListRequestingMore = False-                         , _userListHasAllResults = False-                         , _userListEnterHandler = const $ return False+                         , _userListHasAllResults  = False+                         , _userListEnterHandler   = const $ return False                          }  listFromUserSearchResults :: Vec.Vector UserInfo -> List Name UserInfo@@ -667,11 +768,15 @@     -- in Draw.UserListOverlay.     list UserListSearchResults rs 1 +-- | A match in channel selection mode. Constructors distinguish+-- between channel and user matches to ensure that a match of each type+-- is distinct. data MatchValue =     UserMatch Text     | ChannelMatch Text     deriving (Eq, Show) +-- | The state of channel selection mode. data ChannelSelectState =     ChannelSelectState { _channelSelectInput :: Text                        , _channelMatches     :: [ChannelSelectMatch]@@ -687,25 +792,29 @@                        , _selectedMatch      = Nothing                        } +-- | The state of message selection mode. data MessageSelectState =-    MessageSelectState { selectMessagePostId :: Maybe PostId }+    MessageSelectState { selectMessagePostId :: Maybe PostId+                       } -data PostListOverlayState = PostListOverlayState-  { _postListPosts    :: Messages-  , _postListSelected :: Maybe PostId-  }+-- | The state of the post list overlay.+data PostListOverlayState =+    PostListOverlayState { _postListPosts    :: Messages+                         , _postListSelected :: Maybe PostId+                         } -data UserListOverlayState = UserListOverlayState-  { _userListSearchResults :: List Name UserInfo-  , _userListSelected :: Maybe PostId-  , _userListSearchInput :: Editor Text Name-  , _userListSearchScope :: UserSearchScope-  , _userListSearching :: Bool-  , _userListRequestingMore :: Bool-  , _userListHasAllResults :: Bool-  , _userListEnterHandler :: UserInfo -> MH Bool-  }+-- | The state of the user list overlay.+data UserListOverlayState =+    UserListOverlayState { _userListSearchResults :: List Name UserInfo+                         , _userListSearchInput :: Editor Text Name+                         , _userListSearchScope :: UserSearchScope+                         , _userListSearching :: Bool+                         , _userListRequestingMore :: Bool+                         , _userListHasAllResults :: Bool+                         , _userListEnterHandler :: UserInfo -> MH Bool+                         } +-- | The scope for searching for users in a user list overlay. data UserSearchScope =     ChannelMembers ChannelId     | ChannelNonMembers ChannelId@@ -714,9 +823,7 @@ -- | Actions that can be sent on the websocket to the server. data WebsocketAction =     UserTyping UTCTime ChannelId (Maybe PostId) -- ^ user typing in the input box-  -- | GetStatuses-  -- | GetStatusesByIds [UserId]-  deriving (Read, Show, Eq, Ord)+    deriving (Read, Show, Eq, Ord)  -- * MH Monad @@ -724,11 +831,10 @@ -- manipulate the application state and also request that the -- application quit newtype MH a =-  MH { fromMH :: St.StateT (ChatState, ChatState -> EventM Name (Next ChatState))-                           (EventM Name) a }+    MH { fromMH :: St.StateT (ChatState, ChatState -> EventM Name (Next ChatState)) (EventM Name) a } --- | Run an 'MM' computation, choosing whether to continue or halt---   based on the resulting+-- | Run an 'MM' computation, choosing whether to continue or halt based+-- on the resulting runMHEvent :: ChatState -> MH () -> EventM Name (Next ChatState) runMHEvent st (MH mote) = do   ((), (st', rs)) <- St.runStateT mote (st, Brick.continue)@@ -740,54 +846,50 @@  mhHandleEventLensed :: Lens' ChatState b -> (e -> b -> EventM Name b) -> e -> MH () mhHandleEventLensed ln f event = MH $ do-  (st, b) <- St.get-  n <- St.lift $ f event (st ^. ln)-  St.put (st & ln .~ n , b)+    (st, b) <- St.get+    n <- St.lift $ f event (st ^. ln)+    St.put (st & ln .~ n , b)  mhSuspendAndResume :: (ChatState -> IO ChatState) -> MH () mhSuspendAndResume mote = MH $ do-  (st, _) <- St.get-  St.put (st, \ _ -> Brick.suspendAndResume (mote st))+    (st, _) <- St.get+    St.put (st, \ _ -> Brick.suspendAndResume (mote st))  -- | This will request that after this computation finishes the -- application should exit requestQuit :: MH () requestQuit = MH $ do-  (st, _) <- St.get-  St.put (st, Brick.halt)+    (st, _) <- St.get+    St.put (st, Brick.halt)  instance Functor MH where-  fmap f (MH x) = MH (fmap f x)+    fmap f (MH x) = MH (fmap f x)  instance Applicative MH where-  pure x = MH (pure x)-  MH f <*> MH x = MH (f <*> x)+    pure x = MH (pure x)+    MH f <*> MH x = MH (f <*> x)  instance Monad MH where-  return x = MH (return x)-  MH x >>= f = MH (x >>= \ x' -> fromMH (f x'))+    return x = MH (return x)+    MH x >>= f = MH (x >>= \ x' -> fromMH (f x'))  -- We want to pretend that the state is only the ChatState, rather -- than the ChatState and the Brick continuation instance St.MonadState ChatState MH where-  get = fst `fmap` MH St.get-  put st = MH $ do-    (_, c) <- St.get-    St.put (st, c)+    get = fst `fmap` MH St.get+    put st = MH $ do+        (_, c) <- St.get+        St.put (st, c)  instance St.MonadIO MH where-  liftIO = MH . St.liftIO+    liftIO = MH . St.liftIO  -- | This represents events that we handle in the main application loop.-data MHEvent-    = WSEvent WebsocketEvent+data MHEvent =+    WSEvent WebsocketEvent     -- ^ For events that arise from the websocket     | RespEvent (MH ())     -- ^ For the result values of async IO operations-    | AsyncMattermostError MattermostError-    -- ^ For Mattermost-specific exceptions-    | AsyncErrEvent SomeException-    -- ^ For errors that arise in the course of async IO operations     | RefreshWebsocketEvent     -- ^ Tell our main loop to refresh the websocket connection     | WebsocketParseError String@@ -803,11 +905,38 @@     | IEvent InternalEvent     -- ^ MH-internal events -data InternalEvent-    = DisplayError Text-      -- ^ Display a generic error message to the user-    deriving (Eq, Show)+-- | Internal application events.+data InternalEvent =+    DisplayError MHError+    -- ^ Some kind of application error occurred +-- | Application errors.+data MHError =+    GenericError T.Text+    -- ^ A generic error message constructor+    | NoSuchChannel T.Text+    -- ^ The specified channel does not exist+    | NoSuchUser T.Text+    -- ^ The specified user does not exist+    | AmbiguousName T.Text+    -- ^ The specified name matches both a user and a channel+    | ServerError MattermostError+    -- ^ A Mattermost server error occurred+    | ClipboardError T.Text+    -- ^ A problem occurred trying to deal with yanking or the system+    -- clipboard+    | ConfigOptionMissing T.Text+    -- ^ A missing config option is required to perform an operation+    | ProgramExecutionFailed T.Text T.Text+    -- ^ Args: program name, path to log file. A problem occurred when+    -- running the program.+    | NoSuchScript T.Text+    -- ^ The specified script was not found+    | NoSuchHelpTopic T.Text+    -- ^ The specified help topic was not found+    | AsyncErrEvent SomeException+    -- ^ For errors that arise in the course of async IO operations+ -- ** Application State Lenses  makeLenses ''ChatResources@@ -850,29 +979,29 @@  csCurrentChannel :: Lens' ChatState ClientChannel csCurrentChannel =-  lens (\ st -> findChannelById (st^.csCurrentChannelId) (st^.csChannels) ^?! _Just)-       (\ st n -> st & csChannels %~ addChannel (st^.csCurrentChannelId) n)+    lens (\ st -> findChannelById (st^.csCurrentChannelId) (st^.csChannels) ^?! _Just)+         (\ st n -> st & csChannels %~ addChannel (st^.csCurrentChannelId) n)  csChannel :: ChannelId -> Traversal' ChatState ClientChannel csChannel cId =-  csChannels . channelByIdL cId+    csChannels . channelByIdL cId  withChannel :: ChannelId -> (ClientChannel -> MH ()) -> MH () withChannel cId = withChannelOrDefault cId ()  withChannelOrDefault :: ChannelId -> a -> (ClientChannel -> MH a) -> MH a withChannelOrDefault cId deflt mote = do-  chan <- preuse (csChannel(cId))-  case chan of-    Nothing -> return deflt-    Just c  -> mote c+    chan <- preuse (csChannel(cId))+    case chan of+        Nothing -> return deflt+        Just c  -> mote c  -- ** 'ChatState' Helper Functions  raiseInternalEvent :: InternalEvent -> MH () raiseInternalEvent ev = do-  queue <- use (csResources.crEventQueue)-  St.liftIO $ writeBChan queue (IEvent ev)+    queue <- use (csResources.crEventQueue)+    St.liftIO $ writeBChan queue (IEvent ev)  isMine :: ChatState -> Message -> Bool isMine st msg = (UserI $ myUserId st) == msg^.mUser@@ -882,9 +1011,9 @@  getParentMessage :: ChatState -> Message -> Maybe Message getParentMessage st msg-  | InReplyTo pId <- msg^.mInReplyToMsg-    = st^.csPostMap.at(pId)-  | otherwise = Nothing+    | InReplyTo pId <- msg^.mInReplyToMsg+      = st^.csPostMap.at(pId)+    | otherwise = Nothing  setUserStatus :: UserId -> Text -> MH () setUserStatus uId t = csUsers %= modifyUserById uId (uiStatus .~ statusFromText t)@@ -956,11 +1085,6 @@     | normalChannelSigil `T.isPrefixOf` n = T.tail n     | otherwise                           = n -trimUserSigil :: Text -> Text-trimUserSigil n-    | userSigil `T.isPrefixOf` n = T.tail n-    | otherwise                  = n- addNewUser :: UserInfo -> MH () addNewUser u = do     csUsers %= addUser u@@ -1018,48 +1142,49 @@     csFocus %= newZip  clientPostToMessage :: ClientPost -> Message-clientPostToMessage cp = Message-  { _mText          = cp^.cpText-  , _mUser          = case cp^.cpUserOverride of-                        Just n | cp^.cpType == NormalPost -> UserOverride (n <> "[BOT]")-                        _ -> maybe NoUser UserI $ cp^.cpUser-  , _mDate          = cp^.cpDate-  , _mType          = CP $ cp^.cpType-  , _mPending       = cp^.cpPending-  , _mDeleted       = cp^.cpDeleted-  , _mAttachments   = cp^.cpAttachments-  , _mInReplyToMsg  =-    case cp^.cpInReplyToPost of-      Nothing  -> NotAReply-      Just pId -> InReplyTo pId-  , _mPostId        = Just $ cp^.cpPostId-  , _mReactions     = cp^.cpReactions-  , _mOriginalPost  = Just $ cp^.cpOriginalPost-  , _mFlagged       = False-  , _mChannelId     = Just $ cp^.cpChannelId-  }+clientPostToMessage cp =+    Message { _mText = cp^.cpText+            , _mUser =+                case cp^.cpUserOverride of+                    Just n | cp^.cpType == NormalPost -> UserOverride (n <> "[BOT]")+                    _ -> maybe NoUser UserI $ cp^.cpUser+            , _mDate = cp^.cpDate+            , _mType = CP $ cp^.cpType+            , _mPending = cp^.cpPending+            , _mDeleted = cp^.cpDeleted+            , _mAttachments = cp^.cpAttachments+            , _mInReplyToMsg =+                case cp^.cpInReplyToPost of+                    Nothing  -> NotAReply+                    Just pId -> InReplyTo pId+            , _mPostId = Just $ cp^.cpPostId+            , _mReactions = cp^.cpReactions+            , _mOriginalPost = Just $ cp^.cpOriginalPost+            , _mFlagged = False+            , _mChannelId = Just $ cp^.cpChannelId+            }  -- * Slash Commands --- | The 'CmdArgs' type represents the arguments to a slash-command;---   the type parameter represents the argument structure.+-- | The 'CmdArgs' type represents the arguments to a slash-command; the+-- type parameter represents the argument structure. data CmdArgs :: * -> * where-  NoArg    :: CmdArgs ()-  LineArg  :: Text -> CmdArgs Text-  TokenArg :: Text -> CmdArgs rest -> CmdArgs (Text, rest)+    NoArg    :: CmdArgs ()+    LineArg  :: Text -> CmdArgs Text+    TokenArg :: Text -> CmdArgs rest -> CmdArgs (Text, rest) --- | A 'CmdExec' value represents the implementation of a command---   when provided with its arguments+-- | A 'CmdExec' value represents the implementation of a command when+-- provided with its arguments type CmdExec a = a -> MH ()  -- | A 'Cmd' packages up a 'CmdArgs' specifier and the 'CmdExec'---   implementation with a name and a description.-data Cmd = forall a. Cmd-  { cmdName    :: Text-  , cmdDescr   :: Text-  , cmdArgSpec :: CmdArgs a-  , cmdAction  :: CmdExec a-  }+-- implementation with a name and a description.+data Cmd =+    forall a. Cmd { cmdName    :: Text+                  , cmdDescr   :: Text+                  , cmdArgSpec :: CmdArgs a+                  , cmdAction  :: CmdExec a+                  }  -- | Helper function to extract the name out of a 'Cmd' value commandName :: Cmd -> Text@@ -1069,15 +1194,15 @@  hasUnread :: ChatState -> ChannelId -> Bool hasUnread st cId = maybe False id $ do-  chan <- findChannelById cId (st^.csChannels)-  lastViewTime <- chan^.ccInfo.cdViewed-  return $ (chan^.ccInfo.cdUpdated > lastViewTime) ||-           (isJust $ chan^.ccInfo.cdEditedMessageThreshold)+    chan <- findChannelById cId (st^.csChannels)+    lastViewTime <- chan^.ccInfo.cdViewed+    return $ (chan^.ccInfo.cdUpdated > lastViewTime) ||+             (isJust $ chan^.ccInfo.cdEditedMessageThreshold)  userList :: ChatState -> [UserInfo] userList st = filter showUser $ allUsers (st^.csUsers)-  where showUser u = not (isSelf u) && (u^.uiInTeam)-        isSelf u = (myUserId st) == (u^.uiId)+    where showUser u = not (isSelf u) && (u^.uiInTeam)+          isSelf u = (myUserId st) == (u^.uiId)  allUserIds :: ChatState -> [UserId] allUserIds st = getAllUserIds $ st^.csUsers@@ -1111,15 +1236,15 @@  sortedUserList :: ChatState -> [UserInfo] sortedUserList st = sortBy cmp yes <> sortBy cmp no-  where-      cmp = compareUserInfo uiName-      dmHasUnread u =-          case st^.csNames.usernameToChanId.at(u^.uiName) of-            Nothing  -> False-            Just cId-              | (st^.csCurrentChannelId) == cId -> False-              | otherwise -> hasUnread st cId-      (yes, no) = partition dmHasUnread (filter (not . _uiDeleted) $ userList st)+    where+        cmp = compareUserInfo uiName+        dmHasUnread u =+            case st^.csNames.usernameToChanId.at(u^.uiName) of+              Nothing  -> False+              Just cId+                | (st^.csCurrentChannelId) == cId -> False+                | otherwise -> hasUnread st cId+        (yes, no) = partition dmHasUnread (filter (not . _uiDeleted) $ userList st)  compareUserInfo :: (Ord a) => Lens' UserInfo a -> UserInfo -> UserInfo -> Ordering compareUserInfo field u1 u2@@ -1135,13 +1260,17 @@ type UserSet = Set Text type ChannelSet = Set Text -data HighlightSet = HighlightSet-  { hUserSet    :: Set Text-  , hChannelSet :: Set Text-  }+-- | The set of usernames, channel names, and language names used for+-- highlighting when rendering messages.+data HighlightSet =+    HighlightSet { hUserSet    :: Set Text+                 , hChannelSet :: Set Text+                 , hSyntaxMap  :: SyntaxMap+                 }  getHighlightSet :: ChatState -> HighlightSet-getHighlightSet st = HighlightSet-  { hUserSet = Set.fromList (st^..csUsers.to allUsers.folded.uiName)-  , hChannelSet = Set.fromList (st^..csChannels.folded.ccInfo.cdName)-  }+getHighlightSet st =+    HighlightSet { hUserSet = Set.fromList (st^..csUsers.to allUsers.folded.uiName)+                 , hChannelSet = Set.fromList (st^..csChannels.folded.ccInfo.cdName)+                 , hSyntaxMap = st^.csResources.crSyntaxMap+                 }

@@ -44,11 +44,15 @@   ) where +import           Prelude ()+import           Prelude.MH+ import qualified Data.HashMap.Strict as HM-import           Lens.Micro.Platform ((%~), (.~), Traversal', Lens',-                                       makeLenses, ix, at,-                                       to, non)-import           Network.Mattermost.Lenses hiding (Lens')+import           Lens.Micro.Platform ( (%~), (.~), Traversal', Lens'+                                     , makeLenses, ix, at+                                     , to, non )++import           Network.Mattermost.Lenses hiding ( Lens' ) import           Network.Mattermost.Types ( Channel(..), UserId, ChannelId                                           , ChannelMember(..)                                           , Type(..)@@ -60,11 +64,13 @@                                           , ServerTime                                           , emptyChannelNotifyProps                                           )-import           Types.Messages (Messages, noMessages, addMessage, clientMessageToMessage)-import           Types.Posts (ClientMessageType(UnknownGap), newClientMessage, postIsLeave, postIsJoin)-import           Types.Users (TypingUsers, noTypingUsers, addTypingUser)-import           Prelude ()-import           Prelude.MH++import           Types.Messages ( Messages, noMessages, addMessage+                                , clientMessageToMessage )+import           Types.Posts ( ClientMessageType(UnknownGap)+                             , newClientMessage, postIsLeave, postIsJoin )+import           Types.Users ( TypingUsers, noTypingUsers, addTypingUser )+  -- * Channel representations 

@@ -11,10 +11,10 @@  module Types.DirectionalSeq where --import qualified Data.Sequence as Seq import           Prelude () import           Prelude.MH++import qualified Data.Sequence as Seq   data Chronological

@@ -22,12 +22,13 @@   ) where +import           Prelude ()+import           Prelude.MH+ import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Graphics.Vty as Vty -import Prelude ()-import Prelude.MH  -- | This enum represents all the possible key events a user might --   want to use.

@@ -73,16 +73,21 @@   ) where -import           Cheapskate (Blocks)+import           Prelude ()+import           Prelude.MH++import           Cheapskate ( Blocks ) import qualified Data.Map.Strict as Map import           Data.Sequence as Seq import           Data.Tuple-import           Lens.Micro.Platform (makeLenses)-import           Network.Mattermost.Types (ChannelId, PostId, Post, ServerTime, UserId)+import           Lens.Micro.Platform ( makeLenses )++import           Network.Mattermost.Types ( ChannelId, PostId, Post+                                          , ServerTime, UserId )+ import           Types.DirectionalSeq import           Types.Posts-import           Prelude ()-import           Prelude.MH+  -- ---------------------------------------------------------------------- -- * Messages

@@ -44,17 +44,20 @@   ) where -import           Cheapskate (Blocks)+import           Prelude ()+import           Prelude.MH++import           Cheapskate ( Blocks ) import qualified Cheapskate as C import qualified Data.Map.Strict as Map import qualified Data.Sequence as Seq import qualified Data.Text as T-import           Data.Time.Clock (getCurrentTime)-import           Lens.Micro.Platform (makeLenses)-import           Network.Mattermost.Types+import           Data.Time.Clock ( getCurrentTime )+import           Lens.Micro.Platform ( makeLenses )+ import           Network.Mattermost.Lenses-import           Prelude ()-import           Prelude.MH+import           Network.Mattermost.Types+  -- * Client Messages 

@@ -13,6 +13,8 @@   -- * Creating UserInfo objects   , userInfoFromUser   -- * Miscellaneous+  , userSigil+  , trimUserSigil   , statusFromText   , findUserById   , findUserByName@@ -32,14 +34,17 @@   ) where -import           Data.Semigroup (Max(..))-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T-import           Lens.Micro.Platform ((%~), makeLenses, ix)-import           Network.Mattermost.Types (Id(Id), UserId(..), User(..), idString) import           Prelude () import           Prelude.MH +import qualified Data.HashMap.Strict as HM+import           Data.Semigroup ( Max(..) )+import qualified Data.Text as T+import           Lens.Micro.Platform ( (%~), makeLenses, ix )++import           Network.Mattermost.Types ( Id(Id), UserId(..), User(..)+                                          , idString )+ -- * 'UserInfo' Values  -- | A 'UserInfo' value represents everything we need to know at@@ -152,21 +157,31 @@ findUserById :: UserId -> Users -> Maybe UserInfo findUserById uId = HM.lookup uId . _ofUsers --- | Get the User information given the user's name.  This is an exact--- match on the username field, not necessarly the presented name.+-- | Get the User information given the user's name. This is an exact+-- match on the username field, not necessarly the presented name. It+-- will automatically trim a user sigil from the input. findUserByName :: Users -> Text -> Maybe (UserId, UserInfo) findUserByName allusers name =-  case filter ((== name) . _uiName . snd) $ HM.toList $ _ofUsers allusers of+  case filter ((== trimUserSigil name) . _uiName . snd) $ HM.toList $ _ofUsers allusers of     (usr : []) -> Just usr     _ -> Nothing --- | Get the User information given the user's name.  This is an exact--- match on the nickname field, not necessarily the presented name.+-- | Get the User information given the user's name. This is an exact+-- match on the nickname field, not necessarily the presented name. It+-- will automatically trim a user sigil from the input. findUserByNickname :: [UserInfo] -> Text -> Maybe UserInfo findUserByNickname uList nick =   find (nickCheck nick) uList     where-        nickCheck n = maybe False (== n) . _uiNickName+        nickCheck n = maybe False (== (trimUserSigil n)) . _uiNickName++userSigil :: Text+userSigil = "@"++trimUserSigil :: Text -> Text+trimUserSigil n+    | userSigil `T.isPrefixOf` n = T.tail n+    | otherwise                  = n  -- | Extract a specific user from the collection and perform an -- endomorphism operation on it, then put it back into the collection.

@@ -14,12 +14,12 @@   ) where -import Prelude ()-import Prelude.MH+import           Prelude ()+import           Prelude.MH  import qualified Data.Foldable as F+import           Lens.Micro.Platform ( Lens, lens, ix, (.~) ) -import Lens.Micro.Platform (Lens, lens, ix, (.~))  data Zipper a = Zipper   { zFocus :: Int