{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
module Matterhorn.Types
  ( ConnectionStatus(..)
  , HelpTopic(..)
  , ProgramOutput(..)
  , MHEvent(..)
  , InternalEvent(..)
  , StartupStateInfo(..)
  , MHError(..)
  , CPUUsagePolicy(..)
  , SemEq(..)
  , handleEventWith
  , getServerBaseUrl
  , serverBaseUrl
  , ConnectionInfo(..)
  , SidebarUpdate(..)
  , PendingChannelChange(..)
  , ViewMessageWindowTab(..)
  , clearChannelUnreadStatus
  , ChannelListSorting(..)
  , TeamListSorting(..)
  , ThreadOrientation(..)
  , ChannelListOrientation(..)
  , channelListEntryUserId
  , userIdsFromZipper
  , entryIsDMEntry
  , ciHostname
  , ciPort
  , ciUrlPath
  , ciUsername
  , ciOTPToken
  , ciPassword
  , ciType
  , ciAccessToken
  , ChannelTopicDialogState(..)
  , channelTopicDialogEditor
  , channelTopicDialogFocus

  , resultToWidget

  , MHKeyEventHandler
  , mhHandleKeyboardEvent

  , Config(..)
  , configUserL
  , configHostL
  , configTeamL
  , configPortL
  , configUrlPathL
  , configPassL
  , configTokenL
  , configOTPTokenL
  , configTimeFormatL
  , configDateFormatL
  , configThemeL
  , configThemeCustomizationFileL
  , configSmartBacktickL
  , configSmartEditingL
  , configURLOpenCommandL
  , configURLOpenCommandInteractiveL
  , configActivityNotifyCommandL
  , configActivityNotifyVersionL
  , configActivityBellL
  , configTruncateVerbatimBlocksL
  , configChannelListSortingL
  , configTeamListSortingL
  , configShowMessageTimestampsL
  , configShowBackgroundL
  , configShowMessagePreviewL
  , configShowChannelListL
  , configShowExpandedChannelTopicsL
  , configEnableAspellL
  , configAspellDictionaryL
  , configUnsafeUseHTTPL
  , configValidateServerCertificateL
  , configChannelListWidthL
  , configLogMaxBufferSizeL
  , configShowOlderEditsL
  , configShowTypingIndicatorL
  , configSendTypingNotificationsL
  , configAbsPathL
  , configUserKeysL
  , configHyperlinkingModeL
  , configSyntaxDirsL
  , configDirectChannelExpirationDaysL
  , configCpuUsagePolicyL
  , configDefaultAttachmentPathL
  , configChannelListOrientationL
  , configThreadOrientationL
  , configMouseModeL
  , configShowLastOpenThreadL

  , unsafeKeyDispatcher
  , bindingConflictMessage

  , NotificationVersion(..)
  , PasswordSource(..)
  , TokenSource(..)
  , OTPTokenSource(..)
  , MatchType(..)
  , Mode(..)
  , ChannelSelectPattern(..)
  , PostListContents(..)
  , AuthenticationException(..)
  , BackgroundInfo(..)
  , RequestChan
  , UserFetch(..)
  , writeBChan
  , InternalTheme(..)

  , attrNameToConfig

  , matchesTeam
  , teamUnreadCount
  , teamZipperIds
  , mkChannelZipperList
  , ChannelListGroup(..)
  , nonDMChannelListGroupUnread

  , ThreadInterface
  , ChannelMessageInterface

  , threadInterface
  , unsafeThreadInterface
  , maybeThreadInterface
  , threadInterfaceEmpty
  , threadInterfaceDeleteWhere
  , modifyThreadMessages
  , modifyEachThreadMessage

  , trimChannelSigil

  , ChannelSelectState(..)
  , channelSelectMatches
  , channelSelectInput
  , emptyChannelSelectState

  , TeamState(..)
  , tsFocus
  , tsPendingChannelChange
  , tsRecentChannel
  , tsReturnChannel
  , tsTeam
  , tsChannelSelectState
  , tsViewedMessage
  , tsPostListWindow
  , tsUserListWindow
  , tsChannelListWindow
  , tsNotifyPrefs
  , tsChannelTopicDialog
  , tsReactionEmojiListWindow
  , tsThemeListWindow
  , tsChannelListSorting
  , tsThreadInterface
  , tsMessageInterfaceFocus

  , teamMode
  , teamModes
  , getTeamMode

  , MessageInterfaceFocus(..)
  , messageInterfaceFocusNext
  , messageInterfaceFocusPrev

  , channelEditor
  , channelMessageSelect

  , ChatState
  , newState

  , withCurrentChannel
  , withCurrentChannel'
  , withCurrentTeam

  , csTeamZipper
  , csTeams
  , csTeam
  , csChannelListOrientation
  , csResources
  , csLastMouseDownEvent
  , csGlobalEditState
  , csVerbatimTruncateSetting
  , csCurrentChannelId
  , csCurrentTeamId
  , csPostMap
  , csUsers
  , csHiddenChannelGroups
  , csConnectionStatus
  , csWorkerIsBusy
  , csChannel
  , csChannelMessages
  , csChannelMessageInterface
  , maybeChannelMessageInterface
  , csChannels
  , csClientConfig
  , csInputHistory
  , csMe
  , timeZone
  , whenMode
  , pushMode
  , pushMode'
  , popMode
  , replaceMode

  , GlobalEditState(..)
  , emptyGlobalEditState
  , gedYankBuffer

  , PostListWindowState(..)
  , postListSelected
  , postListPosts

  , UserSearchScope(..)
  , ChannelSearchScope(..)

  , ListWindowState(..)
  , listWindowSearchResults
  , listWindowSearchInput
  , listWindowSearchScope
  , listWindowSearching
  , listWindowEnterHandler
  , listWindowNewList
  , listWindowFetchResults
  , listWindowRecordCount

  , getUsers

  , ChatResources(..)
  , crUserPreferences
  , crEventQueue
  , crTheme
  , crStatusUpdateChan
  , crSubprocessLog
  , crWebsocketActionChan
  , crWebsocketThreadId
  , crRequestQueue
  , crFlaggedPosts
  , crConn
  , crConfiguration
  , crSyntaxMap
  , crLogManager
  , crSpellChecker
  , crEmoji
  , getSession
  , getResourceSession

  , specialUserMentions

  , applyTeamOrder
  , refreshTeamZipper

  , UserPreferences(UserPreferences)
  , userPrefShowJoinLeave
  , userPrefFlaggedPostList
  , userPrefGroupChannelPrefs
  , userPrefDirectChannelPrefs
  , userPrefTeammateNameDisplayMode
  , userPrefTeamOrder
  , userPrefFavoriteChannelPrefs
  , dmChannelShowPreference
  , groupChannelShowPreference
  , favoriteChannelPreference

  , defaultUserPreferences
  , setUserPreferences

  , WebsocketAction(..)

  , Cmd(..)
  , commandName
  , CmdArgs(..)

  , MH
  , runMHEvent
  , scheduleUserFetches
  , scheduleUserStatusFetches
  , getScheduledUserFetches
  , getScheduledUserStatusFetches
  , mh
  , generateUUID
  , generateUUID_IO
  , mhSuspendAndResume
  , mhZoom
  , mhZoom'
  , mhContinueWithoutRedraw
  , St.gets
  , mhError

  , mhLog
  , mhGetIOLogger
  , ioLogWithManager
  , LogContext(..)
  , withLogContext
  , withLogContextChannelId
  , getLogContext
  , LogMessage(..)
  , LogCommand(..)
  , LogCategory(..)

  , LogManager(..)
  , startLoggingToFile
  , stopLoggingToFile
  , requestLogSnapshot
  , requestLogDestination
  , sendLogMessage

  , requestQuit
  , getMessageForPostId
  , getParentMessage
  , getReplyRootMessage
  , withChannel
  , withChannelOrDefault
  , userList
  , resetAutocomplete
  , isMine
  , setUserStatus
  , myUser
  , myUsername
  , myUserId
  , usernameForUserId
  , userByUsername
  , userByNickname
  , channelIdByChannelName
  , channelIdByUsername
  , userById
  , allUserIds
  , addNewUser
  , useNickname
  , useNickname'
  , displayNameForUserId
  , displayNameForUser
  , raiseInternalEvent
  , getNewMessageCutoff
  , getEditedMessageCutoff

  , HighlightSet(..)
  , UserSet
  , ChannelSet
  , getHighlightSet
  , emptyHSet

  , moveLeft
  , moveRight

  , module Matterhorn.Types.Core
  , module Matterhorn.Types.Channels
  , module Matterhorn.Types.EditState
  , module Matterhorn.Types.Messages
  , module Matterhorn.Types.MessageInterface
  , module Matterhorn.Types.TabbedWindow
  , module Matterhorn.Types.Posts
  , module Matterhorn.Types.Users
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           GHC.Stack ( HasCallStack )

import qualified Brick
import           Brick ( EventM, Widget(..), Size(..), Result )
import           Brick.Keybindings
import           Brick.Focus ( FocusRing )
import           Brick.Themes ( Theme )
import           Brick.Main ( invalidateCache, invalidateCacheEntry )
import           Brick.AttrMap ( AttrMap )
import qualified Brick.BChan as BCH
import           Brick.Forms (Form)
import           Brick.Widgets.Edit ( Editor, editor )
import           Brick.Widgets.List ( List )
import           Control.Concurrent ( ThreadId )
import           Control.Concurrent.Async ( Async )
import qualified Control.Concurrent.STM as STM
import           Control.Exception ( SomeException )
import qualified Control.Monad.State as St
import qualified Control.Monad.Reader as R
import qualified Data.Set as Set
import qualified Data.Foldable as F
import           Data.Function ( on )
import qualified Data.Kind as K
import           Data.Maybe ( fromJust )
import           Data.Ord ( comparing, Down(..) )
import qualified Data.HashMap.Strict as HM
import           Data.List ( sortBy, elemIndex, partition )
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import           Data.Time.Clock ( getCurrentTime, addUTCTime )
import           Data.UUID ( UUID )
import qualified Data.Vector as Vec
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( at, makeLenses, lens, (^?!), (.=)
                                     , (%=), (%~), (.~), _Just, Traversal', to
                                     , SimpleGetter, filtered, traversed, singular
                                     , zoom
                                     )
import           Network.Connection ( HostNotResolved, HostCannotConnect )
import           Skylighting.Types ( SyntaxMap )
import           System.Exit ( ExitCode )
import           System.Random ( randomIO )
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, WebsocketActionResponse )

import           Matterhorn.Constants ( normalChannelSigil )
import           Matterhorn.InputHistory
import           Matterhorn.Emoji
import           Matterhorn.Types.Common
import           Matterhorn.Types.Core
import           Matterhorn.Types.Channels
import           Matterhorn.Types.EditState
import           Matterhorn.Types.Messages
import           Matterhorn.Types.MessageInterface
import           Matterhorn.Types.NonemptyStack
import           Matterhorn.Types.Posts
import           Matterhorn.Types.RichText ( TeamBaseURL(..), TeamURLName(..) )
import           Matterhorn.Types.TabbedWindow
import           Matterhorn.Types.Users
import qualified Matterhorn.Zipper as Z


-- * Configuration

-- | A notification version for the external notifier
data NotificationVersion =
    NotifyV1
    | NotifyV2
    | NotifyV3
    deriving (NotificationVersion -> NotificationVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotificationVersion -> NotificationVersion -> Bool
$c/= :: NotificationVersion -> NotificationVersion -> Bool
== :: NotificationVersion -> NotificationVersion -> Bool
$c== :: NotificationVersion -> NotificationVersion -> Bool
Eq, ReadPrec [NotificationVersion]
ReadPrec NotificationVersion
Int -> ReadS NotificationVersion
ReadS [NotificationVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NotificationVersion]
$creadListPrec :: ReadPrec [NotificationVersion]
readPrec :: ReadPrec NotificationVersion
$creadPrec :: ReadPrec NotificationVersion
readList :: ReadS [NotificationVersion]
$creadList :: ReadS [NotificationVersion]
readsPrec :: Int -> ReadS NotificationVersion
$creadsPrec :: Int -> ReadS NotificationVersion
Read, Int -> NotificationVersion -> ShowS
[NotificationVersion] -> ShowS
NotificationVersion -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NotificationVersion] -> ShowS
$cshowList :: [NotificationVersion] -> ShowS
show :: NotificationVersion -> [Char]
$cshow :: NotificationVersion -> [Char]
showsPrec :: Int -> NotificationVersion -> ShowS
$cshowsPrec :: Int -> NotificationVersion -> ShowS
Show)

-- | A user password is either given to us directly, or a command
-- which we execute to find the password.
data PasswordSource =
    PasswordString Text
    | PasswordCommand Text
    deriving (PasswordSource -> PasswordSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PasswordSource -> PasswordSource -> Bool
$c/= :: PasswordSource -> PasswordSource -> Bool
== :: PasswordSource -> PasswordSource -> Bool
$c== :: PasswordSource -> PasswordSource -> Bool
Eq, ReadPrec [PasswordSource]
ReadPrec PasswordSource
Int -> ReadS PasswordSource
ReadS [PasswordSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PasswordSource]
$creadListPrec :: ReadPrec [PasswordSource]
readPrec :: ReadPrec PasswordSource
$creadPrec :: ReadPrec PasswordSource
readList :: ReadS [PasswordSource]
$creadList :: ReadS [PasswordSource]
readsPrec :: Int -> ReadS PasswordSource
$creadsPrec :: Int -> ReadS PasswordSource
Read, Int -> PasswordSource -> ShowS
[PasswordSource] -> ShowS
PasswordSource -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PasswordSource] -> ShowS
$cshowList :: [PasswordSource] -> ShowS
show :: PasswordSource -> [Char]
$cshow :: PasswordSource -> [Char]
showsPrec :: Int -> PasswordSource -> ShowS
$cshowsPrec :: Int -> PasswordSource -> ShowS
Show)

-- | An access token source.
data TokenSource =
    TokenString Text
    | TokenCommand Text
    deriving (TokenSource -> TokenSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenSource -> TokenSource -> Bool
$c/= :: TokenSource -> TokenSource -> Bool
== :: TokenSource -> TokenSource -> Bool
$c== :: TokenSource -> TokenSource -> Bool
Eq, ReadPrec [TokenSource]
ReadPrec TokenSource
Int -> ReadS TokenSource
ReadS [TokenSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TokenSource]
$creadListPrec :: ReadPrec [TokenSource]
readPrec :: ReadPrec TokenSource
$creadPrec :: ReadPrec TokenSource
readList :: ReadS [TokenSource]
$creadList :: ReadS [TokenSource]
readsPrec :: Int -> ReadS TokenSource
$creadsPrec :: Int -> ReadS TokenSource
Read, Int -> TokenSource -> ShowS
[TokenSource] -> ShowS
TokenSource -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TokenSource] -> ShowS
$cshowList :: [TokenSource] -> ShowS
show :: TokenSource -> [Char]
$cshow :: TokenSource -> [Char]
showsPrec :: Int -> TokenSource -> ShowS
$cshowsPrec :: Int -> TokenSource -> ShowS
Show)

-- | An OTP token source.
data OTPTokenSource =
    OTPTokenString Text
    | OTPTokenCommand Text
    deriving (OTPTokenSource -> OTPTokenSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OTPTokenSource -> OTPTokenSource -> Bool
$c/= :: OTPTokenSource -> OTPTokenSource -> Bool
== :: OTPTokenSource -> OTPTokenSource -> Bool
$c== :: OTPTokenSource -> OTPTokenSource -> Bool
Eq, ReadPrec [OTPTokenSource]
ReadPrec OTPTokenSource
Int -> ReadS OTPTokenSource
ReadS [OTPTokenSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OTPTokenSource]
$creadListPrec :: ReadPrec [OTPTokenSource]
readPrec :: ReadPrec OTPTokenSource
$creadPrec :: ReadPrec OTPTokenSource
readList :: ReadS [OTPTokenSource]
$creadList :: ReadS [OTPTokenSource]
readsPrec :: Int -> ReadS OTPTokenSource
$creadsPrec :: Int -> ReadS OTPTokenSource
Read, Int -> OTPTokenSource -> ShowS
[OTPTokenSource] -> ShowS
OTPTokenSource -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OTPTokenSource] -> ShowS
$cshowList :: [OTPTokenSource] -> ShowS
show :: OTPTokenSource -> [Char]
$cshow :: OTPTokenSource -> [Char]
showsPrec :: Int -> OTPTokenSource -> ShowS
$cshowsPrec :: Int -> OTPTokenSource -> ShowS
Show)


-- | The type of channel list group headings. Integer arguments indicate
-- total number of channels in the group that have unread activity.
data ChannelListGroup =
    ChannelListGroup { ChannelListGroup -> ChannelListGroupLabel
channelListGroupLabel :: ChannelListGroupLabel
                     , ChannelListGroup -> Int
channelListGroupUnread :: Int
                     , ChannelListGroup -> Bool
channelListGroupCollapsed :: Bool
                     , ChannelListGroup -> Int
channelListGroupEntries :: Int
                     }
                     deriving (ChannelListGroup -> ChannelListGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelListGroup -> ChannelListGroup -> Bool
$c/= :: ChannelListGroup -> ChannelListGroup -> Bool
== :: ChannelListGroup -> ChannelListGroup -> Bool
$c== :: ChannelListGroup -> ChannelListGroup -> Bool
Eq, Int -> ChannelListGroup -> ShowS
[ChannelListGroup] -> ShowS
ChannelListGroup -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListGroup] -> ShowS
$cshowList :: [ChannelListGroup] -> ShowS
show :: ChannelListGroup -> [Char]
$cshow :: ChannelListGroup -> [Char]
showsPrec :: Int -> ChannelListGroup -> ShowS
$cshowsPrec :: Int -> ChannelListGroup -> ShowS
Show)

nonDMChannelListGroupUnread :: ChannelListGroup -> Int
nonDMChannelListGroupUnread :: ChannelListGroup -> Int
nonDMChannelListGroupUnread ChannelListGroup
g =
    case ChannelListGroup -> ChannelListGroupLabel
channelListGroupLabel ChannelListGroup
g of
        ChannelListGroupLabel
ChannelGroupDirectMessages -> Int
0
        ChannelListGroupLabel
_ -> ChannelListGroup -> Int
channelListGroupUnread ChannelListGroup
g

data ChannelListSorting =
    ChannelListSortDefault
    | ChannelListSortUnreadFirst
    deriving (ChannelListSorting -> ChannelListSorting -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelListSorting -> ChannelListSorting -> Bool
$c/= :: ChannelListSorting -> ChannelListSorting -> Bool
== :: ChannelListSorting -> ChannelListSorting -> Bool
$c== :: ChannelListSorting -> ChannelListSorting -> Bool
Eq, Int -> ChannelListSorting -> ShowS
[ChannelListSorting] -> ShowS
ChannelListSorting -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListSorting] -> ShowS
$cshowList :: [ChannelListSorting] -> ShowS
show :: ChannelListSorting -> [Char]
$cshow :: ChannelListSorting -> [Char]
showsPrec :: Int -> ChannelListSorting -> ShowS
$cshowsPrec :: Int -> ChannelListSorting -> ShowS
Show, Eq ChannelListSorting
ChannelListSorting -> ChannelListSorting -> Bool
ChannelListSorting -> ChannelListSorting -> Ordering
ChannelListSorting -> ChannelListSorting -> ChannelListSorting
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChannelListSorting -> ChannelListSorting -> ChannelListSorting
$cmin :: ChannelListSorting -> ChannelListSorting -> ChannelListSorting
max :: ChannelListSorting -> ChannelListSorting -> ChannelListSorting
$cmax :: ChannelListSorting -> ChannelListSorting -> ChannelListSorting
>= :: ChannelListSorting -> ChannelListSorting -> Bool
$c>= :: ChannelListSorting -> ChannelListSorting -> Bool
> :: ChannelListSorting -> ChannelListSorting -> Bool
$c> :: ChannelListSorting -> ChannelListSorting -> Bool
<= :: ChannelListSorting -> ChannelListSorting -> Bool
$c<= :: ChannelListSorting -> ChannelListSorting -> Bool
< :: ChannelListSorting -> ChannelListSorting -> Bool
$c< :: ChannelListSorting -> ChannelListSorting -> Bool
compare :: ChannelListSorting -> ChannelListSorting -> Ordering
$ccompare :: ChannelListSorting -> ChannelListSorting -> Ordering
Ord)

data TeamListSorting =
    TeamListSortDefault
    | TeamListSortUnreadFirst
    deriving (TeamListSorting -> TeamListSorting -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamListSorting -> TeamListSorting -> Bool
$c/= :: TeamListSorting -> TeamListSorting -> Bool
== :: TeamListSorting -> TeamListSorting -> Bool
$c== :: TeamListSorting -> TeamListSorting -> Bool
Eq, Int -> TeamListSorting -> ShowS
[TeamListSorting] -> ShowS
TeamListSorting -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TeamListSorting] -> ShowS
$cshowList :: [TeamListSorting] -> ShowS
show :: TeamListSorting -> [Char]
$cshow :: TeamListSorting -> [Char]
showsPrec :: Int -> TeamListSorting -> ShowS
$cshowsPrec :: Int -> TeamListSorting -> ShowS
Show, Eq TeamListSorting
TeamListSorting -> TeamListSorting -> Bool
TeamListSorting -> TeamListSorting -> Ordering
TeamListSorting -> TeamListSorting -> TeamListSorting
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TeamListSorting -> TeamListSorting -> TeamListSorting
$cmin :: TeamListSorting -> TeamListSorting -> TeamListSorting
max :: TeamListSorting -> TeamListSorting -> TeamListSorting
$cmax :: TeamListSorting -> TeamListSorting -> TeamListSorting
>= :: TeamListSorting -> TeamListSorting -> Bool
$c>= :: TeamListSorting -> TeamListSorting -> Bool
> :: TeamListSorting -> TeamListSorting -> Bool
$c> :: TeamListSorting -> TeamListSorting -> Bool
<= :: TeamListSorting -> TeamListSorting -> Bool
$c<= :: TeamListSorting -> TeamListSorting -> Bool
< :: TeamListSorting -> TeamListSorting -> Bool
$c< :: TeamListSorting -> TeamListSorting -> Bool
compare :: TeamListSorting -> TeamListSorting -> Ordering
$ccompare :: TeamListSorting -> TeamListSorting -> Ordering
Ord)

-- | This is how we represent the user's configuration. Most fields
-- correspond to configuration file settings (see Config.hs) but some
-- are for internal book-keeping purposes only.
data Config =
    Config { Config -> Maybe Text
configUser :: Maybe Text
           -- ^ The username to use when connecting.
           , Config -> Maybe Text
configHost :: Maybe Text
           -- ^ The hostname to use when connecting.
           , Config -> Maybe Text
configTeam :: Maybe Text
           -- ^ The team name to use when connecting.
           , Config -> Int
configPort :: Int
           -- ^ The port to use when connecting.
           , Config -> Maybe Text
configUrlPath :: Maybe Text
           -- ^ The server path to use when connecting.
           , Config -> Maybe PasswordSource
configPass :: Maybe PasswordSource
           -- ^ The password source to use when connecting.
           , Config -> Maybe TokenSource
configToken :: Maybe TokenSource
           -- ^ The token source to use when connecting.
           , Config -> Maybe OTPTokenSource
configOTPToken :: Maybe OTPTokenSource
           -- ^ The OTP token source to use when connecting.
           , Config -> Maybe Text
configTimeFormat :: Maybe Text
           -- ^ The format string for timestamps.
           , Config -> Maybe Text
configDateFormat :: Maybe Text
           -- ^ The format string for dates.
           , Config -> Maybe Text
configTheme :: Maybe Text
           -- ^ The name of the theme to use.
           , Config -> Maybe Text
configThemeCustomizationFile :: Maybe Text
           -- ^ The path to the theme customization file, if any.
           , Config -> Bool
configSmartBacktick :: Bool
           -- ^ Whether to enable smart quoting characters.
           , Config -> Bool
configSmartEditing :: Bool
           -- ^ Whether to enable smart editing behaviors.
           , Config -> Maybe Text
configURLOpenCommand :: Maybe Text
           -- ^ The command to use to open URLs.
           , Config -> Bool
configURLOpenCommandInteractive :: Bool
           -- ^ Whether the URL-opening command is interactive (i.e.
           -- whether it should be given control of the terminal).
           , Config -> Maybe Text
configActivityNotifyCommand :: Maybe T.Text
           -- ^ The command to run for activity notifications.
           , Config -> NotificationVersion
configActivityNotifyVersion :: NotificationVersion
           -- ^ The activity notifier version.
           , Config -> Bool
configActivityBell :: Bool
           -- ^ Whether to ring the terminal bell on activity.
           , Config -> Maybe Int
configTruncateVerbatimBlocks :: Maybe Int
           -- ^ Whether to truncate verbatim (and code) blocks past a
           -- reasonable number of lines.
           , Config -> Bool
configShowMessageTimestamps :: Bool
           -- ^ Whether to show timestamps on messages.
           , Config -> BackgroundInfo
configShowBackground :: BackgroundInfo
           -- ^ Whether to show async background worker thread info.
           , Config -> Bool
configShowMessagePreview :: Bool
           -- ^ Whether to show the message preview area.
           , Config -> Bool
configShowChannelList :: Bool
           -- ^ Whether to show the channel list.
           , Config -> Bool
configShowExpandedChannelTopics :: Bool
           -- ^ Whether to show expanded channel topics.
           , Config -> Bool
configEnableAspell :: Bool
           -- ^ Whether to enable Aspell spell checking.
           , Config -> Maybe Text
configAspellDictionary :: Maybe Text
           -- ^ A specific Aspell dictionary name to use.
           , Config -> Bool
configUnsafeUseHTTP :: Bool
           -- ^ Whether to permit an insecure HTTP connection.
           , Config -> Bool
configValidateServerCertificate :: Bool
           -- ^ Whether to validate TLS certificates.
           , Config -> Int
configChannelListWidth :: Int
           -- ^ The width, in columns, of the channel list sidebar.
           , Config -> Int
configLogMaxBufferSize :: Int
           -- ^ The maximum size, in log entries, of the internal log
           -- message buffer.
           , Config -> Bool
configShowOlderEdits :: Bool
           -- ^ Whether to highlight the edit indicator on edits made
           -- prior to the beginning of the current session.
           , Config -> ChannelListSorting
configChannelListSorting :: ChannelListSorting
           -- ^ How to sort channels in each channel list group
           , Config -> TeamListSorting
configTeamListSorting :: TeamListSorting
           -- ^ How to sort teams in the team list
           , Config -> Bool
configShowTypingIndicator :: Bool
           -- ^ Whether to show the typing indicator when other users
           -- are typing
           , Config -> Bool
configSendTypingNotifications :: Bool
           -- Whether to send typing notifications to other users.
           , Config -> Maybe [Char]
configAbsPath :: Maybe FilePath
           -- ^ A book-keeping field for the absolute path to the
           -- configuration. (Not a user setting.)
           , Config -> KeyConfig KeyEvent
configUserKeys :: KeyConfig KeyEvent
           -- ^ The user's keybinding configuration.
           , Config -> Bool
configHyperlinkingMode :: Bool
           -- ^ Whether to enable terminal hyperlinking mode.
           , Config -> [[Char]]
configSyntaxDirs :: [FilePath]
           -- ^ The search path for syntax description XML files.
           , Config -> Int
configDirectChannelExpirationDays :: Int
           -- ^ The number of days to show a user in the channel menu after a direct
           -- message with them.
           , Config -> CPUUsagePolicy
configCpuUsagePolicy :: CPUUsagePolicy
           -- ^ The CPU usage policy for the application.
           , Config -> Maybe [Char]
configDefaultAttachmentPath :: Maybe FilePath
           -- ^ The default path for browsing attachments
           , Config -> ChannelListOrientation
configChannelListOrientation :: ChannelListOrientation
           -- ^ The orientation of the channel list.
           , Config -> ThreadOrientation
configThreadOrientation :: ThreadOrientation
           -- ^ The orientation of the thread window relative to the
           -- main channel message window.
           , Config -> Bool
configMouseMode :: Bool
           -- ^ Whether to enable mouse support in matterhorn
           , Config -> Bool
configShowLastOpenThread :: Bool
           -- ^ Whether to re-open a thread that was open the last time
           -- Matterhorn quit
           } deriving (Config -> Config -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

-- | The policy for CPU usage.
--
-- The idea is that Matterhorn can benefit from using multiple CPUs,
-- but the exact number is application-determined. We expose this policy
-- setting to the user in the configuration.
data CPUUsagePolicy =
    SingleCPU
    -- ^ Constrain the application to use one CPU.
    | MultipleCPUs
    -- ^ Permit the usage of multiple CPUs (the exact number is
    -- determined by the application).
    deriving (CPUUsagePolicy -> CPUUsagePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CPUUsagePolicy -> CPUUsagePolicy -> Bool
$c/= :: CPUUsagePolicy -> CPUUsagePolicy -> Bool
== :: CPUUsagePolicy -> CPUUsagePolicy -> Bool
$c== :: CPUUsagePolicy -> CPUUsagePolicy -> Bool
Eq, Int -> CPUUsagePolicy -> ShowS
[CPUUsagePolicy] -> ShowS
CPUUsagePolicy -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CPUUsagePolicy] -> ShowS
$cshowList :: [CPUUsagePolicy] -> ShowS
show :: CPUUsagePolicy -> [Char]
$cshow :: CPUUsagePolicy -> [Char]
showsPrec :: Int -> CPUUsagePolicy -> ShowS
$cshowsPrec :: Int -> CPUUsagePolicy -> ShowS
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 (BackgroundInfo -> BackgroundInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BackgroundInfo -> BackgroundInfo -> Bool
$c/= :: BackgroundInfo -> BackgroundInfo -> Bool
== :: BackgroundInfo -> BackgroundInfo -> Bool
$c== :: BackgroundInfo -> BackgroundInfo -> Bool
Eq, Int -> BackgroundInfo -> ShowS
[BackgroundInfo] -> ShowS
BackgroundInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundInfo] -> ShowS
$cshowList :: [BackgroundInfo] -> ShowS
show :: BackgroundInfo -> [Char]
$cshow :: BackgroundInfo -> [Char]
showsPrec :: Int -> BackgroundInfo -> ShowS
$cshowsPrec :: Int -> BackgroundInfo -> ShowS
Show)

data UserPreferences =
    UserPreferences { UserPreferences -> Bool
_userPrefShowJoinLeave :: Bool
                    , UserPreferences -> Seq FlaggedPost
_userPrefFlaggedPostList :: Seq FlaggedPost
                    , UserPreferences -> HashMap ChannelId Bool
_userPrefGroupChannelPrefs :: HashMap ChannelId Bool
                    , UserPreferences -> HashMap UserId Bool
_userPrefDirectChannelPrefs :: HashMap UserId Bool
                    , UserPreferences -> HashMap ChannelId Bool
_userPrefFavoriteChannelPrefs :: HashMap ChannelId Bool
                    , UserPreferences -> Maybe TeammateNameDisplayMode
_userPrefTeammateNameDisplayMode :: Maybe TeammateNameDisplayMode
                    , UserPreferences -> Maybe [TeamId]
_userPrefTeamOrder :: Maybe [TeamId]
                    }

hasUnread' :: ClientChannel -> Bool
hasUnread' :: ClientChannel -> Bool
hasUnread' ClientChannel
chan = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
    let info :: ChannelInfo
info = ClientChannel -> ChannelInfo
_ccInfo ClientChannel
chan
    ServerTime
lastViewTime <- ChannelInfo -> Maybe ServerTime
_cdViewed ChannelInfo
info
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChannelInfo -> Int
_cdMentionCount ChannelInfo
info forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
||
             (Bool -> Bool
not (ClientChannel -> Bool
isMuted ClientChannel
chan) Bool -> Bool -> Bool
&&
              (((ChannelInfo -> ServerTime
_cdUpdated ChannelInfo
info) forall a. Ord a => a -> a -> Bool
> ServerTime
lastViewTime) Bool -> Bool -> Bool
||
               (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ChannelInfo -> Maybe ServerTime
_cdEditedMessageThreshold ChannelInfo
info)))

mkChannelZipperList :: ChannelListSorting
                    -> UTCTime
                    -> Config
                    -> TeamId
                    -> Maybe ClientConfig
                    -> UserPreferences
                    -> HM.HashMap TeamId (Set ChannelListGroupLabel)
                    -> ClientChannels
                    -> Users
                    -> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList :: ChannelListSorting
-> UTCTime
-> Config
-> TeamId
-> Maybe ClientConfig
-> UserPreferences
-> HashMap TeamId (Set ChannelListGroupLabel)
-> ClientChannels
-> Users
-> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList ChannelListSorting
sorting UTCTime
now Config
config TeamId
tId Maybe ClientConfig
cconfig UserPreferences
prefs HashMap TeamId (Set ChannelListGroupLabel)
hidden ClientChannels
cs Users
us =
    let ([ChannelListEntry]
privFavs, [ChannelListEntry]
privEntries) = [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites forall a b. (a -> b) -> a -> b
$ TeamId
-> UserPreferences -> ClientChannels -> Type -> [ChannelListEntry]
getChannelEntriesByType TeamId
tId UserPreferences
prefs ClientChannels
cs Type
Private
        ([ChannelListEntry]
normFavs, [ChannelListEntry]
normEntries) = [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites forall a b. (a -> b) -> a -> b
$ TeamId
-> UserPreferences -> ClientChannels -> Type -> [ChannelListEntry]
getChannelEntriesByType TeamId
tId UserPreferences
prefs ClientChannels
cs Type
Ordinary
        ([ChannelListEntry]
dmFavs,   [ChannelListEntry]
dmEntries)   = [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites forall a b. (a -> b) -> a -> b
$ UTCTime
-> Config
-> Maybe ClientConfig
-> UserPreferences
-> Users
-> ClientChannels
-> [ChannelListEntry]
getDMChannelEntries UTCTime
now Config
config Maybe ClientConfig
cconfig UserPreferences
prefs Users
us ClientChannels
cs
        favEntries :: [ChannelListEntry]
favEntries              = [ChannelListEntry]
privFavs forall a. Semigroup a => a -> a -> a
<> [ChannelListEntry]
normFavs forall a. Semigroup a => a -> a -> a
<> [ChannelListEntry]
dmFavs
        isHidden :: ChannelListGroupLabel -> Bool
isHidden ChannelListGroupLabel
label =
            case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup TeamId
tId HashMap TeamId (Set ChannelListGroupLabel)
hidden of
                Maybe (Set ChannelListGroupLabel)
Nothing -> Bool
False
                Just Set ChannelListGroupLabel
s -> forall a. Ord a => a -> Set a -> Bool
Set.member ChannelListGroupLabel
label Set ChannelListGroupLabel
s
    in [ let unread :: Int
unread = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
favEntries
             coll :: Bool
coll = ChannelListGroupLabel -> Bool
isHidden ChannelListGroupLabel
ChannelGroupFavoriteChannels
         in ( ChannelListGroupLabel -> Int -> Bool -> Int -> ChannelListGroup
ChannelListGroup ChannelListGroupLabel
ChannelGroupFavoriteChannels Int
unread Bool
coll (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChannelListEntry]
favEntries)
            , if Bool
coll then forall a. Monoid a => a
mempty else ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries ChannelListSorting
sorting [ChannelListEntry]
favEntries
            )
       , let unread :: Int
unread = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
normEntries
             coll :: Bool
coll = ChannelListGroupLabel -> Bool
isHidden ChannelListGroupLabel
ChannelGroupPublicChannels
         in ( ChannelListGroupLabel -> Int -> Bool -> Int -> ChannelListGroup
ChannelListGroup ChannelListGroupLabel
ChannelGroupPublicChannels Int
unread Bool
coll (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChannelListEntry]
normEntries)
            , if Bool
coll then forall a. Monoid a => a
mempty else ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries ChannelListSorting
sorting [ChannelListEntry]
normEntries
            )
       , let unread :: Int
unread = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
privEntries
             coll :: Bool
coll = ChannelListGroupLabel -> Bool
isHidden ChannelListGroupLabel
ChannelGroupPrivateChannels
         in ( ChannelListGroupLabel -> Int -> Bool -> Int -> ChannelListGroup
ChannelListGroup ChannelListGroupLabel
ChannelGroupPrivateChannels Int
unread Bool
coll (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChannelListEntry]
privEntries)
            , if Bool
coll then forall a. Monoid a => a
mempty else ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries ChannelListSorting
sorting [ChannelListEntry]
privEntries
            )
       , let unread :: Int
unread = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
dmEntries
             coll :: Bool
coll = ChannelListGroupLabel -> Bool
isHidden ChannelListGroupLabel
ChannelGroupDirectMessages
         in ( ChannelListGroupLabel -> Int -> Bool -> Int -> ChannelListGroup
ChannelListGroup ChannelListGroupLabel
ChannelGroupDirectMessages Int
unread Bool
coll (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ChannelListEntry]
dmEntries)
            , if Bool
coll then forall a. Monoid a => a
mempty else [ChannelListEntry] -> [ChannelListEntry]
sortDMChannelListEntries [ChannelListEntry]
dmEntries
            )
       ]

sortChannelListEntries :: ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries :: ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries ChannelListSorting
ChannelListSortDefault =
    forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\ChannelListEntry
c -> (ChannelListEntry -> Bool
channelListEntryMuted ChannelListEntry
c, ChannelListEntry -> Text
channelListEntrySortValue ChannelListEntry
c)))
sortChannelListEntries ChannelListSorting
ChannelListSortUnreadFirst =
    forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelListEntry -> Bool
channelListEntryUnread)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ChannelListSorting -> [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries ChannelListSorting
ChannelListSortDefault

sortDMChannelListEntries :: [ChannelListEntry] -> [ChannelListEntry]
sortDMChannelListEntries :: [ChannelListEntry] -> [ChannelListEntry]
sortDMChannelListEntries = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ChannelListEntry -> ChannelListEntry -> Ordering
compareDMChannelListEntries

partitionFavorites :: [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites :: [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ChannelListEntry -> Bool
channelListEntryFavorite

getChannelEntriesByType :: TeamId -> UserPreferences -> ClientChannels -> Type -> [ChannelListEntry]
getChannelEntriesByType :: TeamId
-> UserPreferences -> ClientChannels -> Type -> [ChannelListEntry]
getChannelEntriesByType TeamId
tId UserPreferences
prefs ClientChannels
cs Type
ty =
    let matches :: (ChannelId, ClientChannel) -> Bool
matches (ChannelId
_, ClientChannel
info) = ClientChannel
infoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall a. Eq a => a -> a -> Bool
== Type
ty Bool -> Bool -> Bool
&&
                            ClientChannel
infoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just TeamId
tId
        pairs :: [(ChannelId, ClientChannel)]
pairs = ((ChannelId, ClientChannel) -> Bool)
-> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels (ChannelId, ClientChannel) -> Bool
matches ClientChannels
cs
        entries :: [ChannelListEntry]
entries = (ChannelId, ClientChannel) -> ChannelListEntry
mkEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ChannelId, ClientChannel)]
pairs
        mkEntry :: (ChannelId, ClientChannel) -> ChannelListEntry
mkEntry (ChannelId
cId, ClientChannel
ch) = ChannelListEntry { channelListEntryChannelId :: ChannelId
channelListEntryChannelId = ChannelId
cId
                                             , channelListEntryType :: ChannelListEntryType
channelListEntryType = ChannelListEntryType
CLChannel
                                             , channelListEntryMuted :: Bool
channelListEntryMuted = ClientChannel -> Bool
isMuted ClientChannel
ch
                                             , channelListEntryUnread :: Bool
channelListEntryUnread = ClientChannel -> Bool
hasUnread' ClientChannel
ch
                                             , channelListEntrySortValue :: Text
channelListEntrySortValue = ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdDisplayNameforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Text -> Text
T.toLower
                                             , channelListEntryFavorite :: Bool
channelListEntryFavorite = UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId
                                             }
    in [ChannelListEntry]
entries

getDMChannelEntries :: UTCTime
                    -> Config
                    -> Maybe ClientConfig
                    -> UserPreferences
                    -> Users
                    -> ClientChannels
                    -> [ChannelListEntry]
getDMChannelEntries :: UTCTime
-> Config
-> Maybe ClientConfig
-> UserPreferences
-> Users
-> ClientChannels
-> [ChannelListEntry]
getDMChannelEntries UTCTime
now Config
config Maybe ClientConfig
cconfig UserPreferences
prefs Users
us ClientChannels
cs =
    let oneOnOneDmChans :: [ChannelListEntry]
oneOnOneDmChans = UTCTime
-> Config
-> Maybe ClientConfig
-> UserPreferences
-> Users
-> ClientChannels
-> [ChannelListEntry]
getSingleDMChannelEntries UTCTime
now Config
config Maybe ClientConfig
cconfig UserPreferences
prefs Users
us ClientChannels
cs
        groupChans :: [ChannelListEntry]
groupChans = UTCTime
-> Config
-> UserPreferences
-> ClientChannels
-> [ChannelListEntry]
getGroupDMChannelEntries UTCTime
now Config
config UserPreferences
prefs ClientChannels
cs
    in [ChannelListEntry]
groupChans forall a. Semigroup a => a -> a -> a
<> [ChannelListEntry]
oneOnOneDmChans

compareDMChannelListEntries :: ChannelListEntry -> ChannelListEntry -> Ordering
compareDMChannelListEntries :: ChannelListEntry -> ChannelListEntry -> Ordering
compareDMChannelListEntries ChannelListEntry
e1 ChannelListEntry
e2 =
    let u1 :: Bool
u1 = ChannelListEntry -> Bool
channelListEntryUnread ChannelListEntry
e1
        u2 :: Bool
u2 = ChannelListEntry -> Bool
channelListEntryUnread ChannelListEntry
e2
        n1 :: Text
n1 = ChannelListEntry -> Text
channelListEntrySortValue ChannelListEntry
e1
        n2 :: Text
n2 = ChannelListEntry -> Text
channelListEntrySortValue ChannelListEntry
e2
    in if Bool
u1 forall a. Eq a => a -> a -> Bool
== Bool
u2
       then forall a. Ord a => a -> a -> Ordering
compare Text
n1 Text
n2
       else if Bool
u1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
u2
            then Ordering
LT
            else Ordering
GT

useNickname' :: Maybe ClientConfig -> UserPreferences -> Bool
useNickname' :: Maybe ClientConfig -> UserPreferences -> Bool
useNickname' Maybe ClientConfig
clientConfig UserPreferences
prefs =
    let serverSetting :: Maybe Bool
serverSetting = case Maybe ClientConfig
clientConfigforall s a. s -> Getting (First a) s a -> Maybe a
^?forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to ClientConfig -> TeammateNameDisplayMode
clientConfigTeammateNameDisplay of
            Just TeammateNameDisplayMode
TMNicknameOrFullname -> forall a. a -> Maybe a
Just Bool
True
            Maybe TeammateNameDisplayMode
_                         -> forall a. Maybe a
Nothing
        accountSetting :: Maybe Bool
accountSetting = (forall a. Eq a => a -> a -> Bool
== TeammateNameDisplayMode
TMNicknameOrFullname) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserPreferences -> Maybe TeammateNameDisplayMode
_userPrefTeammateNameDisplayMode UserPreferences
prefs)
        fallback :: Bool
fallback = Bool
False
    in forall a. a -> Maybe a -> a
fromMaybe Bool
fallback forall a b. (a -> b) -> a -> b
$ Maybe Bool
accountSetting forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool
serverSetting

displayNameForUser :: UserInfo -> Maybe ClientConfig -> UserPreferences -> Text
displayNameForUser :: UserInfo -> Maybe ClientConfig -> UserPreferences -> Text
displayNameForUser UserInfo
u Maybe ClientConfig
clientConfig UserPreferences
prefs
    | Maybe ClientConfig -> UserPreferences -> Bool
useNickname' Maybe ClientConfig
clientConfig UserPreferences
prefs =
        forall a. a -> Maybe a -> a
fromMaybe (UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Text
uiName) (UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo (Maybe Text)
uiNickName)
    | Bool
otherwise =
        UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Text
uiName

getGroupDMChannelEntries :: UTCTime
                         -> Config
                         -> UserPreferences
                         -> ClientChannels
                         -> [ChannelListEntry]
getGroupDMChannelEntries :: UTCTime
-> Config
-> UserPreferences
-> ClientChannels
-> [ChannelListEntry]
getGroupDMChannelEntries UTCTime
now Config
config UserPreferences
prefs ClientChannels
cs =
    let matches :: (ChannelId, ClientChannel) -> Bool
matches (ChannelId
_, ClientChannel
info) = ClientChannel
infoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall a. Eq a => a -> a -> Bool
== Type
Group Bool -> Bool -> Bool
&&
                            ClientChannel
infoforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                            UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
groupChannelShouldAppear UTCTime
now Config
config UserPreferences
prefs ClientChannel
info
    in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ChannelId
cId, ClientChannel
ch) -> ChannelListEntry { channelListEntryChannelId :: ChannelId
channelListEntryChannelId = ChannelId
cId
                                            , channelListEntryType :: ChannelListEntryType
channelListEntryType = ChannelListEntryType
CLGroupDM
                                            , channelListEntryMuted :: Bool
channelListEntryMuted = ClientChannel -> Bool
isMuted ClientChannel
ch
                                            , channelListEntryUnread :: Bool
channelListEntryUnread = ClientChannel -> Bool
hasUnread' ClientChannel
ch
                                            , channelListEntrySortValue :: Text
channelListEntrySortValue = ClientChannel
chforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdDisplayName
                                            , channelListEntryFavorite :: Bool
channelListEntryFavorite = UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId
                                            }) forall a b. (a -> b) -> a -> b
$
       ((ChannelId, ClientChannel) -> Bool)
-> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels (ChannelId, ClientChannel) -> Bool
matches ClientChannels
cs

getSingleDMChannelEntries :: UTCTime
                          -> Config
                          -> Maybe ClientConfig
                          -> UserPreferences
                          -> Users
                          -> ClientChannels
                          -> [ChannelListEntry]
getSingleDMChannelEntries :: UTCTime
-> Config
-> Maybe ClientConfig
-> UserPreferences
-> Users
-> ClientChannels
-> [ChannelListEntry]
getSingleDMChannelEntries UTCTime
now Config
config Maybe ClientConfig
cconfig UserPreferences
prefs Users
us ClientChannels
cs =
    let mapping :: [(UserId, ChannelId)]
mapping = ClientChannels -> [(UserId, ChannelId)]
allDmChannelMappings ClientChannels
cs
        mappingWithUserInfo :: [ChannelListEntry]
mappingWithUserInfo = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ (UserId, ChannelId) -> Maybe ChannelListEntry
getInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UserId, ChannelId)]
mapping
        getInfo :: (UserId, ChannelId) -> Maybe ChannelListEntry
getInfo (UserId
uId, ChannelId
cId) = do
            ClientChannel
c <- ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId ClientChannels
cs
            UserInfo
u <- UserId -> Users -> Maybe UserInfo
findUserById UserId
uId Users
us
            case UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Bool
uiDeleted of
                Bool
True -> forall a. Maybe a
Nothing
                Bool
False ->
                    if UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
dmChannelShouldAppear UTCTime
now Config
config UserPreferences
prefs ClientChannel
c
                    then forall (m :: * -> *) a. Monad m => a -> m a
return (ChannelListEntry { channelListEntryChannelId :: ChannelId
channelListEntryChannelId = ChannelId
cId
                                                  , channelListEntryType :: ChannelListEntryType
channelListEntryType = UserId -> ChannelListEntryType
CLUserDM UserId
uId
                                                  , channelListEntryMuted :: Bool
channelListEntryMuted = ClientChannel -> Bool
isMuted ClientChannel
c
                                                  , channelListEntryUnread :: Bool
channelListEntryUnread = ClientChannel -> Bool
hasUnread' ClientChannel
c
                                                  , channelListEntrySortValue :: Text
channelListEntrySortValue = UserInfo -> Maybe ClientConfig -> UserPreferences -> Text
displayNameForUser UserInfo
u Maybe ClientConfig
cconfig UserPreferences
prefs
                                                  , channelListEntryFavorite :: Bool
channelListEntryFavorite = UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId
                                                  })
                    else forall a. Maybe a
Nothing
    in [ChannelListEntry]
mappingWithUserInfo

-- | Return whether the specified channel has been marked as a favorite
-- channel.
isFavorite :: UserPreferences -> ChannelId -> Bool
isFavorite :: UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId = UserPreferences -> ChannelId -> Maybe Bool
favoriteChannelPreference UserPreferences
prefs ChannelId
cId forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True

-- Always show a DM channel if it has unread activity or has been marked
-- as a favorite.
--
-- If it has no unread activity and if the preferences explicitly say to
-- hide it, hide it.
--
-- Otherwise, only show it if at least one of the other conditions are
-- met (see 'or' below).
dmChannelShouldAppear :: UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
dmChannelShouldAppear :: UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
dmChannelShouldAppear UTCTime
now Config
config UserPreferences
prefs ClientChannel
c =
    let ndays :: Int
ndays = Config -> Int
configDirectChannelExpirationDays Config
config
        localCutoff :: UTCTime
localCutoff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
nominalDay forall a. Num a => a -> a -> a
* (-(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ndays))) UTCTime
now
        cutoff :: ServerTime
cutoff = UTCTime -> ServerTime
ServerTime UTCTime
localCutoff
        updated :: ServerTime
updated = ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ServerTime
cdUpdated
        uId :: UserId
uId = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UserId)
cdDMUserId
        cId :: ChannelId
cId = ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelId
cdChannelId
    in if UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId
       then Bool
True
       else (if ClientChannel -> Bool
hasUnread' ClientChannel
c Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
>= UTCTime
localCutoff) (ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride)
             then Bool
True
             else case UserPreferences -> UserId -> Maybe Bool
dmChannelShowPreference UserPreferences
prefs UserId
uId of
                    Just Bool
False -> Bool
False
                    Maybe Bool
_ -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
                                -- The channel was updated recently enough
                                ServerTime
updated forall a. Ord a => a -> a -> Bool
>= ServerTime
cutoff
                            ])

-- Always show a group DM channel if it has unread activity or has been
-- marked as a favorite.
--
-- If it has no unread activity and if the preferences explicitly say to
-- hide it, hide it.
--
-- Otherwise, only show it if at least one of the other conditions are
-- met (see 'or' below).
groupChannelShouldAppear :: UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
groupChannelShouldAppear :: UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
groupChannelShouldAppear UTCTime
now Config
config UserPreferences
prefs ClientChannel
c =
    let ndays :: Int
ndays = Config -> Int
configDirectChannelExpirationDays Config
config
        localCutoff :: UTCTime
localCutoff = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
nominalDay forall a. Num a => a -> a -> a
* (-(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ndays))) UTCTime
now
        cutoff :: ServerTime
cutoff = UTCTime -> ServerTime
ServerTime UTCTime
localCutoff
        updated :: ServerTime
updated = ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ServerTime
cdUpdated
        cId :: ChannelId
cId = ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo ChannelId
cdChannelId
    in if UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId
       then Bool
True
       else (if ClientChannel -> Bool
hasUnread' ClientChannel
c Bool -> Bool -> Bool
|| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
>= UTCTime
localCutoff) (ClientChannel
cforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe UTCTime)
cdSidebarShowOverride)
             then Bool
True
             else case UserPreferences -> ChannelId -> Maybe Bool
groupChannelShowPreference UserPreferences
prefs ChannelId
cId of
                    Just Bool
False -> Bool
False
                    Maybe Bool
_ -> forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
                                -- The channel was updated recently enough
                                ServerTime
updated forall a. Ord a => a -> a -> Bool
>= ServerTime
cutoff
                            ])

dmChannelShowPreference :: UserPreferences -> UserId -> Maybe Bool
dmChannelShowPreference :: UserPreferences -> UserId -> Maybe Bool
dmChannelShowPreference UserPreferences
ps UserId
uId = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup UserId
uId (UserPreferences -> HashMap UserId Bool
_userPrefDirectChannelPrefs UserPreferences
ps)

groupChannelShowPreference :: UserPreferences -> ChannelId -> Maybe Bool
groupChannelShowPreference :: UserPreferences -> ChannelId -> Maybe Bool
groupChannelShowPreference UserPreferences
ps ChannelId
cId = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ChannelId
cId (UserPreferences -> HashMap ChannelId Bool
_userPrefGroupChannelPrefs UserPreferences
ps)

favoriteChannelPreference :: UserPreferences -> ChannelId -> Maybe Bool
favoriteChannelPreference :: UserPreferences -> ChannelId -> Maybe Bool
favoriteChannelPreference UserPreferences
ps ChannelId
cId = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ChannelId
cId (UserPreferences -> HashMap ChannelId Bool
_userPrefFavoriteChannelPrefs UserPreferences
ps)

-- | Types that provide a "semantically equal" operation. Two values may
-- be semantically equal even if they are not equal according to Eq if,
-- for example, they are equal on the basis of some fields that are more
-- pertinent than others.
class (Show a, Eq a, Ord a) => SemEq a where
    semeq :: a -> a -> Bool

instance SemEq Name where
    semeq :: Name -> Name -> Bool
semeq (ClickableURL Maybe MessageId
mId1 Name
r1 Int
_ LinkTarget
t1) (ClickableURL Maybe MessageId
mId2 Name
r2 Int
_ LinkTarget
t2) = Maybe MessageId
mId1 forall a. Eq a => a -> a -> Bool
== Maybe MessageId
mId2 Bool -> Bool -> Bool
&& LinkTarget
t1 forall a. Eq a => a -> a -> Bool
== LinkTarget
t2 Bool -> Bool -> Bool
&& Name
r1 forall a. Eq a => a -> a -> Bool
== Name
r2
    semeq (ClickableUsername Maybe MessageId
mId1 Name
r1 Int
_ Text
n) (ClickableUsername Maybe MessageId
mId2 Name
r2 Int
_ Text
n2) = Maybe MessageId
mId1 forall a. Eq a => a -> a -> Bool
== Maybe MessageId
mId2 Bool -> Bool -> Bool
&& Text
n forall a. Eq a => a -> a -> Bool
== Text
n2 Bool -> Bool -> Bool
&& Name
r1 forall a. Eq a => a -> a -> Bool
== Name
r2
    semeq Name
a Name
b = Name
a forall a. Eq a => a -> a -> Bool
== Name
b

instance SemEq a => SemEq (Maybe a) where
    semeq :: Maybe a -> Maybe a -> Bool
semeq Maybe a
Nothing Maybe a
Nothing = Bool
True
    semeq (Just a
a) (Just a
b) = a
a forall a. SemEq a => a -> a -> Bool
`semeq` a
b
    semeq Maybe a
_ Maybe a
_ = Bool
False

-- | The sum type of exceptions we expect to encounter on authentication
-- failure. We encode them explicitly here so that we can print them in
-- a more user-friendly manner than just 'show'.
data AuthenticationException =
    ConnectError HostCannotConnect
    | ResolveError HostNotResolved
    | AuthIOError IOError
    | LoginError LoginFailureException
    | MattermostServerError MattermostError
    | OtherAuthError SomeException
    deriving (Int -> AuthenticationException -> ShowS
[AuthenticationException] -> ShowS
AuthenticationException -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationException] -> ShowS
$cshowList :: [AuthenticationException] -> ShowS
show :: AuthenticationException -> [Char]
$cshow :: AuthenticationException -> [Char]
showsPrec :: Int -> AuthenticationException -> ShowS
$cshowsPrec :: Int -> AuthenticationException -> ShowS
Show)

-- | Our 'ConnectionInfo' contains exactly as much information as is
-- necessary to start a connection with a Mattermost server. This is
-- built up during interactive authentication and then is used to log
-- in.
--
-- If the access token field is non-empty, that value is used and the
-- username and password values are ignored.
data ConnectionInfo =
    ConnectionInfo { ConnectionInfo -> Text
_ciHostname :: Text
                   , ConnectionInfo -> Int
_ciPort     :: Int
                   , ConnectionInfo -> Text
_ciUrlPath  :: Text
                   , ConnectionInfo -> Text
_ciUsername :: Text
                   , ConnectionInfo -> Maybe Text
_ciOTPToken :: Maybe Text
                   , ConnectionInfo -> Text
_ciPassword :: Text
                   , ConnectionInfo -> Text
_ciAccessToken :: Text
                   , ConnectionInfo -> ConnectionType
_ciType     :: ConnectionType
                   }

-- | 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
    deriving (PostRef -> PostRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostRef -> PostRef -> Bool
$c/= :: PostRef -> PostRef -> Bool
== :: PostRef -> PostRef -> Bool
$c== :: PostRef -> PostRef -> Bool
Eq, Int -> PostRef -> ShowS
[PostRef] -> ShowS
PostRef -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PostRef] -> ShowS
$cshowList :: [PostRef] -> ShowS
show :: PostRef -> [Char]
$cshow :: PostRef -> [Char]
showsPrec :: Int -> PostRef -> ShowS
$cshowsPrec :: Int -> PostRef -> ShowS
Show)

-- ** Channel-matching types

data ChannelSelectPattern = CSP MatchType Text
                          | CSPAny
                          deriving (ChannelSelectPattern -> ChannelSelectPattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelSelectPattern -> ChannelSelectPattern -> Bool
$c/= :: ChannelSelectPattern -> ChannelSelectPattern -> Bool
== :: ChannelSelectPattern -> ChannelSelectPattern -> Bool
$c== :: ChannelSelectPattern -> ChannelSelectPattern -> Bool
Eq, Int -> ChannelSelectPattern -> ShowS
[ChannelSelectPattern] -> ShowS
ChannelSelectPattern -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ChannelSelectPattern] -> ShowS
$cshowList :: [ChannelSelectPattern] -> ShowS
show :: ChannelSelectPattern -> [Char]
$cshow :: ChannelSelectPattern -> [Char]
showsPrec :: Int -> ChannelSelectPattern -> ShowS
$cshowsPrec :: Int -> ChannelSelectPattern -> ShowS
Show)

data MatchType =
    Prefix
    | Suffix
    | Infix
    | Equal
    | PrefixDMOnly
    | PrefixNonDMOnly
    deriving (MatchType -> MatchType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchType -> MatchType -> Bool
$c/= :: MatchType -> MatchType -> Bool
== :: MatchType -> MatchType -> Bool
$c== :: MatchType -> MatchType -> Bool
Eq, Int -> MatchType -> ShowS
[MatchType] -> ShowS
MatchType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MatchType] -> ShowS
$cshowList :: [MatchType] -> ShowS
show :: MatchType -> [Char]
$cshow :: MatchType -> [Char]
showsPrec :: Int -> MatchType -> ShowS
$cshowsPrec :: Int -> MatchType -> ShowS
Show)

-- * Application State Values

data ProgramOutput =
    ProgramOutput { ProgramOutput -> [Char]
program :: FilePath
                  , ProgramOutput -> [[Char]]
programArgs :: [String]
                  , ProgramOutput -> [Char]
programStdout :: String
                  , ProgramOutput -> [Char]
programStderr :: String
                  , ProgramOutput -> ExitCode
programExitCode :: ExitCode
                  }

defaultUserPreferences :: UserPreferences
defaultUserPreferences :: UserPreferences
defaultUserPreferences =
    UserPreferences { _userPrefShowJoinLeave :: Bool
_userPrefShowJoinLeave     = Bool
True
                    , _userPrefFlaggedPostList :: Seq FlaggedPost
_userPrefFlaggedPostList   = forall a. Monoid a => a
mempty
                    , _userPrefGroupChannelPrefs :: HashMap ChannelId Bool
_userPrefGroupChannelPrefs = forall a. Monoid a => a
mempty
                    , _userPrefDirectChannelPrefs :: HashMap UserId Bool
_userPrefDirectChannelPrefs = forall a. Monoid a => a
mempty
                    , _userPrefFavoriteChannelPrefs :: HashMap ChannelId Bool
_userPrefFavoriteChannelPrefs = forall a. Monoid a => a
mempty
                    , _userPrefTeammateNameDisplayMode :: Maybe TeammateNameDisplayMode
_userPrefTeammateNameDisplayMode = forall a. Maybe a
Nothing
                    , _userPrefTeamOrder :: Maybe [TeamId]
_userPrefTeamOrder = forall a. Maybe a
Nothing
                    }

setUserPreferences :: Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences :: Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr Preference -> UserPreferences -> UserPreferences
go)
    where go :: Preference -> UserPreferences -> UserPreferences
go Preference
p UserPreferences
u
            | Just FlaggedPost
fp <- Preference -> Maybe FlaggedPost
preferenceToFlaggedPost Preference
p =
              UserPreferences
u { _userPrefFlaggedPostList :: Seq FlaggedPost
_userPrefFlaggedPostList =
                  UserPreferences -> Seq FlaggedPost
_userPrefFlaggedPostList UserPreferences
u forall a. Seq a -> a -> Seq a
Seq.|> FlaggedPost
fp
                }
            | Just DirectChannelShowStatus
gp <- Preference -> Maybe DirectChannelShowStatus
preferenceToDirectChannelShowStatus Preference
p =
              UserPreferences
u { _userPrefDirectChannelPrefs :: HashMap UserId Bool
_userPrefDirectChannelPrefs =
                  forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert
                    (DirectChannelShowStatus -> UserId
directChannelShowUserId DirectChannelShowStatus
gp)
                    (DirectChannelShowStatus -> Bool
directChannelShowValue DirectChannelShowStatus
gp)
                    (UserPreferences -> HashMap UserId Bool
_userPrefDirectChannelPrefs UserPreferences
u)
                }
            | Just GroupChannelPreference
gp <- Preference -> Maybe GroupChannelPreference
preferenceToGroupChannelPreference Preference
p =
              UserPreferences
u { _userPrefGroupChannelPrefs :: HashMap ChannelId Bool
_userPrefGroupChannelPrefs =
                  forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert
                    (GroupChannelPreference -> ChannelId
groupChannelId GroupChannelPreference
gp)
                    (GroupChannelPreference -> Bool
groupChannelShow GroupChannelPreference
gp)
                    (UserPreferences -> HashMap ChannelId Bool
_userPrefGroupChannelPrefs UserPreferences
u)
                }
            | Just FavoriteChannelPreference
fp <- Preference -> Maybe FavoriteChannelPreference
preferenceToFavoriteChannelPreference Preference
p =
              UserPreferences
u { _userPrefFavoriteChannelPrefs :: HashMap ChannelId Bool
_userPrefFavoriteChannelPrefs =
                  forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert
                    (FavoriteChannelPreference -> ChannelId
favoriteChannelId FavoriteChannelPreference
fp)
                    (FavoriteChannelPreference -> Bool
favoriteChannelShow FavoriteChannelPreference
fp)
                    (UserPreferences -> HashMap ChannelId Bool
_userPrefFavoriteChannelPrefs UserPreferences
u)
                }
            | Just [TeamId]
tIds <- Preference -> Maybe [TeamId]
preferenceToTeamOrder Preference
p =
              UserPreferences
u { _userPrefTeamOrder :: Maybe [TeamId]
_userPrefTeamOrder = forall a. a -> Maybe a
Just [TeamId]
tIds
                }
            | Preference -> PreferenceName
preferenceName Preference
p forall a. Eq a => a -> a -> Bool
== Text -> PreferenceName
PreferenceName Text
"join_leave" =
              UserPreferences
u { _userPrefShowJoinLeave :: Bool
_userPrefShowJoinLeave =
                  Preference -> PreferenceValue
preferenceValue Preference
p forall a. Eq a => a -> a -> Bool
/= Text -> PreferenceValue
PreferenceValue Text
"false" }
            | Preference -> PreferenceCategory
preferenceCategory Preference
p forall a. Eq a => a -> a -> Bool
== PreferenceCategory
PreferenceCategoryDisplaySettings Bool -> Bool -> Bool
&&
              Preference -> PreferenceName
preferenceName Preference
p forall a. Eq a => a -> a -> Bool
== Text -> PreferenceName
PreferenceName Text
"name_format" =
                  let PreferenceValue Text
txt = Preference -> PreferenceValue
preferenceValue Preference
p
                  in UserPreferences
u { _userPrefTeammateNameDisplayMode :: Maybe TeammateNameDisplayMode
_userPrefTeammateNameDisplayMode = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> TeammateNameDisplayMode
teammateDisplayModeFromText Text
txt }
            | Bool
otherwise = UserPreferences
u

-- | Log message tags.
data LogCategory =
    LogGeneral
    | LogAPI
    | LogWebsocket
    | LogError
    | LogUserMark
    deriving (LogCategory -> LogCategory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogCategory -> LogCategory -> Bool
$c/= :: LogCategory -> LogCategory -> Bool
== :: LogCategory -> LogCategory -> Bool
$c== :: LogCategory -> LogCategory -> Bool
Eq, Int -> LogCategory -> ShowS
[LogCategory] -> ShowS
LogCategory -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogCategory] -> ShowS
$cshowList :: [LogCategory] -> ShowS
show :: LogCategory -> [Char]
$cshow :: LogCategory -> [Char]
showsPrec :: Int -> LogCategory -> ShowS
$cshowsPrec :: Int -> LogCategory -> ShowS
Show)

-- | A log message.
data LogMessage =
    LogMessage { LogMessage -> Text
logMessageText :: !Text
               -- ^ The text of the log message.
               , LogMessage -> Maybe LogContext
logMessageContext :: !(Maybe LogContext)
               -- ^ The optional context information relevant to the log
               -- message.
               , LogMessage -> LogCategory
logMessageCategory :: !LogCategory
               -- ^ The category of the log message.
               , LogMessage -> UTCTime
logMessageTimestamp :: !UTCTime
               -- ^ The timestamp of the log message.
               }
               deriving (LogMessage -> LogMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessage -> LogMessage -> Bool
$c/= :: LogMessage -> LogMessage -> Bool
== :: LogMessage -> LogMessage -> Bool
$c== :: LogMessage -> LogMessage -> Bool
Eq, Int -> LogMessage -> ShowS
[LogMessage] -> ShowS
LogMessage -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage] -> ShowS
$cshowList :: [LogMessage] -> ShowS
show :: LogMessage -> [Char]
$cshow :: LogMessage -> [Char]
showsPrec :: Int -> LogMessage -> ShowS
$cshowsPrec :: Int -> LogMessage -> ShowS
Show)

-- | A logging thread command.
data LogCommand =
    LogToFile FilePath
    -- ^ Start logging to the specified path.
    | LogAMessage !LogMessage
    -- ^ Log the specified message.
    | StopLogging
    -- ^ Stop any active logging.
    | ShutdownLogging
    -- ^ Shut down.
    | GetLogDestination
    -- ^ Ask the logging thread about its active logging destination.
    | LogSnapshot FilePath
    -- ^ Ask the logging thread to dump the current buffer to the
    -- specified destination.
    deriving (Int -> LogCommand -> ShowS
[LogCommand] -> ShowS
LogCommand -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogCommand] -> ShowS
$cshowList :: [LogCommand] -> ShowS
show :: LogCommand -> [Char]
$cshow :: LogCommand -> [Char]
showsPrec :: Int -> LogCommand -> ShowS
$cshowsPrec :: Int -> LogCommand -> ShowS
Show)

-- | A handle to the log manager thread.
data LogManager =
    LogManager { LogManager -> TChan LogCommand
logManagerCommandChannel :: STM.TChan LogCommand
               , LogManager -> Async ()
logManagerHandle :: Async ()
               }

startLoggingToFile :: LogManager -> FilePath -> IO ()
startLoggingToFile :: LogManager -> [Char] -> IO ()
startLoggingToFile LogManager
mgr [Char]
loc = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr forall a b. (a -> b) -> a -> b
$ [Char] -> LogCommand
LogToFile [Char]
loc

stopLoggingToFile :: LogManager -> IO ()
stopLoggingToFile :: LogManager -> IO ()
stopLoggingToFile LogManager
mgr = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr LogCommand
StopLogging

requestLogSnapshot :: LogManager -> FilePath -> IO ()
requestLogSnapshot :: LogManager -> [Char] -> IO ()
requestLogSnapshot LogManager
mgr [Char]
path = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr forall a b. (a -> b) -> a -> b
$ [Char] -> LogCommand
LogSnapshot [Char]
path

requestLogDestination :: LogManager -> IO ()
requestLogDestination :: LogManager -> IO ()
requestLogDestination LogManager
mgr = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr LogCommand
GetLogDestination

sendLogMessage :: LogManager -> LogMessage -> IO ()
sendLogMessage :: LogManager -> LogMessage -> IO ()
sendLogMessage LogManager
mgr LogMessage
lm = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr forall a b. (a -> b) -> a -> b
$ LogMessage -> LogCommand
LogAMessage LogMessage
lm

sendLogCommand :: LogManager -> LogCommand -> IO ()
sendLogCommand :: LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr LogCommand
c =
    forall a. STM a -> IO a
STM.atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
STM.writeTChan (LogManager -> TChan LogCommand
logManagerCommandChannel LogManager
mgr) LogCommand
c

-- | '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 { ChatResources -> Session
_crSession             :: Session
                  , ChatResources -> Maybe ThreadId
_crWebsocketThreadId   :: Maybe ThreadId
                  , ChatResources -> ConnectionData
_crConn                :: ConnectionData
                  , ChatResources -> RequestChan
_crRequestQueue        :: RequestChan
                  , ChatResources -> BChan MHEvent
_crEventQueue          :: BCH.BChan MHEvent
                  , ChatResources -> TChan ProgramOutput
_crSubprocessLog       :: STM.TChan ProgramOutput
                  , ChatResources -> TChan WebsocketAction
_crWebsocketActionChan :: STM.TChan WebsocketAction
                  , ChatResources -> AttrMap
_crTheme               :: AttrMap
                  , ChatResources -> TChan [UserId]
_crStatusUpdateChan    :: STM.TChan [UserId]
                  , ChatResources -> Config
_crConfiguration       :: Config
                  , ChatResources -> Set PostId
_crFlaggedPosts        :: Set PostId
                  , ChatResources -> UserPreferences
_crUserPreferences     :: UserPreferences
                  , ChatResources -> SyntaxMap
_crSyntaxMap           :: SyntaxMap
                  , ChatResources -> LogManager
_crLogManager          :: LogManager
                  , ChatResources -> EmojiCollection
_crEmoji               :: EmojiCollection
                  , ChatResources -> Maybe Aspell
_crSpellChecker        :: Maybe Aspell
                  }

-- | The 'GlobalEditState' value contains state not specific to any
-- single editor.
data GlobalEditState =
    GlobalEditState { GlobalEditState -> Text
_gedYankBuffer :: Text
                    }

emptyGlobalEditState :: GlobalEditState
emptyGlobalEditState :: GlobalEditState
emptyGlobalEditState =
    GlobalEditState { _gedYankBuffer :: Text
_gedYankBuffer   = Text
""
                    }

-- | 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 (Maybe (MH ())))

-- | Help topics
data HelpTopic =
    HelpTopic { HelpTopic -> Text
helpTopicName         :: Text
              , HelpTopic -> Text
helpTopicDescription  :: Text
              , HelpTopic -> HelpScreen
helpTopicScreen       :: HelpScreen
              }
              deriving (HelpTopic -> HelpTopic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelpTopic -> HelpTopic -> Bool
$c/= :: HelpTopic -> HelpTopic -> Bool
== :: HelpTopic -> HelpTopic -> Bool
$c== :: HelpTopic -> HelpTopic -> Bool
Eq, Int -> HelpTopic -> ShowS
[HelpTopic] -> ShowS
HelpTopic -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HelpTopic] -> ShowS
$cshowList :: [HelpTopic] -> ShowS
show :: HelpTopic -> [Char]
$cshow :: HelpTopic -> [Char]
showsPrec :: Int -> HelpTopic -> ShowS
$cshowsPrec :: Int -> HelpTopic -> ShowS
Show)

-- | Mode type for the current contents of the post list window
data PostListContents =
    PostListFlagged
    | PostListPinned ChannelId
    | PostListSearch Text Bool -- for the query and search status
    deriving (PostListContents -> PostListContents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PostListContents -> PostListContents -> Bool
$c/= :: PostListContents -> PostListContents -> Bool
== :: PostListContents -> PostListContents -> Bool
$c== :: PostListContents -> PostListContents -> Bool
Eq, Int -> PostListContents -> ShowS
[PostListContents] -> ShowS
PostListContents -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PostListContents] -> ShowS
$cshowList :: [PostListContents] -> ShowS
show :: PostListContents -> [Char]
$cshow :: PostListContents -> [Char]
showsPrec :: Int -> PostListContents -> ShowS
$cshowsPrec :: Int -> PostListContents -> ShowS
Show)

-- | The 'Mode' represents the current dominant UI activity
data Mode =
    Main
    | ShowHelp HelpTopic
    | ChannelSelect
    | LeaveChannelConfirm
    | DeleteChannelConfirm
    | MessageSelectDeleteConfirm MessageInterfaceTarget
    | PostListWindow PostListContents
    | UserListWindow
    | ReactionEmojiListWindow
    | ChannelListWindow
    | ThemeListWindow
    | ViewMessage
    | EditNotifyPrefs
    | ChannelTopicWindow
    deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> [Char]
$cshow :: Mode -> [Char]
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

-- | We're either connected or we're not.
data ConnectionStatus = Connected | Disconnected deriving (ConnectionStatus -> ConnectionStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionStatus -> ConnectionStatus -> Bool
$c/= :: ConnectionStatus -> ConnectionStatus -> Bool
== :: ConnectionStatus -> ConnectionStatus -> Bool
$c== :: ConnectionStatus -> ConnectionStatus -> Bool
Eq)

type ThreadInterface = MessageInterface Name PostId
type ChannelMessageInterface = MessageInterface Name ()

data ChannelListOrientation =
    ChannelListLeft
    -- ^ Show the channel list to the left of the message area.
    | ChannelListRight
    -- ^ Show the channel list to the right of the message area.
    deriving (ChannelListOrientation -> ChannelListOrientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelListOrientation -> ChannelListOrientation -> Bool
$c/= :: ChannelListOrientation -> ChannelListOrientation -> Bool
== :: ChannelListOrientation -> ChannelListOrientation -> Bool
$c== :: ChannelListOrientation -> ChannelListOrientation -> Bool
Eq, Int -> ChannelListOrientation -> ShowS
[ChannelListOrientation] -> ShowS
ChannelListOrientation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListOrientation] -> ShowS
$cshowList :: [ChannelListOrientation] -> ShowS
show :: ChannelListOrientation -> [Char]
$cshow :: ChannelListOrientation -> [Char]
showsPrec :: Int -> ChannelListOrientation -> ShowS
$cshowsPrec :: Int -> ChannelListOrientation -> ShowS
Show)

data ThreadOrientation =
    ThreadBelow
    -- ^ Show the thread below the channel message area.
    | ThreadAbove
    -- ^ Show the thread above the channel message area.
    | ThreadLeft
    -- ^ Show the thread to the left of the channel message area.
    | ThreadRight
    -- ^ Show the thread to the right of the channel message area.
    deriving (ThreadOrientation -> ThreadOrientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ThreadOrientation -> ThreadOrientation -> Bool
$c/= :: ThreadOrientation -> ThreadOrientation -> Bool
== :: ThreadOrientation -> ThreadOrientation -> Bool
$c== :: ThreadOrientation -> ThreadOrientation -> Bool
Eq, Int -> ThreadOrientation -> ShowS
[ThreadOrientation] -> ShowS
ThreadOrientation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ThreadOrientation] -> ShowS
$cshowList :: [ThreadOrientation] -> ShowS
show :: ThreadOrientation -> [Char]
$cshow :: ThreadOrientation -> [Char]
showsPrec :: Int -> ThreadOrientation -> ShowS
$cshowsPrec :: Int -> ThreadOrientation -> ShowS
Show)

-- | This type represents the current state of our application at any
-- given time.
data ChatState =
    ChatState { ChatState -> ChatResources
_csResources :: ChatResources
              -- ^ Global application-wide resources that don't change
              -- much.
              , ChatState -> Maybe (BrickEvent Name MHEvent)
_csLastMouseDownEvent :: Maybe (Brick.BrickEvent Name MHEvent)
              -- ^ The most recent mouse click event we got. We reset
              -- this on mouse up so we can ignore clicks whenever this
              -- is already set.
              , ChatState -> Maybe Int
_csVerbatimTruncateSetting :: Maybe Int
              -- ^ The current verbatim block truncation setting. This
              -- is used to toggle truncation behavior and is updated
              -- from the configTruncateVerbatimBlocks Config field.
              , ChatState -> HashMap TeamId TeamState
_csTeams :: HashMap TeamId TeamState
              -- ^ The state for each team that we are in.
              , ChatState -> Zipper () TeamId
_csTeamZipper :: Z.Zipper () TeamId
              -- ^ The list of teams we can cycle through.
              , ChatState -> ChannelListOrientation
_csChannelListOrientation :: ChannelListOrientation
              -- ^ The orientation of the channel list.
              , ChatState -> User
_csMe :: User
              -- ^ The authenticated user.
              , ChatState -> ClientChannels
_csChannels :: ClientChannels
              -- ^ The channels that we are showing, including their
              -- message lists.
              , ChatState -> HashMap TeamId (Set ChannelListGroupLabel)
_csHiddenChannelGroups :: HM.HashMap TeamId (Set ChannelListGroupLabel)
              -- ^ The set of channel list groups that are currently
              -- collapsed in the sidebar.
              , ChatState -> HashMap PostId Message
_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.
              , ChatState -> Users
_csUsers :: Users
              -- ^ All of the users we know about.
              , ChatState -> TimeZoneSeries
_timeZone :: TimeZoneSeries
              -- ^ The client time zone.
              , ChatState -> ConnectionStatus
_csConnectionStatus :: ConnectionStatus
              -- ^ Our view of the connection status.
              , ChatState -> Maybe (Maybe Int)
_csWorkerIsBusy :: Maybe (Maybe Int)
              -- ^ Whether the async worker thread is busy, and its
              -- queue length if so.
              , ChatState -> Maybe ClientConfig
_csClientConfig :: Maybe ClientConfig
              -- ^ The Mattermost client configuration, as we understand it.
              , ChatState -> InputHistory
_csInputHistory :: InputHistory
              -- ^ The map of per-channel input history for the
              -- application. We don't distribute the per-channel
              -- history into the per-channel states (like we do
              -- for other per-channel state) since keeping it
              -- under the InputHistory banner lets us use a nicer
              -- startup/shutdown disk file management API.
              , ChatState -> GlobalEditState
_csGlobalEditState :: GlobalEditState
              -- ^ Bits of global state common to all editors.
              }

-- | All application state specific to a team, along with state specific
-- to our user interface's presentation of that team. We include the
-- UI state relevant to the team so that we can easily switch which
-- team the UI is presenting without having to reinitialize the UI from
-- the new team. This allows the user to be engaged in just about any
-- application activity while viewing a team, switch to another team,
-- and return to the original team and resume what they were doing, all
-- without us doing any work.
data TeamState =
    TeamState { TeamState -> Zipper ChannelListGroup ChannelListEntry
_tsFocus :: Z.Zipper ChannelListGroup ChannelListEntry
              -- ^ The channel sidebar zipper that tracks which channel
              -- is selected.
              , TeamState -> Team
_tsTeam :: Team
              -- ^ The team data.
              , TeamState -> Maybe ChannelId
_tsRecentChannel :: Maybe ChannelId
              -- ^ The most recently-selected channel, if any.
              , TeamState -> Maybe ChannelId
_tsReturnChannel :: Maybe ChannelId
              -- ^ The channel to return to after visiting one or more
              -- unread channels.
              , TeamState -> NonemptyStack Mode
_tsModeStack :: NonemptyStack Mode
              -- ^ The current application mode stack when viewing this
              -- team. This is used to dispatch to different rendering
              -- and event handling routines. The current mode is always
              -- in at the top of the stack.
              , TeamState -> ChannelSelectState
_tsChannelSelectState :: ChannelSelectState
              -- ^ The state of the user's input and selection for
              -- channel selection mode.
              , TeamState -> Maybe PendingChannelChange
_tsPendingChannelChange :: Maybe PendingChannelChange
              -- ^ A pending channel change that we need to apply once
              -- the channel in question is available. We set this up
              -- when we need to change to a channel in the sidebar, but
              -- it isn't even there yet because we haven't loaded its
              -- metadata.
              , TeamState
-> Maybe
     (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
_tsViewedMessage :: Maybe (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
              -- ^ Set when the ViewMessage mode is active. The message
              -- being viewed. Note that this stores a message, not
              -- a message ID. That's because not all messages have
              -- message IDs (e.g. client messages) and we still
              -- want to support viewing of those messages. It's the
              -- responsibility of code that uses this message to always
              -- consult the chat state for the latest *version* of any
              -- message with an ID here, to be sure that the latest
              -- version is used (e.g. if it gets edited, etc.).
              , TeamState -> PostListWindowState
_tsPostListWindow :: PostListWindowState
              -- ^ The state of the post list window.
              , TeamState -> ListWindowState UserInfo UserSearchScope
_tsUserListWindow :: ListWindowState UserInfo UserSearchScope
              -- ^ The state of the user list window.
              , TeamState -> ListWindowState Channel ChannelSearchScope
_tsChannelListWindow :: ListWindowState Channel ChannelSearchScope
              -- ^ The state of the user list window.
              , TeamState -> Maybe (Form ChannelNotifyProps MHEvent Name)
_tsNotifyPrefs :: Maybe (Form ChannelNotifyProps MHEvent Name)
              -- ^ A form for editing the notification preferences for
              -- the current channel. This is set when entering
              -- EditNotifyPrefs mode and updated when the user
              -- changes the form state.
              , TeamState -> ChannelTopicDialogState
_tsChannelTopicDialog :: ChannelTopicDialogState
              -- ^ The state for the interactive channel topic editor
              -- window.
              , TeamState -> ListWindowState (Bool, Text) ()
_tsReactionEmojiListWindow :: ListWindowState (Bool, T.Text) ()
              -- ^ The state of the reaction emoji list window.
              , TeamState -> ListWindowState InternalTheme ()
_tsThemeListWindow :: ListWindowState InternalTheme ()
              -- ^ The state of the theme list window.
              , TeamState -> ChannelListSorting
_tsChannelListSorting :: ChannelListSorting
              -- ^ How to sort channels in this team's channel list
              -- groups
              , TeamState -> Maybe ThreadInterface
_tsThreadInterface :: Maybe ThreadInterface
              -- ^ The thread interface for this team for participating
              -- in a single thread
              , TeamState -> MessageInterfaceFocus
_tsMessageInterfaceFocus :: MessageInterfaceFocus
              -- ^ Which message interface is focused for editing input
              }

data MessageInterfaceFocus =
    FocusThread
    | FocusCurrentChannel
    deriving (MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
$c/= :: MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
== :: MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
$c== :: MessageInterfaceFocus -> MessageInterfaceFocus -> Bool
Eq, Int -> MessageInterfaceFocus -> ShowS
[MessageInterfaceFocus] -> ShowS
MessageInterfaceFocus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MessageInterfaceFocus] -> ShowS
$cshowList :: [MessageInterfaceFocus] -> ShowS
show :: MessageInterfaceFocus -> [Char]
$cshow :: MessageInterfaceFocus -> [Char]
showsPrec :: Int -> MessageInterfaceFocus -> ShowS
$cshowsPrec :: Int -> MessageInterfaceFocus -> ShowS
Show)

messageInterfaceFocusList :: [MessageInterfaceFocus]
messageInterfaceFocusList :: [MessageInterfaceFocus]
messageInterfaceFocusList =
    [ MessageInterfaceFocus
FocusCurrentChannel
    , MessageInterfaceFocus
FocusThread
    ]

messageInterfaceFocusNext :: TeamState -> TeamState
messageInterfaceFocusNext :: TeamState -> TeamState
messageInterfaceFocusNext = [MessageInterfaceFocus] -> TeamState -> TeamState
messageInterfaceFocusWith [MessageInterfaceFocus]
messageInterfaceFocusList

messageInterfaceFocusPrev :: TeamState -> TeamState
messageInterfaceFocusPrev :: TeamState -> TeamState
messageInterfaceFocusPrev = [MessageInterfaceFocus] -> TeamState -> TeamState
messageInterfaceFocusWith (forall a. [a] -> [a]
reverse [MessageInterfaceFocus]
messageInterfaceFocusList)

messageInterfaceFocusWith :: [MessageInterfaceFocus] -> TeamState -> TeamState
messageInterfaceFocusWith :: [MessageInterfaceFocus] -> TeamState -> TeamState
messageInterfaceFocusWith [MessageInterfaceFocus]
lst TeamState
ts =
    let next :: MessageInterfaceFocus
next = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe a
cycleElemAfter MessageInterfaceFocus
cur [MessageInterfaceFocus]
lst
        cur :: MessageInterfaceFocus
cur = TeamState -> MessageInterfaceFocus
_tsMessageInterfaceFocus TeamState
ts
        noThread :: Bool
noThread = forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ TeamState -> Maybe ThreadInterface
_tsThreadInterface TeamState
ts
        newFocus :: MessageInterfaceFocus
newFocus = if MessageInterfaceFocus
next forall a. Eq a => a -> a -> Bool
== MessageInterfaceFocus
FocusThread Bool -> Bool -> Bool
&& Bool
noThread
                   then forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe a
cycleElemAfter MessageInterfaceFocus
FocusThread [MessageInterfaceFocus]
lst
                   else MessageInterfaceFocus
next
    in TeamState
ts { _tsMessageInterfaceFocus :: MessageInterfaceFocus
_tsMessageInterfaceFocus = MessageInterfaceFocus
newFocus }

cycleElemAfter :: (Eq a) => a -> [a] -> Maybe a
cycleElemAfter :: forall a. Eq a => a -> [a] -> Maybe a
cycleElemAfter a
e [a]
es =
    if a
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
es
    then forall a. Maybe a
Nothing
    else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= a
e) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
cycle [a]
es

-- | Handles for the View Message window's tabs.
data ViewMessageWindowTab =
    VMTabMessage
    -- ^ The message tab.
    | VMTabReactions
    -- ^ The reactions tab.
    deriving (ViewMessageWindowTab -> ViewMessageWindowTab -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewMessageWindowTab -> ViewMessageWindowTab -> Bool
$c/= :: ViewMessageWindowTab -> ViewMessageWindowTab -> Bool
== :: ViewMessageWindowTab -> ViewMessageWindowTab -> Bool
$c== :: ViewMessageWindowTab -> ViewMessageWindowTab -> Bool
Eq, Int -> ViewMessageWindowTab -> ShowS
[ViewMessageWindowTab] -> ShowS
ViewMessageWindowTab -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ViewMessageWindowTab] -> ShowS
$cshowList :: [ViewMessageWindowTab] -> ShowS
show :: ViewMessageWindowTab -> [Char]
$cshow :: ViewMessageWindowTab -> [Char]
showsPrec :: Int -> ViewMessageWindowTab -> ShowS
$cshowsPrec :: Int -> ViewMessageWindowTab -> ShowS
Show)

data PendingChannelChange =
    ChangeByChannelId TeamId ChannelId (Maybe (MH ()))
    | ChangeByUserId UserId

-- | Startup state information that is constructed prior to building a
-- ChatState.
data StartupStateInfo =
    StartupStateInfo { StartupStateInfo -> ChatResources
startupStateResources      :: ChatResources
                     , StartupStateInfo -> User
startupStateConnectedUser  :: User
                     , StartupStateInfo -> HashMap TeamId TeamState
startupStateTeams          :: HM.HashMap TeamId TeamState
                     , StartupStateInfo -> TimeZoneSeries
startupStateTimeZone       :: TimeZoneSeries
                     , StartupStateInfo -> InputHistory
startupStateInitialHistory :: InputHistory
                     , StartupStateInfo -> TeamId
startupStateInitialTeam    :: TeamId
                     }

-- | The state of the channel topic editor window.
data ChannelTopicDialogState =
    ChannelTopicDialogState { ChannelTopicDialogState -> Editor Text Name
_channelTopicDialogEditor :: Editor T.Text Name
                            -- ^ The topic string editor state.
                            , ChannelTopicDialogState -> FocusRing Name
_channelTopicDialogFocus :: FocusRing Name
                            -- ^ The window focus state (editor/buttons)
                            }

sortTeamsAlpha :: [Team] -> [Team]
sortTeamsAlpha :: [Team] -> [Team]
sortTeamsAlpha =
    forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserText -> Text
sanitizeUserText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Team -> UserText
teamName))

matchesTeam :: T.Text -> Team -> Bool
matchesTeam :: Text -> Team -> Bool
matchesTeam Text
tName Team
t =
    let normalizeUserText :: UserText -> Text
normalizeUserText = Text -> Text
normalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserText -> Text
sanitizeUserText
        normalize :: Text -> Text
normalize = Text -> Text
T.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower
        urlName :: Text
urlName = UserText -> Text
normalizeUserText forall a b. (a -> b) -> a -> b
$ Team -> UserText
teamName Team
t
        displayName :: Text
displayName = UserText -> Text
normalizeUserText forall a b. (a -> b) -> a -> b
$ Team -> UserText
teamDisplayName Team
t
    in Text -> Text
normalize Text
tName forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
displayName, Text
urlName]

mkTeamZipperFromIds :: [TeamId] -> Z.Zipper () TeamId
mkTeamZipperFromIds :: [TeamId] -> Zipper () TeamId
mkTeamZipperFromIds [TeamId]
tIds = forall b a. Eq b => [(a, [b])] -> Zipper a b
Z.fromList [((), [TeamId]
tIds)]

teamZipperIds :: Z.Zipper () TeamId -> [TeamId]
teamZipperIds :: Zipper () TeamId -> [TeamId]
teamZipperIds = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Zipper a b -> [(a, [b])]
Z.toList

-- | The state of channel selection mode.
data ChannelSelectState =
    ChannelSelectState { ChannelSelectState -> Editor Text Name
_channelSelectInput :: Editor Text Name
                       , ChannelSelectState -> Zipper ChannelListGroup ChannelSelectMatch
_channelSelectMatches :: Z.Zipper ChannelListGroup ChannelSelectMatch
                       }

emptyChannelSelectState :: TeamId -> ChannelSelectState
emptyChannelSelectState :: TeamId -> ChannelSelectState
emptyChannelSelectState TeamId
tId =
    ChannelSelectState { _channelSelectInput :: Editor Text Name
_channelSelectInput = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ChannelSelectInput TeamId
tId) (forall a. a -> Maybe a
Just Int
1) Text
""
                       , _channelSelectMatches :: Zipper ChannelListGroup ChannelSelectMatch
_channelSelectMatches = forall b a. Eq b => [(a, [b])] -> Zipper a b
Z.fromList []
                       }

-- | The state of the post list window.
data PostListWindowState =
    PostListWindowState { PostListWindowState -> Messages
_postListPosts    :: Messages
                         , PostListWindowState -> Maybe PostId
_postListSelected :: Maybe PostId
                         }

data InternalTheme =
    InternalTheme { InternalTheme -> Text
internalThemeName :: Text
                  , InternalTheme -> Theme
internalTheme :: Theme
                  , InternalTheme -> Text
internalThemeDesc :: Text
                  }

-- | The state of the search result list window. Type 'a' is the type
-- of data in the list. Type 'b' is the search scope type.
data ListWindowState a b =
    ListWindowState { forall a b. ListWindowState a b -> List Name a
_listWindowSearchResults :: List Name a
                     -- ^ The list of search results currently shown in
                     -- the window.
                     , forall a b. ListWindowState a b -> Editor Text Name
_listWindowSearchInput :: Editor Text Name
                     -- ^ The editor for the window's search input.
                     , forall a b. ListWindowState a b -> b
_listWindowSearchScope :: b
                     -- ^ The window's current search scope.
                     , forall a b. ListWindowState a b -> Bool
_listWindowSearching :: Bool
                     -- ^ Whether a search is in progress (i.e. whether
                     -- we are currently awaiting a response from a
                     -- search query to the server).
                     , forall a b. ListWindowState a b -> a -> MH Bool
_listWindowEnterHandler :: a -> MH Bool
                     -- ^ The handler to invoke on the selected element
                     -- when the user presses Enter.
                     , forall a b. ListWindowState a b -> Vector a -> List Name a
_listWindowNewList :: Vec.Vector a -> List Name a
                     -- ^ The function to build a new brick List from a
                     -- vector of search results.
                     , forall a b.
ListWindowState a b -> b -> Session -> Text -> IO (Vector a)
_listWindowFetchResults :: b -> Session -> Text -> IO (Vec.Vector a)
                     -- ^ The function to call to issue a search query
                     -- to the server.
                     , forall a b. ListWindowState a b -> Maybe Int
_listWindowRecordCount :: Maybe Int
                     -- ^ The total number of available records, if known.
                     }

-- | The scope for searching for users in a user list window.
data UserSearchScope =
    ChannelMembers ChannelId TeamId
    | ChannelNonMembers ChannelId TeamId
    | AllUsers (Maybe TeamId)

-- | The scope for searching for channels to join.
data ChannelSearchScope =
    AllChannels

-- | Actions that can be sent on the websocket to the server.
data WebsocketAction =
    UserTyping UTCTime ChannelId (Maybe PostId) -- ^ user typing in the input box
    deriving (ReadPrec [WebsocketAction]
ReadPrec WebsocketAction
Int -> ReadS WebsocketAction
ReadS [WebsocketAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsocketAction]
$creadListPrec :: ReadPrec [WebsocketAction]
readPrec :: ReadPrec WebsocketAction
$creadPrec :: ReadPrec WebsocketAction
readList :: ReadS [WebsocketAction]
$creadList :: ReadS [WebsocketAction]
readsPrec :: Int -> ReadS WebsocketAction
$creadsPrec :: Int -> ReadS WebsocketAction
Read, Int -> WebsocketAction -> ShowS
[WebsocketAction] -> ShowS
WebsocketAction -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketAction] -> ShowS
$cshowList :: [WebsocketAction] -> ShowS
show :: WebsocketAction -> [Char]
$cshow :: WebsocketAction -> [Char]
showsPrec :: Int -> WebsocketAction -> ShowS
$cshowsPrec :: Int -> WebsocketAction -> ShowS
Show, WebsocketAction -> WebsocketAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsocketAction -> WebsocketAction -> Bool
$c/= :: WebsocketAction -> WebsocketAction -> Bool
== :: WebsocketAction -> WebsocketAction -> Bool
$c== :: WebsocketAction -> WebsocketAction -> Bool
Eq, Eq WebsocketAction
WebsocketAction -> WebsocketAction -> Bool
WebsocketAction -> WebsocketAction -> Ordering
WebsocketAction -> WebsocketAction -> WebsocketAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebsocketAction -> WebsocketAction -> WebsocketAction
$cmin :: WebsocketAction -> WebsocketAction -> WebsocketAction
max :: WebsocketAction -> WebsocketAction -> WebsocketAction
$cmax :: WebsocketAction -> WebsocketAction -> WebsocketAction
>= :: WebsocketAction -> WebsocketAction -> Bool
$c>= :: WebsocketAction -> WebsocketAction -> Bool
> :: WebsocketAction -> WebsocketAction -> Bool
$c> :: WebsocketAction -> WebsocketAction -> Bool
<= :: WebsocketAction -> WebsocketAction -> Bool
$c<= :: WebsocketAction -> WebsocketAction -> Bool
< :: WebsocketAction -> WebsocketAction -> Bool
$c< :: WebsocketAction -> WebsocketAction -> Bool
compare :: WebsocketAction -> WebsocketAction -> Ordering
$ccompare :: WebsocketAction -> WebsocketAction -> Ordering
Ord)

-- * MH Monad

-- | Logging context information, in the event that metadata should
-- accompany a log message.
data LogContext =
    LogContext { LogContext -> Maybe ChannelId
logContextChannelId :: Maybe ChannelId
               }
               deriving (LogContext -> LogContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogContext -> LogContext -> Bool
$c/= :: LogContext -> LogContext -> Bool
== :: LogContext -> LogContext -> Bool
$c== :: LogContext -> LogContext -> Bool
Eq, Int -> LogContext -> ShowS
[LogContext] -> ShowS
LogContext -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogContext] -> ShowS
$cshowList :: [LogContext] -> ShowS
show :: LogContext -> [Char]
$cshow :: LogContext -> [Char]
showsPrec :: Int -> LogContext -> ShowS
$cshowsPrec :: Int -> LogContext -> ShowS
Show)

-- | A user fetching strategy.
data UserFetch =
    UserFetchById UserId
    -- ^ Fetch the user with the specified ID.
    | UserFetchByUsername Text
    -- ^ Fetch the user with the specified username.
    | UserFetchByNickname Text
    -- ^ Fetch the user with the specified nickname.
    deriving (UserFetch -> UserFetch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserFetch -> UserFetch -> Bool
$c/= :: UserFetch -> UserFetch -> Bool
== :: UserFetch -> UserFetch -> Bool
$c== :: UserFetch -> UserFetch -> Bool
Eq, Int -> UserFetch -> ShowS
[UserFetch] -> ShowS
UserFetch -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UserFetch] -> ShowS
$cshowList :: [UserFetch] -> ShowS
show :: UserFetch -> [Char]
$cshow :: UserFetch -> [Char]
showsPrec :: Int -> UserFetch -> ShowS
$cshowsPrec :: Int -> UserFetch -> ShowS
Show)

data MHState =
    MHState { MHState -> [UserFetch]
mhUsersToFetch :: [UserFetch]
            , MHState -> Maybe [UserId]
mhPendingStatusList :: Maybe [UserId]
            }

-- | A value of type 'MH' @a@ represents a computation that can
-- manipulate the application state and also request that the
-- application quit
newtype MH a =
    MH { forall a.
MH a
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
fromMH :: R.ReaderT (Maybe LogContext) (St.StateT MHState (EventM Name ChatState)) a }

-- | Use a modified logging context for the duration of the specified MH
-- action.
withLogContext :: (Maybe LogContext -> Maybe LogContext) -> MH a -> MH a
withLogContext :: forall a. (Maybe LogContext -> Maybe LogContext) -> MH a -> MH a
withLogContext Maybe LogContext -> Maybe LogContext
modifyContext MH a
act =
    forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
R.withReaderT Maybe LogContext -> Maybe LogContext
modifyContext (forall a.
MH a
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
fromMH MH a
act)

withLogContextChannelId :: ChannelId -> MH a -> MH a
withLogContextChannelId :: forall a. ChannelId -> MH a -> MH a
withLogContextChannelId ChannelId
cId MH a
act =
    let f :: Maybe LogContext -> Maybe LogContext
f Maybe LogContext
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Maybe ChannelId -> LogContext
LogContext (forall a. a -> Maybe a
Just ChannelId
cId)
        f (Just LogContext
c) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ LogContext
c { logContextChannelId :: Maybe ChannelId
logContextChannelId = forall a. a -> Maybe a
Just ChannelId
cId }
    in forall a. (Maybe LogContext -> Maybe LogContext) -> MH a -> MH a
withLogContext Maybe LogContext -> Maybe LogContext
f MH a
act

-- | Get the current logging context.
getLogContext :: MH (Maybe LogContext)
getLogContext :: MH (Maybe LogContext)
getLogContext = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall r (m :: * -> *). MonadReader r m => m r
R.ask

-- | Log a message.
mhLog :: LogCategory -> Text -> MH ()
mhLog :: LogCategory -> Text -> MH ()
mhLog LogCategory
cat Text
msg = do
    LogCategory -> Text -> IO ()
logger <- MH (LogCategory -> Text -> IO ())
mhGetIOLogger
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ LogCategory -> Text -> IO ()
logger LogCategory
cat Text
msg

-- | Get a logger suitable for use in IO. The logger always logs using
-- the MH monad log context at the time of the call to mhGetIOLogger.
mhGetIOLogger :: MH (LogCategory -> Text -> IO ())
mhGetIOLogger :: MH (LogCategory -> Text -> IO ())
mhGetIOLogger = do
    Maybe LogContext
ctx <- MH (Maybe LogContext)
getLogContext
    LogManager
mgr <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (forall s a. (s -> a) -> SimpleGetter s a
to (ChatResources -> LogManager
_crLogManager forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatState -> ChatResources
_csResources))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LogManager -> Maybe LogContext -> LogCategory -> Text -> IO ()
ioLogWithManager LogManager
mgr Maybe LogContext
ctx

ioLogWithManager :: LogManager -> Maybe LogContext -> LogCategory -> Text -> IO ()
ioLogWithManager :: LogManager -> Maybe LogContext -> LogCategory -> Text -> IO ()
ioLogWithManager LogManager
mgr Maybe LogContext
ctx LogCategory
cat Text
msg = do
    UTCTime
now <- IO UTCTime
getCurrentTime
    let lm :: LogMessage
lm = LogMessage { logMessageText :: Text
logMessageText = Text
msg
                        , logMessageContext :: Maybe LogContext
logMessageContext = Maybe LogContext
ctx
                        , logMessageCategory :: LogCategory
logMessageCategory = LogCategory
cat
                        , logMessageTimestamp :: UTCTime
logMessageTimestamp = UTCTime
now
                        }
    LogManager -> LogMessage -> IO ()
sendLogMessage LogManager
mgr LogMessage
lm

-- | Run an 'MH' computation in 'EventM'.
runMHEvent :: MH () -> EventM Name ChatState ()
runMHEvent :: MH () -> EventM Name ChatState ()
runMHEvent (MH ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) ()
mote) = do
  let mhSt :: MHState
mhSt = MHState { mhUsersToFetch :: [UserFetch]
mhUsersToFetch = []
                     , mhPendingStatusList :: Maybe [UserId]
mhPendingStatusList = forall a. Maybe a
Nothing
                     }
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
St.runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) ()
mote forall a. Maybe a
Nothing) MHState
mhSt

scheduleUserFetches :: [UserFetch] -> MH ()
scheduleUserFetches :: [UserFetch] -> MH ()
scheduleUserFetches [UserFetch]
fs = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
St.modify forall a b. (a -> b) -> a -> b
$ \MHState
s -> MHState
s { mhUsersToFetch :: [UserFetch]
mhUsersToFetch = [UserFetch]
fs forall a. Semigroup a => a -> a -> a
<> MHState -> [UserFetch]
mhUsersToFetch MHState
s }

scheduleUserStatusFetches :: [UserId] -> MH ()
scheduleUserStatusFetches :: [UserId] -> MH ()
scheduleUserStatusFetches [UserId]
is = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
St.modify forall a b. (a -> b) -> a -> b
$ \MHState
s -> MHState
s { mhPendingStatusList :: Maybe [UserId]
mhPendingStatusList = forall a. a -> Maybe a
Just [UserId]
is }

getScheduledUserFetches :: MH [UserFetch]
getScheduledUserFetches :: MH [UserFetch]
getScheduledUserFetches = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
St.gets MHState -> [UserFetch]
mhUsersToFetch

getScheduledUserStatusFetches :: MH (Maybe [UserId])
getScheduledUserStatusFetches :: MH (Maybe [UserId])
getScheduledUserStatusFetches = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
St.gets MHState -> Maybe [UserId]
mhPendingStatusList

-- | lift a computation in 'EventM' into 'MH'
mh :: EventM Name ChatState a -> MH a
mh :: forall a. EventM Name ChatState a -> MH a
mh = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift

generateUUID :: MH UUID
generateUUID :: MH UUID
generateUUID = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UUID
generateUUID_IO

generateUUID_IO :: IO UUID
generateUUID_IO :: IO UUID
generateUUID_IO = forall a. Random a => IO a
randomIO

mhZoom :: Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom :: forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom Lens' ChatState b
ln e -> EventM Name b ()
f e
event = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' ChatState b
ln (e -> EventM Name b ()
f e
event)

mhZoom' :: Lens' ChatState b -> (EventM Name b ()) -> MH ()
mhZoom' :: forall b. Lens' ChatState b -> EventM Name b () -> MH ()
mhZoom' Lens' ChatState b
ln EventM Name b ()
f = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' ChatState b
ln EventM Name b ()
f

mhSuspendAndResume :: (ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume :: (ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume ChatState -> IO ChatState
act = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall a b. (a -> b) -> a -> b
$ do
    ChatState
st <- forall s (m :: * -> *). MonadState s m => m s
St.get
    forall n s. Ord n => IO s -> EventM n s ()
Brick.suspendAndResume (ChatState -> IO ChatState
act ChatState
st)

mhContinueWithoutRedraw :: MH ()
mhContinueWithoutRedraw :: MH ()
mhContinueWithoutRedraw = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall a b. (a -> b) -> a -> b
$ forall n s. EventM n s ()
Brick.continueWithoutRedraw

-- | This will request that after this computation finishes the
-- application should exit
requestQuit :: MH ()
requestQuit :: MH ()
requestQuit = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall a b. (a -> b) -> a -> b
$ forall n s. EventM n s ()
Brick.halt

instance Functor MH where
    fmap :: forall a b. (a -> b) -> MH a -> MH b
fmap a -> b
f (MH ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
x) = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
x)

instance Applicative MH where
    pure :: forall a. a -> MH a
pure a
x = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
    MH ReaderT
  (Maybe LogContext)
  (StateT MHState (EventM Name ChatState))
  (a -> b)
f <*> :: forall a b. MH (a -> b) -> MH a -> MH b
<*> MH ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
x = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH (ReaderT
  (Maybe LogContext)
  (StateT MHState (EventM Name ChatState))
  (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
x)

instance Monad MH where
    return :: forall a. a -> MH a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MH ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
x >>= :: forall a b. MH a -> (a -> MH b) -> MH b
>>= a -> MH b
f = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH (ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
x' -> forall a.
MH a
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
fromMH (a -> MH b
f a
x'))

instance St.MonadState ChatState MH where
    get :: MH ChatState
get = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall s (m :: * -> *). MonadState s m => m s
St.get
    put :: ChatState -> MH ()
put = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
St.put

instance St.MonadIO MH where
    liftIO :: forall a. IO a -> MH a
liftIO = forall a.
ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name ChatState)) a
-> MH a
MH forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
St.liftIO

-- | This represents events that we handle in the main application loop.
data MHEvent =
    WSEvent WebsocketEvent
    -- ^ For events that arise from the websocket
    | WSActionResponse WebsocketActionResponse
    -- ^ For responses to websocket actions
    | RespEvent (MH ())
    -- ^ For the result values of async IO operations
    | RefreshWebsocketEvent
    -- ^ Tell our main loop to refresh the websocket connection
    | WebsocketParseError String
    -- ^ We failed to parse an incoming websocket event
    | WebsocketDisconnect
    -- ^ The websocket connection went down.
    | WebsocketConnect
    -- ^ The websocket connection came up.
    | BGIdle
    -- ^ background worker is idle
    | BGBusy (Maybe Int)
    -- ^ background worker is busy (with n requests)
    | RateLimitExceeded Int
    -- ^ A request initially failed due to a rate limit but will be
    -- retried if possible. The argument is the number of seconds in
    -- which the retry will be attempted.
    | RateLimitSettingsMissing
    -- ^ A request denied by a rate limit could not be retried because
    -- the response contained no rate limit metadata
    | RequestDropped
    -- ^ A request was reattempted due to a rate limit and was rate
    -- limited again
    | IEvent InternalEvent
    -- ^ MH-internal events

-- | Internal application events.
data InternalEvent =
    DisplayError MHError
    -- ^ Some kind of application error occurred
    | LoggingStarted FilePath
    | LoggingStopped FilePath
    | LogStartFailed FilePath String
    | LogDestination (Maybe FilePath)
    | LogSnapshotSucceeded FilePath
    | LogSnapshotFailed FilePath String
    -- ^ Logging events from the logging thread

-- | 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
    | AttachmentException SomeException
    -- ^ IO operations for attaching a file threw an exception
    | BadAttachmentPath T.Text
    -- ^ The specified file is either a directory or doesn't exist
    | AsyncErrEvent SomeException
    -- ^ For errors that arise in the course of async IO operations
    deriving (Int -> MHError -> ShowS
[MHError] -> ShowS
MHError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MHError] -> ShowS
$cshowList :: [MHError] -> ShowS
show :: MHError -> [Char]
$cshow :: MHError -> [Char]
showsPrec :: Int -> MHError -> ShowS
$cshowsPrec :: Int -> MHError -> ShowS
Show)

-- ** Application State Lenses

makeLenses ''ChatResources
makeLenses ''ChatState
makeLenses ''TeamState
makeLenses ''GlobalEditState
makeLenses ''PostListWindowState
makeLenses ''ListWindowState
makeLenses ''ChannelSelectState
makeLenses ''UserPreferences
makeLenses ''ConnectionInfo
makeLenses ''ChannelTopicDialogState
Brick.suffixLenses ''Config

-- | Given a list of event handlers and an event, try to handle the
-- event with the handlers in the specified order. If a handler returns
-- False (indicating it did not handle the event), try the next handler
-- until either a handler returns True or all handlers are tried.
-- Returns True if any handler handled the event or False otherwise.
handleEventWith :: [Vty.Event -> MH Bool] -> Vty.Event -> MH Bool
handleEventWith :: [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [] Event
_ =
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
handleEventWith (Event -> MH Bool
handler:[Event -> MH Bool]
rest) Event
e = do
    Bool
handled <- Event -> MH Bool
handler Event
e
    if Bool
handled
       then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       else [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [Event -> MH Bool]
rest Event
e

applyTeamOrderPref :: Config -> Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref :: Config -> Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref Config
cfg Maybe [TeamId]
mPrefTIds ChatState
st =
    let teams :: HashMap TeamId TeamState
teams = ChatState -> HashMap TeamId TeamState
_csTeams ChatState
st
        ourTids :: [TeamId]
ourTids = forall k v. HashMap k v -> [k]
HM.keys HashMap TeamId TeamState
teams
        tIds :: [TeamId]
tIds = case Maybe [TeamId]
mPrefTIds of
            Maybe [TeamId]
Nothing -> []
            Just [TeamId]
prefTIds -> forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
ourTids) [TeamId]
prefTIds
        curTId :: Maybe TeamId
curTId = ChatState
stforall s a. s -> Getting a s a -> a
^.SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
        unmentioned :: [TeamState]
unmentioned = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamState -> Bool
wasMentioned) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [v]
HM.elems HashMap TeamId TeamState
teams
        wasMentioned :: TeamState -> Bool
wasMentioned TeamState
ts = (Team -> TeamId
teamId forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam TeamState
ts) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [TeamId]
tIds
        zipperTidsBeforeConfigSort :: [TeamId]
zipperTidsBeforeConfigSort = [TeamId]
tIds forall a. Semigroup a => a -> a -> a
<> (Team -> TeamId
teamId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Team] -> [Team]
sortTeamsAlpha (TeamState -> Team
_tsTeam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TeamState]
unmentioned))
        zipperTids :: [TeamId]
zipperTids = ChatState -> TeamListSorting -> [TeamId] -> [TeamId]
applyTeamSorting ChatState
st (Config
cfgforall s a. s -> Getting a s a -> a
^.Lens' Config TeamListSorting
configTeamListSortingL) [TeamId]
zipperTidsBeforeConfigSort
    in ChatState
st { _csTeamZipper :: Zipper () TeamId
_csTeamZipper = (forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight ((forall a. Eq a => a -> a -> Bool
== Maybe TeamId
curTId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall a b. (a -> b) -> a -> b
$ [TeamId] -> Zipper () TeamId
mkTeamZipperFromIds [TeamId]
zipperTids)
          }

applyTeamSorting :: ChatState -> TeamListSorting -> [TeamId] -> [TeamId]
applyTeamSorting :: ChatState -> TeamListSorting -> [TeamId] -> [TeamId]
applyTeamSorting ChatState
_ TeamListSorting
TeamListSortDefault [TeamId]
tIds = [TeamId]
tIds
applyTeamSorting ChatState
st TeamListSorting
TeamListSortUnreadFirst [TeamId]
tIds =
    let withCount :: TeamId -> (TeamId, Int)
withCount TeamId
tId = (TeamId
tId, TeamId -> ChatState -> Int
teamUnreadCount TeamId
tId ChatState
st)
        withCounts :: [(TeamId, Int)]
withCounts = TeamId -> (TeamId, Int)
withCount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TeamId]
tIds
        unreadFirst :: [(TeamId, Int)]
unreadFirst = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Ord a => a -> a -> Bool
> Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)) [(TeamId, Int)]
withCounts
    in forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(TeamId, Int)]
unreadFirst

refreshTeamZipper :: MH ()
refreshTeamZipper :: MH ()
refreshTeamZipper = do
    Config
config <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)
    Maybe [TeamId]
tidOrder <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferencesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' UserPreferences (Maybe [TeamId])
userPrefTeamOrder)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
St.modify (Config -> Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref Config
config Maybe [TeamId]
tidOrder)

applyTeamOrder :: [TeamId] -> MH ()
applyTeamOrder :: [TeamId] -> MH ()
applyTeamOrder [TeamId]
tIds = do
    Config
config <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
St.modify (Config -> Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref Config
config forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just [TeamId]
tIds)

newState :: StartupStateInfo -> ChatState
newState :: StartupStateInfo -> ChatState
newState (StartupStateInfo {HashMap TeamId TeamState
TeamId
User
TimeZoneSeries
InputHistory
ChatResources
startupStateInitialTeam :: TeamId
startupStateInitialHistory :: InputHistory
startupStateTimeZone :: TimeZoneSeries
startupStateTeams :: HashMap TeamId TeamState
startupStateConnectedUser :: User
startupStateResources :: ChatResources
startupStateInitialTeam :: StartupStateInfo -> TeamId
startupStateInitialHistory :: StartupStateInfo -> InputHistory
startupStateTimeZone :: StartupStateInfo -> TimeZoneSeries
startupStateTeams :: StartupStateInfo -> HashMap TeamId TeamState
startupStateConnectedUser :: StartupStateInfo -> User
startupStateResources :: StartupStateInfo -> ChatResources
..}) =
    let config :: Config
config = ChatResources -> Config
_crConfiguration ChatResources
startupStateResources
    in Config -> Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref Config
config (UserPreferences -> Maybe [TeamId]
_userPrefTeamOrder forall a b. (a -> b) -> a -> b
$ ChatResources -> UserPreferences
_crUserPreferences ChatResources
startupStateResources) forall a b. (a -> b) -> a -> b
$
       ChatState { _csResources :: ChatResources
_csResources                   = ChatResources
startupStateResources
                 , _csLastMouseDownEvent :: Maybe (BrickEvent Name MHEvent)
_csLastMouseDownEvent          = forall a. Maybe a
Nothing
                 , _csGlobalEditState :: GlobalEditState
_csGlobalEditState             = GlobalEditState
emptyGlobalEditState
                 , _csVerbatimTruncateSetting :: Maybe Int
_csVerbatimTruncateSetting     = Config -> Maybe Int
configTruncateVerbatimBlocks Config
config
                 , _csTeamZipper :: Zipper () TeamId
_csTeamZipper                  = forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight (forall a. Eq a => a -> a -> Bool
== TeamId
startupStateInitialTeam) forall a b. (a -> b) -> a -> b
$
                                                    [TeamId] -> Zipper () TeamId
mkTeamZipperFromIds forall a b. (a -> b) -> a -> b
$ Team -> TeamId
teamId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TeamState -> Team
_tsTeam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap TeamId TeamState
startupStateTeams)
                 , _csTeams :: HashMap TeamId TeamState
_csTeams                       = HashMap TeamId TeamState
startupStateTeams
                 , _csChannelListOrientation :: ChannelListOrientation
_csChannelListOrientation      = Config -> ChannelListOrientation
configChannelListOrientation Config
config
                 , _csMe :: User
_csMe                          = User
startupStateConnectedUser
                 , _csChannels :: ClientChannels
_csChannels                    = ClientChannels
noChannels
                 , _csPostMap :: HashMap PostId Message
_csPostMap                     = forall k v. HashMap k v
HM.empty
                 , _csUsers :: Users
_csUsers                       = Users
noUsers
                 , _timeZone :: TimeZoneSeries
_timeZone                      = TimeZoneSeries
startupStateTimeZone
                 , _csConnectionStatus :: ConnectionStatus
_csConnectionStatus            = ConnectionStatus
Connected
                 , _csWorkerIsBusy :: Maybe (Maybe Int)
_csWorkerIsBusy                = forall a. Maybe a
Nothing
                 , _csClientConfig :: Maybe ClientConfig
_csClientConfig                = forall a. Maybe a
Nothing
                 , _csInputHistory :: InputHistory
_csInputHistory                = InputHistory
startupStateInitialHistory
                 , _csHiddenChannelGroups :: HashMap TeamId (Set ChannelListGroupLabel)
_csHiddenChannelGroups         = forall a. Monoid a => a
mempty
                 }

getServerBaseUrl :: TeamId -> MH TeamBaseURL
getServerBaseUrl :: TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId = do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChatState -> TeamId -> TeamBaseURL
serverBaseUrl ChatState
st TeamId
tId

serverBaseUrl :: ChatState -> TeamId -> TeamBaseURL
serverBaseUrl :: ChatState -> TeamId -> TeamBaseURL
serverBaseUrl ChatState
st TeamId
tId =
    let baseUrl :: ServerBaseURL
baseUrl = ConnectionData -> ServerBaseURL
connectionDataURL forall a b. (a -> b) -> a -> b
$ ChatResources -> ConnectionData
_crConn forall a b. (a -> b) -> a -> b
$ ChatState -> ChatResources
_csResources ChatState
st
        tName :: UserText
tName = Team -> UserText
teamName forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState Team
tsTeam
    in TeamURLName -> ServerBaseURL -> TeamBaseURL
TeamBaseURL (Text -> TeamURLName
TeamURLName forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText UserText
tName) ServerBaseURL
baseUrl

getSession :: MH Session
getSession :: MH Session
getSession = forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Session
crSession)

getResourceSession :: ChatResources -> Session
getResourceSession :: ChatResources -> Session
getResourceSession = ChatResources -> Session
_crSession

whenMode :: TeamId -> Mode -> MH () -> MH ()
whenMode :: TeamId -> Mode -> MH () -> MH ()
whenMode TeamId
tId Mode
m MH ()
act = do
    Mode
curMode <- forall a. NonemptyStack a -> a
top forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (NonemptyStack Mode)
tsModeStack)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mode
curMode forall a. Eq a => a -> a -> Bool
== Mode
m) MH ()
act

pushMode :: TeamId -> Mode -> MH ()
pushMode :: TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
m = do
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
St.modify (TeamId -> Mode -> ChatState -> ChatState
pushMode' TeamId
tId Mode
m)
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache

replaceMode :: TeamId -> Mode -> MH ()
replaceMode :: TeamId -> Mode -> MH ()
replaceMode TeamId
tId Mode
m = TeamId -> MH ()
popMode TeamId
tId forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
m

popMode :: TeamId -> MH ()
popMode :: TeamId -> MH ()
popMode TeamId
tId = do
    NonemptyStack Mode
s <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (NonemptyStack Mode)
tsModeStack)
    let (NonemptyStack Mode
s', Maybe Mode
topVal) = forall a. NonemptyStack a -> (NonemptyStack a, Maybe a)
pop NonemptyStack Mode
s
    case Maybe Mode
topVal of
        Maybe Mode
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Mode
_ -> do
            TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (NonemptyStack Mode)
tsModeStack forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= NonemptyStack Mode
s'
            forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache

pushMode' :: TeamId -> Mode -> ChatState -> ChatState
pushMode' :: TeamId -> Mode -> ChatState -> ChatState
pushMode' TeamId
tId Mode
m ChatState
st =
    let s :: NonemptyStack Mode
s = ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (NonemptyStack Mode)
tsModeStack
    in if forall a. NonemptyStack a -> a
top NonemptyStack Mode
s forall a. Eq a => a -> a -> Bool
== Mode
m
       then ChatState
st
       else ChatState
st forall a b. a -> (a -> b) -> b
& TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (NonemptyStack Mode)
tsModeStack forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. a -> NonemptyStack a -> NonemptyStack a
push Mode
m)

-- ** Utility Lenses
csCurrentChannelId :: TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId :: TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId =
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocusforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall a b. Zipper a b -> Maybe b
Z.focusforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChannelListEntry -> ChannelId
channelListEntryChannelId)

teamUnreadCount :: TeamId -> ChatState -> Int
teamUnreadCount :: TeamId -> ChatState -> Int
teamUnreadCount TeamId
tId ChatState
st =
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ChannelListGroup -> Int
nonDMChannelListGroupUnread forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$
          forall a b. Zipper a b -> [(a, [b])]
Z.toList forall a b. (a -> b) -> a -> b
$
          ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus

withCurrentTeam :: (TeamId -> MH ()) -> MH ()
withCurrentTeam :: (TeamId -> MH ()) -> MH ()
withCurrentTeam TeamId -> MH ()
f = do
    Maybe TeamId
mtId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
    case Maybe TeamId
mtId of
        Maybe TeamId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just TeamId
tId -> TeamId -> MH ()
f TeamId
tId

withCurrentChannel :: TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel :: TeamId -> (ChannelId -> ClientChannel -> MH ()) -> MH ()
withCurrentChannel TeamId
tId ChannelId -> ClientChannel -> MH ()
f = do
    Maybe ChannelId
mcId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId
    case Maybe ChannelId
mcId of
        Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ChannelId
cId -> do
            Maybe ClientChannel
mChan <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ ChannelId -> Traversal' ChatState ClientChannel
csChannel ChannelId
cId
            case Maybe ClientChannel
mChan of
                Just ClientChannel
ch -> ChannelId -> ClientChannel -> MH ()
f ChannelId
cId ClientChannel
ch
                Maybe ClientChannel
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

withCurrentChannel' :: TeamId -> (ChannelId -> ClientChannel -> MH (Maybe a)) -> MH (Maybe a)
withCurrentChannel' :: forall a.
TeamId
-> (ChannelId -> ClientChannel -> MH (Maybe a)) -> MH (Maybe a)
withCurrentChannel' TeamId
tId ChannelId -> ClientChannel -> MH (Maybe a)
f = do
    Maybe ChannelId
mcId <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId TeamId
tId
    case Maybe ChannelId
mcId of
        Maybe ChannelId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just ChannelId
cId -> do
            Maybe ClientChannel
mChan <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse forall a b. (a -> b) -> a -> b
$ ChannelId -> Traversal' ChatState ClientChannel
csChannel ChannelId
cId
            case Maybe ClientChannel
mChan of
                Just ClientChannel
ch -> ChannelId -> ClientChannel -> MH (Maybe a)
f ChannelId
cId ClientChannel
ch
                Maybe ClientChannel
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

csCurrentTeamId :: SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId :: SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId = Lens' ChatState (Zipper () TeamId)
csTeamZipperforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall a b. Zipper a b -> Maybe b
Z.focus

csChannelMessageInterface :: ChannelId -> Lens' ChatState ChannelMessageInterface
csChannelMessageInterface :: ChannelId -> Lens' ChatState ChannelMessageInterface
csChannelMessageInterface ChannelId
cId =
    Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL ChannelId
cIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelMessageInterface
ccMessageInterface

maybeChannelMessageInterface :: ChannelId -> Traversal' ChatState ChannelMessageInterface
maybeChannelMessageInterface :: ChannelId -> Traversal' ChatState ChannelMessageInterface
maybeChannelMessageInterface ChannelId
cId =
    Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL ChannelId
cIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelMessageInterface
ccMessageInterface

channelEditor :: ChannelId -> Lens' ChatState (EditState Name)
channelEditor :: ChannelId -> Lens' ChatState (EditState Name)
channelEditor ChannelId
cId =
    Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL ChannelId
cIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelMessageInterface
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditor

channelMessageSelect :: ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect :: ChannelId -> Lens' ChatState MessageSelectState
channelMessageSelect ChannelId
cId =
    Lens' ChatState ClientChannels
csChannelsforall b c a. (b -> c) -> (a -> b) -> a -> c
.ChannelId -> Lens' ClientChannels (Maybe ClientChannel)
maybeChannelByIdL ChannelId
cIdforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ClientChannel ChannelMessageInterface
ccMessageInterfaceforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageSelectState
miMessageSelect

csTeam :: TeamId -> Lens' ChatState TeamState
csTeam :: TeamId -> Lens' ChatState TeamState
csTeam TeamId
tId =
    forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ ChatState
st -> ChatState
st forall s a. s -> Getting a s a -> a
^. Lens' ChatState (HashMap TeamId TeamState)
csTeams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
tId forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just)
         (\ ChatState
st TeamState
t -> ChatState
st forall a b. a -> (a -> b) -> b
& Lens' ChatState (HashMap TeamId TeamState)
csTeams forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TeamId
tId forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just TeamState
t)

teamMode :: TeamState -> Mode
teamMode :: TeamState -> Mode
teamMode = forall a. NonemptyStack a -> a
top forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamState -> NonemptyStack Mode
_tsModeStack

teamModes :: TeamState -> [Mode]
teamModes :: TeamState -> [Mode]
teamModes = forall a. NonemptyStack a -> [a]
stackToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamState -> NonemptyStack Mode
_tsModeStack

getTeamMode :: TeamId -> MH Mode
getTeamMode :: TeamId -> MH Mode
getTeamMode TeamId
tId = TeamState -> Mode
teamMode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId))

channelListEntryUserId :: ChannelListEntry -> Maybe UserId
channelListEntryUserId :: ChannelListEntry -> Maybe UserId
channelListEntryUserId ChannelListEntry
e =
    case ChannelListEntry -> ChannelListEntryType
channelListEntryType ChannelListEntry
e of
        CLUserDM UserId
uId -> forall a. a -> Maybe a
Just UserId
uId
        ChannelListEntryType
_ -> forall a. Maybe a
Nothing

userIdsFromZipper :: Z.Zipper ChannelListGroup ChannelListEntry -> [UserId]
userIdsFromZipper :: Zipper ChannelListGroup ChannelListEntry -> [UserId]
userIdsFromZipper Zipper ChannelListGroup ChannelListEntry
z =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ (forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChannelListEntry -> Maybe UserId
channelListEntryUserId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Zipper a b -> [(a, [b])]
Z.toList Zipper ChannelListGroup ChannelListEntry
z

entryIsDMEntry :: ChannelListEntry -> Bool
entryIsDMEntry :: ChannelListEntry -> Bool
entryIsDMEntry ChannelListEntry
e =
    case ChannelListEntry -> ChannelListEntryType
channelListEntryType ChannelListEntry
e of
        CLUserDM {} -> Bool
True
        CLGroupDM {} -> Bool
True
        CLChannel {} -> Bool
False

csChannel :: ChannelId -> Traversal' ChatState ClientChannel
csChannel :: ChannelId -> Traversal' ChatState ClientChannel
csChannel ChannelId
cId =
    Lens' ChatState ClientChannels
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelId -> Traversal' ClientChannels ClientChannel
channelByIdL ChannelId
cId

csChannelMessages :: ChannelId -> Traversal' ChatState Messages
csChannelMessages :: ChannelId -> Traversal' ChatState Messages
csChannelMessages ChannelId
cId =
    ChannelId -> Lens' ChatState ChannelMessageInterface
csChannelMessageInterface(ChannelId
cId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages

withChannel :: ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel :: ChannelId -> (ClientChannel -> MH ()) -> MH ()
withChannel ChannelId
cId = forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId ()

withChannelOrDefault :: ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault :: forall a. ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId a
deflt ClientChannel -> MH a
mote = do
    Maybe ClientChannel
chan <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId))
    case Maybe ClientChannel
chan of
        Maybe ClientChannel
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return a
deflt
        Just ClientChannel
c  -> ClientChannel -> MH a
mote ClientChannel
c

type MHKeyEventHandler = KeyEventHandler KeyEvent MH

mhHandleKeyboardEvent :: (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
                      -- ^ The function to build a key handler map from
                      -- a key configuration.
                      -> Vty.Event
                      -- ^ The event to handle.
                      -> MH Bool
mhHandleKeyboardEvent :: (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
mkDispatcher (Vty.EvKey Key
k [Modifier]
mods) = do
    Config
config <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)
    forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
handleKey (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
mkDispatcher forall a b. (a -> b) -> a -> b
$ Config -> KeyConfig KeyEvent
configUserKeys Config
config) Key
k [Modifier]
mods
mhHandleKeyboardEvent KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
_ Event
_ =
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

-- | Create a key dispatcher, but convert errors about conflict bindings
-- into a runtime exception with 'error'. Where we use this, it's safe
-- to use because we do a startup check for keybinding conflicts in
-- most application modes, which means that by the time we get around
-- to calling this function, the modes have already been checked and
-- have been found free of conflicts. However, there could be situations
-- in the future where we can't detect collisions at startup due to
-- dynamically built handler lists. In those cases, this would cause
-- the program to crash with a detailed error about the conflicting key
-- binding.
unsafeKeyDispatcher :: (Ord k) => KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher :: forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig k
cfg [KeyEventHandler k m]
hs =
    case forall k (m :: * -> *).
Ord k =>
KeyConfig k
-> [KeyEventHandler k m]
-> Either [(Binding, [KeyHandler k m])] (KeyDispatcher k m)
keyDispatcher KeyConfig k
cfg [KeyEventHandler k m]
hs of
        Right KeyDispatcher k m
d -> KeyDispatcher k m
d
        Left [(Binding, [KeyHandler k m])]
conflicts ->
            forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"Error: conflicting key bindings:\n" forall a. Semigroup a => a -> a -> a
<>
                               forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [(Binding, [KeyHandler k m])] -> Text
bindingConflictMessage KeyConfig k
cfg [(Binding, [KeyHandler k m])]
conflicts

bindingConflictMessage :: (Ord k) => KeyConfig k -> [(Binding, [KeyHandler k m])] -> T.Text
bindingConflictMessage :: forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [(Binding, [KeyHandler k m])] -> Text
bindingConflictMessage KeyConfig k
cfg [(Binding, [KeyHandler k m])]
conflicts = Text
msg
    where
        msg :: Text
msg = Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
sections
        sections :: [Text]
sections = (Binding, [KeyHandler k m]) -> Text
mkSection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Binding, [KeyHandler k m])]
conflicts
        mkSection :: (Binding, [KeyHandler k m]) -> Text
mkSection (Binding
key, [KeyHandler k m]
handlers) =
            let handlerLines :: [Text]
handlerLines = KeyHandler k m -> Text
handlerLine forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyHandler k m]
handlers
                handlerLine :: KeyHandler k m -> Text
handlerLine KeyHandler k m
h =
                    let desc :: Text
desc = forall (m :: * -> *). Handler m -> Text
handlerDescription forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyEventHandler k m -> Handler m
kehHandler forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler KeyHandler k m
h
                        trigger :: Text
trigger = case forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger forall a b. (a -> b) -> a -> b
$ forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler KeyHandler k m
h of
                            ByEvent k
e -> Text
"event '" forall a. Semigroup a => a -> a -> a
<> forall a. HasCallStack => Maybe a -> a
fromJust (forall k. Ord k => KeyEvents k -> k -> Maybe Text
keyEventName (forall k. KeyConfig k -> KeyEvents k
keyConfigEvents KeyConfig k
cfg) k
e) forall a. Semigroup a => a -> a -> a
<> Text
"'"
                            ByKey Binding
b -> Text
"fixed key '" forall a. Semigroup a => a -> a -> a
<> Binding -> Text
ppBinding Binding
b forall a. Semigroup a => a -> a -> a
<> Text
"'"
                    in Text
"  '" forall a. Semigroup a => a -> a -> a
<> Text
desc forall a. Semigroup a => a -> a -> a
<> Text
"', triggered by " forall a. Semigroup a => a -> a -> a
<> Text
trigger
            in Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ [ Text
"Conflicting key binding: " forall a. Semigroup a => a -> a -> a
<> Binding -> Text
ppBinding Binding
key
                                    , Text
"Handlers:"
                                    ] forall a. Semigroup a => a -> a -> a
<> [Text]
handlerLines

-- ** 'ChatState' Helper Functions

raiseInternalEvent :: InternalEvent -> MH ()
raiseInternalEvent :: InternalEvent -> MH ()
raiseInternalEvent InternalEvent
ev = do
    BChan MHEvent
queue <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (BChan MHEvent)
crEventQueue)
    forall (m :: * -> *). MonadIO m => BChan MHEvent -> MHEvent -> m ()
writeBChan BChan MHEvent
queue (InternalEvent -> MHEvent
IEvent InternalEvent
ev)

writeBChan :: (MonadIO m) => BCH.BChan MHEvent -> MHEvent -> m ()
writeBChan :: forall (m :: * -> *). MonadIO m => BChan MHEvent -> MHEvent -> m ()
writeBChan BChan MHEvent
chan MHEvent
e = do
    Bool
written <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. BChan a -> a -> IO Bool
BCH.writeBChanNonBlocking BChan MHEvent
chan MHEvent
e
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
written) forall a b. (a -> b) -> a -> b
$
        forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"mhSendEvent: BChan full, please report this as a bug!"

-- | Log and raise an error.
mhError :: MHError -> MH ()
mhError :: MHError -> MH ()
mhError MHError
err = do
    LogCategory -> Text -> MH ()
mhLog LogCategory
LogError forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show MHError
err
    InternalEvent -> MH ()
raiseInternalEvent (MHError -> InternalEvent
DisplayError MHError
err)

isMine :: ChatState -> Message -> Bool
isMine :: ChatState -> Message -> Bool
isMine ChatState
st Message
msg =
    case Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message UserRef
mUser of
        UserI Bool
_ UserId
uid -> UserId
uid forall a. Eq a => a -> a -> Bool
== ChatState -> UserId
myUserId ChatState
st
        UserRef
_ -> Bool
False

getMessageForPostId :: ChatState -> PostId -> Maybe Message
getMessageForPostId :: ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
pId = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(PostId
pId)

getParentMessage :: ChatState -> Message -> Maybe Message
getParentMessage :: ChatState -> Message -> Maybe Message
getParentMessage ChatState
st Message
msg
    | InReplyTo PostId
pId <- Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message ReplyState
mInReplyToMsg
      = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (HashMap PostId Message)
csPostMapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(PostId
pId)
    | Bool
otherwise = forall a. Maybe a
Nothing

getReplyRootMessage :: Message -> MH Message
getReplyRootMessage :: Message -> MH Message
getReplyRootMessage Message
msg = do
    case Post -> Maybe PostId
postRootId forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Message
msgforall s a. s -> Getting a s a -> a
^.Lens' Message (Maybe Post)
mOriginalPost) of
        Maybe PostId
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Message
msg
        Just PostId
rootId -> do
            ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id
            case ChatState -> PostId -> Maybe Message
getMessageForPostId ChatState
st PostId
rootId of
                -- NOTE: this case should never happen. This is the
                -- case where a message has a root post ID but we
                -- don't have a copy of the root post in storage. This
                -- shouldn't happen because whenever we add a message
                -- to a channel, we always fetch the parent post and
                -- store it if it is in a thread. That should mean that
                -- whenever we reply to a post, if that post is itself
                -- a reply, we should have its root post in storage
                -- and this case should never match. Even though it
                -- shouldn't happen, rather than raising a BUG exception
                -- here we'll just fall back to the input message.
                Maybe Message
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Message
msg
                Just Message
m -> forall (m :: * -> *) a. Monad m => a -> m a
return Message
m

setUserStatus :: UserId -> Text -> MH ()
setUserStatus :: UserId -> Text -> MH ()
setUserStatus UserId
uId Text
t = do
    Lens' ChatState Users
csUsers forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= UserId -> (UserInfo -> UserInfo) -> Users -> Users
modifyUserById UserId
uId (Lens' UserInfo UserStatus
uiStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> UserStatus
statusFromText Text
t)
    ClientChannels
cs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState ClientChannels
csChannels
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ClientChannels -> [TeamId]
allTeamIds ClientChannels
cs) forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
        forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry forall a b. (a -> b) -> a -> b
$ TeamId -> Name
ChannelSidebar TeamId
tId

usernameForUserId :: UserId -> ChatState -> Maybe Text
usernameForUserId :: UserId -> ChatState -> Maybe Text
usernameForUserId UserId
uId ChatState
st = UserInfo -> Text
_uiName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId -> Users -> Maybe UserInfo
findUserById UserId
uId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)

displayNameForUserId :: UserId -> ChatState -> Maybe Text
displayNameForUserId :: UserId -> ChatState -> Maybe Text
displayNameForUserId UserId
uId ChatState
st = do
    UserInfo
u <- UserId -> Users -> Maybe UserInfo
findUserById UserId
uId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UserInfo -> Maybe ClientConfig -> UserPreferences -> Text
displayNameForUser UserInfo
u (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (Maybe ClientConfig)
csClientConfig) (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferences)

-- | Note: this only searches users we have already loaded. Be
-- aware that if you think you need a user we haven't fetched, use
-- withFetchedUser!
userIdForUsername :: Text -> ChatState -> Maybe UserId
userIdForUsername :: Text -> ChatState -> Maybe UserId
userIdForUsername Text
name ChatState
st =
    forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Users -> Maybe (UserId, UserInfo)
findUserByUsername Text
name forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)

channelIdByChannelName :: TeamId -> Text -> ChatState -> Maybe ChannelId
channelIdByChannelName :: TeamId -> Text -> ChatState -> Maybe ChannelId
channelIdByChannelName TeamId
tId Text
name ChatState
st =
    let matches :: (ChannelId, ClientChannel) -> Bool
matches (ChannelId
_, ClientChannel
cc) = ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdName forall a. Eq a => a -> a -> Bool
== (Text -> Text
trimChannelSigil Text
name) Bool -> Bool -> Bool
&&
                          ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe TeamId)
cdTeamId forall a. Eq a => a -> a -> Bool
== (forall a. a -> Maybe a
Just TeamId
tId)
    in forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ChannelId, ClientChannel) -> Bool)
-> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels (ChannelId, ClientChannel) -> Bool
matches (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels)

channelIdByUsername :: Text -> ChatState -> Maybe ChannelId
channelIdByUsername :: Text -> ChatState -> Maybe ChannelId
channelIdByUsername Text
name ChatState
st = do
    UserId
uId <- Text -> ChatState -> Maybe UserId
userIdForUsername Text
name ChatState
st
    UserId -> ClientChannels -> Maybe ChannelId
getDmChannelFor UserId
uId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels)

useNickname :: ChatState -> Bool
useNickname :: ChatState -> Bool
useNickname ChatState
st =
    Maybe ClientConfig -> UserPreferences -> Bool
useNickname' (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState (Maybe ClientConfig)
csClientConfig) (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferences)

trimChannelSigil :: Text -> Text
trimChannelSigil :: Text -> Text
trimChannelSigil Text
n
    | Text
normalChannelSigil Text -> Text -> Bool
`T.isPrefixOf` Text
n = Text -> Text
T.tail Text
n
    | Bool
otherwise = Text
n

addNewUser :: UserInfo -> MH ()
addNewUser :: UserInfo -> MH ()
addNewUser UserInfo
u = do
    Lens' ChatState Users
csUsers forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= UserInfo -> Users -> Users
addUser UserInfo
u
    -- Invalidate the cache because channel message rendering may need
    -- to get updated if this user authored posts in any channels.
    forall a. EventM Name ChatState a -> MH a
mh forall n s. Ord n => EventM n s ()
invalidateCache

data SidebarUpdate =
    SidebarUpdateImmediate
    | SidebarUpdateDeferred
    deriving (SidebarUpdate -> SidebarUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SidebarUpdate -> SidebarUpdate -> Bool
$c/= :: SidebarUpdate -> SidebarUpdate -> Bool
== :: SidebarUpdate -> SidebarUpdate -> Bool
$c== :: SidebarUpdate -> SidebarUpdate -> Bool
Eq, Int -> SidebarUpdate -> ShowS
[SidebarUpdate] -> ShowS
SidebarUpdate -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SidebarUpdate] -> ShowS
$cshowList :: [SidebarUpdate] -> ShowS
show :: SidebarUpdate -> [Char]
$cshow :: SidebarUpdate -> [Char]
showsPrec :: Int -> SidebarUpdate -> ShowS
$cshowsPrec :: Int -> SidebarUpdate -> ShowS
Show)


resetAutocomplete :: Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete :: forall n. Traversal' ChatState (EditState n) -> MH ()
resetAutocomplete Traversal' ChatState (EditState n)
which = do
    Traversal' ChatState (EditState n)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (AutocompleteState n))
esAutocomplete forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
    Traversal' ChatState (EditState n)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe Text)
esAutocompletePending forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing


-- * Slash Commands

-- | The 'CmdArgs' type represents the arguments to a slash-command; the
-- type parameter represents the argument structure.
data CmdArgs :: K.Type -> K.Type where
    NoArg    :: CmdArgs ()
    LineArg  :: Text -> CmdArgs Text
    UserArg  :: CmdArgs rest -> CmdArgs (Text, rest)
    ChannelArg :: CmdArgs rest -> CmdArgs (Text, rest)
    TokenArg :: Text -> CmdArgs rest -> CmdArgs (Text, rest)

-- | 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 { Cmd -> Text
cmdName    :: Text
                  , Cmd -> Text
cmdDescr   :: Text
                  , ()
cmdArgSpec :: CmdArgs a
                  , ()
cmdAction  :: CmdExec a
                  }

-- | Helper function to extract the name out of a 'Cmd' value
commandName :: Cmd -> Text
commandName :: Cmd -> Text
commandName (Cmd Text
name Text
_ CmdArgs a
_ CmdExec a
_ ) = Text
name

-- *  Channel Updates and Notifications

userList :: ChatState -> [UserInfo]
userList :: ChatState -> [UserInfo]
userList ChatState
st = forall a. (a -> Bool) -> [a] -> [a]
filter UserInfo -> Bool
showUser forall a b. (a -> b) -> a -> b
$ Users -> [UserInfo]
allUsers (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)
    where showUser :: UserInfo -> Bool
showUser UserInfo
u = Bool -> Bool
not (UserInfo -> Bool
isSelf UserInfo
u) Bool -> Bool -> Bool
&& (UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Bool
uiInTeam)
          isSelf :: UserInfo -> Bool
isSelf UserInfo
u = (ChatState -> UserId
myUserId ChatState
st) forall a. Eq a => a -> a -> Bool
== (UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo UserId
uiId)

allUserIds :: ChatState -> [UserId]
allUserIds :: ChatState -> [UserId]
allUserIds ChatState
st = Users -> [UserId]
getAllUserIds forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers

-- BEWARE: you probably don't want this, but instead
-- State.Users.withFetchedUser, since this only looks up users in the
-- collection we have already loaded rather than all valid users on the
-- server.
userById :: UserId -> ChatState -> Maybe UserInfo
userById :: UserId -> ChatState -> Maybe UserInfo
userById UserId
uId ChatState
st = UserId -> Users -> Maybe UserInfo
findUserById UserId
uId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)

myUserId :: ChatState -> UserId
myUserId :: ChatState -> UserId
myUserId ChatState
st = ChatState -> User
myUser ChatState
st forall s a. s -> Getting a s a -> a
^. Lens' User UserId
userIdL

myUser :: ChatState -> User
myUser :: ChatState -> User
myUser ChatState
st = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState User
csMe

myUsername :: ChatState -> Text
myUsername :: ChatState -> Text
myUsername ChatState
st = User -> Text
userUsername forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState User
csMe

-- BEWARE: you probably don't want this, but instead
-- State.Users.withFetchedUser, since this only looks up users in the
-- collection we have already loaded rather than all valid users on the
-- server.
userByUsername :: Text -> ChatState -> Maybe UserInfo
userByUsername :: Text -> ChatState -> Maybe UserInfo
userByUsername Text
name ChatState
st = do
    forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Users -> Maybe (UserId, UserInfo)
findUserByUsername Text
name forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)

-- BEWARE: you probably don't want this, but instead
-- State.Users.withFetchedUser, since this only looks up users in the
-- collection we have already loaded rather than all valid users on the
-- server.
userByNickname :: Text -> ChatState -> Maybe UserInfo
userByNickname :: Text -> ChatState -> Maybe UserInfo
userByNickname Text
name ChatState
st =
    forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Users -> Maybe (UserId, UserInfo)
findUserByNickname Text
name forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers)

getUsers :: MH Users
getUsers :: MH Users
getUsers = forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState Users
csUsers

-- * HighlightSet

type UserSet = Set Text
type ChannelSet = Set Text

-- | The set of usernames, channel names, and language names used for
-- highlighting when rendering messages.
data HighlightSet =
    HighlightSet { HighlightSet -> Set Text
hUserSet    :: Set Text
                 , HighlightSet -> Set Text
hChannelSet :: Set Text
                 , HighlightSet -> SyntaxMap
hSyntaxMap  :: SyntaxMap
                 }

emptyHSet :: HighlightSet
emptyHSet :: HighlightSet
emptyHSet = Set Text -> Set Text -> SyntaxMap -> HighlightSet
HighlightSet forall a. Set a
Set.empty forall a. Set a
Set.empty forall a. Monoid a => a
mempty

getHighlightSet :: ChatState -> TeamId -> HighlightSet
getHighlightSet :: ChatState -> TeamId -> HighlightSet
getHighlightSet ChatState
st TeamId
tId =
    HighlightSet { hUserSet :: Set Text
hUserSet = Set Text -> Set Text
addSpecialUserMentions forall a b. (a -> b) -> a -> b
$ Users -> Set Text
getUsernameSet forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState Users
csUsers
                 , hChannelSet :: Set Text
hChannelSet = TeamId -> ClientChannels -> Set Text
getChannelNameSet TeamId
tId forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels
                 , hSyntaxMap :: SyntaxMap
hSyntaxMap = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources SyntaxMap
crSyntaxMap
                 }

attrNameToConfig :: Brick.AttrName -> Text
attrNameToConfig :: AttrName -> Text
attrNameToConfig = [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> [[Char]]
Brick.attrNameComponents

-- From: https://docs.mattermost.com/help/messaging/mentioning-teammates.html
specialUserMentions :: [T.Text]
specialUserMentions :: [Text]
specialUserMentions = [Text
"all", Text
"channel", Text
"here"]

addSpecialUserMentions :: Set Text -> Set Text
addSpecialUserMentions :: Set Text -> Set Text
addSpecialUserMentions Set Text
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Ord a => a -> Set a -> Set a
Set.insert Set Text
s [Text]
specialUserMentions

getNewMessageCutoff :: ChannelId -> ChatState -> Maybe NewMessageIndicator
getNewMessageCutoff :: ChannelId -> ChatState -> Maybe NewMessageIndicator
getNewMessageCutoff ChannelId
cId ChatState
st = do
    ClientChannel
cc <- ChatState
stforall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo NewMessageIndicator
cdNewMessageIndicator

getEditedMessageCutoff :: ChannelId -> ChatState -> Maybe ServerTime
getEditedMessageCutoff :: ChannelId -> ChatState -> Maybe ServerTime
getEditedMessageCutoff ChannelId
cId ChatState
st = do
    ClientChannel
cc <- ChatState
stforall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
    ClientChannel
ccforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo (Maybe ServerTime)
cdEditedMessageThreshold

clearChannelUnreadStatus :: ChannelId -> MH ()
clearChannelUnreadStatus :: ChannelId -> MH ()
clearChannelUnreadStatus ChannelId
cId = do
    forall a. EventM Name ChatState a -> MH a
mh forall a b. (a -> b) -> a -> b
$ forall n s. Ord n => n -> EventM n s ()
invalidateCacheEntry (Name -> Name
MessageInterfaceMessages forall a b. (a -> b) -> a -> b
$ ChannelId -> Name
MessageInput ChannelId
cId)
    ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId) forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ClientChannel -> ClientChannel
clearNewMessageIndicator forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                       ClientChannel -> ClientChannel
clearEditedThreshold)

moveLeft :: (Eq a) => a -> [a] -> [a]
moveLeft :: forall a. Eq a => a -> [a] -> [a]
moveLeft a
v [a]
as =
    case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
v [a]
as of
        Maybe Int
Nothing -> [a]
as
        Just Int
0 -> [a]
as
        Just Int
i ->
            let ([a]
h, [a]
t) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
as
            in forall a. [a] -> [a]
init [a]
h forall a. Semigroup a => a -> a -> a
<> [a
v, forall a. [a] -> a
last [a]
h] forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [a]
tail [a]
t

moveRight :: (Eq a) => a -> [a] -> [a]
moveRight :: forall a. Eq a => a -> [a] -> [a]
moveRight a
v [a]
as =
    case forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
v [a]
as of
        Maybe Int
Nothing -> [a]
as
        Just Int
i
            | Int
i forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as forall a. Num a => a -> a -> a
- Int
1 -> [a]
as
            | Bool
otherwise ->
                let ([a]
h, [a]
t) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
as
                in [a]
h forall a. Semigroup a => a -> a -> a
<> [forall a. [a] -> a
head (forall a. [a] -> [a]
tail [a]
t), a
v] forall a. Semigroup a => a -> a -> a
<> (forall a. [a] -> [a]
tail (forall a. [a] -> [a]
tail [a]
t))

resultToWidget :: Result n -> Widget n
resultToWidget :: forall n. Result n -> Widget n
resultToWidget = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

threadInterface :: (HasCallStack) => TeamId -> Traversal' ChatState ThreadInterface
threadInterface :: HasCallStack => TeamId -> Traversal' ChatState ThreadInterface
threadInterface TeamId
tId = TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just

-- An unsafe lens to get the specified team's thread interface. Assumes
-- the interface is present; if not, this crashes. Intended for places
-- where you know the interface will be present due to other state and
-- don't want to deal with Maybe.
unsafeThreadInterface :: (HasCallStack) => TeamId -> Lens' ChatState ThreadInterface
unsafeThreadInterface :: HasCallStack => TeamId -> Lens' ChatState ThreadInterface
unsafeThreadInterface TeamId
tId = TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just

-- A safe version of unsafeThreadInterface.
maybeThreadInterface :: TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface :: TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface TeamId
tId = TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface

threadInterfaceEmpty :: TeamId -> MH Bool
threadInterfaceEmpty :: TeamId -> MH Bool
threadInterfaceEmpty TeamId
tId = do
    Maybe Int
mLen <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall seq a. DirectionalSeq seq a -> Int
messagesLength)
    case Maybe Int
mLen of
        Maybe Int
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Just Int
len -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
len forall a. Eq a => a -> a -> Bool
== Int
0

withThreadInterface :: TeamId -> ChannelId -> MH () -> MH ()
withThreadInterface :: TeamId -> ChannelId -> MH () -> MH ()
withThreadInterface TeamId
tId ChannelId
cId MH ()
act = do
    Maybe ChannelId
mCid <- forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) ChannelId
miChannelId)
    case Maybe ChannelId
mCid of
        Just ChannelId
i | ChannelId
i forall a. Eq a => a -> a -> Bool
== ChannelId
cId -> MH ()
act
        Maybe ChannelId
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

threadInterfaceDeleteWhere :: TeamId -> ChannelId -> (Message -> Bool) -> MH ()
threadInterfaceDeleteWhere :: TeamId -> ChannelId -> (Message -> Bool) -> MH ()
threadInterfaceDeleteWhere TeamId
tId ChannelId
cId Message -> Bool
f =
    TeamId -> ChannelId -> MH () -> MH ()
withThreadInterface TeamId
tId ChannelId
cId forall a b. (a -> b) -> a -> b
$ do
        TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversedforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. (a -> Bool) -> Traversal' a a
filtered Message -> Bool
f forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
            (forall a b. a -> (a -> b) -> b
& Lens' Message Bool
mDeleted forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)

modifyThreadMessages :: TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages :: TeamId -> ChannelId -> (Messages -> Messages) -> MH ()
modifyThreadMessages TeamId
tId ChannelId
cId Messages -> Messages
f = do
    TeamId -> ChannelId -> MH () -> MH ()
withThreadInterface TeamId
tId ChannelId
cId forall a b. (a -> b) -> a -> b
$ do
        TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessages forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Messages -> Messages
f

modifyEachThreadMessage :: TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage :: TeamId -> ChannelId -> (Message -> Message) -> MH ()
modifyEachThreadMessage TeamId
tId ChannelId
cId Message -> Message
f = do
    TeamId -> ChannelId -> MH () -> MH ()
withThreadInterface TeamId
tId ChannelId
cId forall a b. (a -> b) -> a -> b
$ do
        TeamId -> Lens' ChatState (Maybe ThreadInterface)
maybeThreadInterface(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Justforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) Messages
miMessagesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b.
Traversable f =>
Traversal (f a) (f b) a b
traversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Message -> Message
f