{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
module Matterhorn.Types
  ( ConnectionStatus(..)
  , HelpTopic(..)
  , MessageSelectState(..)
  , ProgramOutput(..)
  , MHEvent(..)
  , InternalEvent(..)
  , Name(..)
  , ChannelSelectMatch(..)
  , StartupStateInfo(..)
  , MHError(..)
  , AttachmentData(..)
  , CPUUsagePolicy(..)
  , SemEq(..)
  , tabbedWindow
  , getCurrentTabbedWindowEntry
  , tabbedWindowNextTab
  , tabbedWindowPreviousTab
  , runTabShowHandlerFor
  , getServerBaseUrl
  , serverBaseUrl
  , TabbedWindow(..)
  , TabbedWindowEntry(..)
  , TabbedWindowTemplate(..)
  , ConnectionInfo(..)
  , SidebarUpdate(..)
  , PendingChannelChange(..)
  , ViewMessageWindowTab(..)
  , clearChannelUnreadStatus
  , ChannelListEntry(..)
  , ChannelListEntryType(..)
  , ChannelListOrientation(..)
  , channelListEntryUserId
  , userIdsFromZipper
  , entryIsDMEntry
  , ciHostname
  , ciPort
  , ciUrlPath
  , ciUsername
  , ciPassword
  , ciType
  , ciAccessToken
  , newChannelTopicDialog
  , ChannelTopicDialogState(..)
  , channelTopicDialogEditor
  , channelTopicDialogFocus

  , newSaveAttachmentDialog
  , SaveAttachmentDialogState(..)
  , attachmentPathEditor
  , attachmentPathDialogFocus

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

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

  , attrNameToConfig

  , sortTeams
  , mkTeamZipper
  , mkTeamZipperFromIds
  , teamZipperIds
  , mkChannelZipperList
  , ChannelListGroup(..)
  , channelListGroupUnread
  , nonDMChannelListGroupUnread

  , trimChannelSigil

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

  , TeamState(..)
  , tsFocus
  , tsMode
  , tsPendingChannelChange
  , tsRecentChannel
  , tsReturnChannel
  , tsEditState
  , tsMessageSelect
  , tsTeam
  , tsChannelSelectState
  , tsUrlList
  , tsViewedMessage
  , tsPostListOverlay
  , tsUserListOverlay
  , tsChannelListOverlay
  , tsNotifyPrefs
  , tsChannelTopicDialog
  , tsReactionEmojiListOverlay
  , tsThemeListOverlay
  , tsSaveAttachmentDialog

  , ChatState
  , newState
  , newTeamState

  , csTeamZipper
  , csCurrentTeam
  , csTeams
  , csTeam
  , csChannelListOrientation
  , csResources
  , csLastMouseDownEvent
  , csCurrentChannel
  , csCurrentChannelId
  , csCurrentTeamId
  , csPostMap
  , csUsers
  , csConnectionStatus
  , csWorkerIsBusy
  , csChannel
  , csChannels
  , csClientConfig
  , csInputHistory
  , csMe
  , timeZone
  , whenMode
  , setMode
  , setMode'

  , ChatEditState
  , emptyEditState
  , cedAttachmentList
  , cedFileBrowser
  , unsafeCedFileBrowser
  , cedYankBuffer
  , cedSpellChecker
  , cedMisspellings
  , cedEditMode
  , cedEphemeral
  , cedEditor
  , cedAutocomplete
  , cedAutocompletePending
  , cedJustCompleted

  , AutocompleteState(..)
  , acPreviousSearchString
  , acCompletionList
  , acCachedResponses
  , acType

  , AutocompletionType(..)

  , CompletionSource(..)
  , AutocompleteAlternative(..)
  , autocompleteAlternativeReplacement
  , SpecialMention(..)
  , specialMentionName
  , isSpecialMention

  , PostListOverlayState
  , postListSelected
  , postListPosts

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

  , ListOverlayState
  , listOverlaySearchResults
  , listOverlaySearchInput
  , listOverlaySearchScope
  , listOverlaySearching
  , listOverlayEnterHandler
  , listOverlayNewList
  , listOverlayFetchResults
  , listOverlayRecordCount
  , listOverlayReturnMode

  , getUsers

  , ChatResources(..)
  , crUserPreferences
  , crEventQueue
  , crTheme
  , crStatusUpdateChan
  , crSubprocessLog
  , crWebsocketActionChan
  , crWebsocketThreadId
  , crRequestQueue
  , crFlaggedPosts
  , crConn
  , crConfiguration
  , crSyntaxMap
  , crLogManager
  , 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
  , mhHandleEventLensed
  , mhHandleEventLensed'
  , St.gets
  , mhError

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

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

  , requestQuit
  , getMessageForPostId
  , getParentMessage
  , getReplyRootMessage
  , resetSpellCheckTimer
  , 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.Channels
  , module Matterhorn.Types.Messages
  , module Matterhorn.Types.Posts
  , module Matterhorn.Types.Users
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Graphics.Vty as Vty
import qualified Brick
import           Brick ( EventM, Next, Widget )
import           Brick.Focus ( FocusRing, 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, applyEdit )
import           Brick.Widgets.List ( List, list )
import qualified Brick.Widgets.FileBrowser as FB
import           Control.Concurrent ( ThreadId )
import           Control.Concurrent.Async ( Async )
import qualified Control.Concurrent.STM as STM
import           Control.Exception ( SomeException )
import qualified Control.Monad.Fail as MHF
import qualified Control.Monad.State as St
import qualified Control.Monad.Reader as R
import qualified Data.Set as Set
import qualified Data.ByteString as BS
import qualified Data.Foldable as F
import           Data.Function ( on )
import qualified Data.Kind as K
import           Data.Ord ( comparing )
import qualified Data.HashMap.Strict as HM
import           Data.List ( sortBy, nub, elemIndex, partition )
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Zipper as Z2
import           Data.Time.Clock ( getCurrentTime, addUTCTime )
import           Data.UUID ( UUID )
import qualified Data.Vector as Vec
import           Lens.Micro.Platform ( at, makeLenses, lens, (%~), (^?!), (.=)
                                     , (%=), (^?), (.~)
                                     , _Just, Traversal', preuse, to
                                     , SimpleGetter
                                     )
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 ( userSigil, normalChannelSigil )
import           Matterhorn.InputHistory
import           Matterhorn.Emoji
import           Matterhorn.Types.Common
import           Matterhorn.Types.Channels
import           Matterhorn.Types.DirectionalSeq ( emptyDirSeq )
import           Matterhorn.Types.KeyEvents
import           Matterhorn.Types.Messages
import           Matterhorn.Types.Posts
import           Matterhorn.Types.RichText ( TeamBaseURL(..), TeamURLName(..) )
import           Matterhorn.Types.Users
import qualified Matterhorn.Zipper as Z


-- * Configuration

-- | A notification version for the external notifier
data NotificationVersion =
    NotifyV1
    | NotifyV2
    deriving (NotificationVersion -> NotificationVersion -> Bool
(NotificationVersion -> NotificationVersion -> Bool)
-> (NotificationVersion -> NotificationVersion -> Bool)
-> Eq NotificationVersion
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]
(Int -> ReadS NotificationVersion)
-> ReadS [NotificationVersion]
-> ReadPrec NotificationVersion
-> ReadPrec [NotificationVersion]
-> Read 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 -> String
(Int -> NotificationVersion -> ShowS)
-> (NotificationVersion -> String)
-> ([NotificationVersion] -> ShowS)
-> Show NotificationVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotificationVersion] -> ShowS
$cshowList :: [NotificationVersion] -> ShowS
show :: NotificationVersion -> String
$cshow :: NotificationVersion -> String
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
(PasswordSource -> PasswordSource -> Bool)
-> (PasswordSource -> PasswordSource -> Bool) -> Eq PasswordSource
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]
(Int -> ReadS PasswordSource)
-> ReadS [PasswordSource]
-> ReadPrec PasswordSource
-> ReadPrec [PasswordSource]
-> Read 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 -> String
(Int -> PasswordSource -> ShowS)
-> (PasswordSource -> String)
-> ([PasswordSource] -> ShowS)
-> Show PasswordSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PasswordSource] -> ShowS
$cshowList :: [PasswordSource] -> ShowS
show :: PasswordSource -> String
$cshow :: PasswordSource -> String
showsPrec :: Int -> PasswordSource -> ShowS
$cshowsPrec :: Int -> PasswordSource -> ShowS
Show)

-- | An access token source.
data TokenSource =
    TokenString Text
    | TokenCommand Text
    deriving (TokenSource -> TokenSource -> Bool
(TokenSource -> TokenSource -> Bool)
-> (TokenSource -> TokenSource -> Bool) -> Eq TokenSource
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]
(Int -> ReadS TokenSource)
-> ReadS [TokenSource]
-> ReadPrec TokenSource
-> ReadPrec [TokenSource]
-> Read 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 -> String
(Int -> TokenSource -> ShowS)
-> (TokenSource -> String)
-> ([TokenSource] -> ShowS)
-> Show TokenSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenSource] -> ShowS
$cshowList :: [TokenSource] -> ShowS
show :: TokenSource -> String
$cshow :: TokenSource -> String
showsPrec :: Int -> TokenSource -> ShowS
$cshowsPrec :: Int -> TokenSource -> 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 =
    ChannelGroupPublicChannels Int
    | ChannelGroupPrivateChannels Int
    | ChannelGroupFavoriteChannels Int
    | ChannelGroupDirectMessages Int
    deriving (ChannelListGroup -> ChannelListGroup -> Bool
(ChannelListGroup -> ChannelListGroup -> Bool)
-> (ChannelListGroup -> ChannelListGroup -> Bool)
-> Eq ChannelListGroup
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)

channelListGroupUnread :: ChannelListGroup -> Int
channelListGroupUnread :: ChannelListGroup -> Int
channelListGroupUnread (ChannelGroupPublicChannels Int
n)  = Int
n
channelListGroupUnread (ChannelGroupPrivateChannels Int
n) = Int
n
channelListGroupUnread (ChannelGroupFavoriteChannels Int
n) = Int
n
channelListGroupUnread (ChannelGroupDirectMessages Int
n)  = Int
n


nonDMChannelListGroupUnread :: ChannelListGroup -> Int
nonDMChannelListGroupUnread :: ChannelListGroup -> Int
nonDMChannelListGroupUnread (ChannelGroupPublicChannels Int
n)  = Int
n
nonDMChannelListGroupUnread (ChannelGroupPrivateChannels Int
n) = Int
n
nonDMChannelListGroupUnread (ChannelGroupFavoriteChannels Int
n) = Int
n
nonDMChannelListGroupUnread (ChannelGroupDirectMessages Int
_)  = Int
0

-- | The type of channel list entries.
data ChannelListEntry =
    ChannelListEntry { ChannelListEntry -> ChannelId
channelListEntryChannelId :: ChannelId
                     , ChannelListEntry -> ChannelListEntryType
channelListEntryType :: ChannelListEntryType
                     , ChannelListEntry -> Bool
channelListEntryUnread :: Bool
                     , ChannelListEntry -> Text
channelListEntrySortValue :: T.Text
                     , ChannelListEntry -> Bool
channelListEntryFavorite :: Bool
                     }
                     deriving (ChannelListEntry -> ChannelListEntry -> Bool
(ChannelListEntry -> ChannelListEntry -> Bool)
-> (ChannelListEntry -> ChannelListEntry -> Bool)
-> Eq ChannelListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelListEntry -> ChannelListEntry -> Bool
$c/= :: ChannelListEntry -> ChannelListEntry -> Bool
== :: ChannelListEntry -> ChannelListEntry -> Bool
$c== :: ChannelListEntry -> ChannelListEntry -> Bool
Eq, Int -> ChannelListEntry -> ShowS
[ChannelListEntry] -> ShowS
ChannelListEntry -> String
(Int -> ChannelListEntry -> ShowS)
-> (ChannelListEntry -> String)
-> ([ChannelListEntry] -> ShowS)
-> Show ChannelListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListEntry] -> ShowS
$cshowList :: [ChannelListEntry] -> ShowS
show :: ChannelListEntry -> String
$cshow :: ChannelListEntry -> String
showsPrec :: Int -> ChannelListEntry -> ShowS
$cshowsPrec :: Int -> ChannelListEntry -> ShowS
Show, Eq ChannelListEntry
Eq ChannelListEntry
-> (ChannelListEntry -> ChannelListEntry -> Ordering)
-> (ChannelListEntry -> ChannelListEntry -> Bool)
-> (ChannelListEntry -> ChannelListEntry -> Bool)
-> (ChannelListEntry -> ChannelListEntry -> Bool)
-> (ChannelListEntry -> ChannelListEntry -> Bool)
-> (ChannelListEntry -> ChannelListEntry -> ChannelListEntry)
-> (ChannelListEntry -> ChannelListEntry -> ChannelListEntry)
-> Ord ChannelListEntry
ChannelListEntry -> ChannelListEntry -> Bool
ChannelListEntry -> ChannelListEntry -> Ordering
ChannelListEntry -> ChannelListEntry -> ChannelListEntry
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 :: ChannelListEntry -> ChannelListEntry -> ChannelListEntry
$cmin :: ChannelListEntry -> ChannelListEntry -> ChannelListEntry
max :: ChannelListEntry -> ChannelListEntry -> ChannelListEntry
$cmax :: ChannelListEntry -> ChannelListEntry -> ChannelListEntry
>= :: ChannelListEntry -> ChannelListEntry -> Bool
$c>= :: ChannelListEntry -> ChannelListEntry -> Bool
> :: ChannelListEntry -> ChannelListEntry -> Bool
$c> :: ChannelListEntry -> ChannelListEntry -> Bool
<= :: ChannelListEntry -> ChannelListEntry -> Bool
$c<= :: ChannelListEntry -> ChannelListEntry -> Bool
< :: ChannelListEntry -> ChannelListEntry -> Bool
$c< :: ChannelListEntry -> ChannelListEntry -> Bool
compare :: ChannelListEntry -> ChannelListEntry -> Ordering
$ccompare :: ChannelListEntry -> ChannelListEntry -> Ordering
$cp1Ord :: Eq ChannelListEntry
Ord)

data ChannelListEntryType =
    CLChannel
    -- ^ A non-DM entry
    | CLUserDM UserId
    -- ^ A single-user DM entry
    | CLGroupDM
    -- ^ A multi-user DM entry
    deriving (ChannelListEntryType -> ChannelListEntryType -> Bool
(ChannelListEntryType -> ChannelListEntryType -> Bool)
-> (ChannelListEntryType -> ChannelListEntryType -> Bool)
-> Eq ChannelListEntryType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelListEntryType -> ChannelListEntryType -> Bool
$c/= :: ChannelListEntryType -> ChannelListEntryType -> Bool
== :: ChannelListEntryType -> ChannelListEntryType -> Bool
$c== :: ChannelListEntryType -> ChannelListEntryType -> Bool
Eq, Int -> ChannelListEntryType -> ShowS
[ChannelListEntryType] -> ShowS
ChannelListEntryType -> String
(Int -> ChannelListEntryType -> ShowS)
-> (ChannelListEntryType -> String)
-> ([ChannelListEntryType] -> ShowS)
-> Show ChannelListEntryType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListEntryType] -> ShowS
$cshowList :: [ChannelListEntryType] -> ShowS
show :: ChannelListEntryType -> String
$cshow :: ChannelListEntryType -> String
showsPrec :: Int -> ChannelListEntryType -> ShowS
$cshowsPrec :: Int -> ChannelListEntryType -> ShowS
Show, Eq ChannelListEntryType
Eq ChannelListEntryType
-> (ChannelListEntryType -> ChannelListEntryType -> Ordering)
-> (ChannelListEntryType -> ChannelListEntryType -> Bool)
-> (ChannelListEntryType -> ChannelListEntryType -> Bool)
-> (ChannelListEntryType -> ChannelListEntryType -> Bool)
-> (ChannelListEntryType -> ChannelListEntryType -> Bool)
-> (ChannelListEntryType
    -> ChannelListEntryType -> ChannelListEntryType)
-> (ChannelListEntryType
    -> ChannelListEntryType -> ChannelListEntryType)
-> Ord ChannelListEntryType
ChannelListEntryType -> ChannelListEntryType -> Bool
ChannelListEntryType -> ChannelListEntryType -> Ordering
ChannelListEntryType
-> ChannelListEntryType -> ChannelListEntryType
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 :: ChannelListEntryType
-> ChannelListEntryType -> ChannelListEntryType
$cmin :: ChannelListEntryType
-> ChannelListEntryType -> ChannelListEntryType
max :: ChannelListEntryType
-> ChannelListEntryType -> ChannelListEntryType
$cmax :: ChannelListEntryType
-> ChannelListEntryType -> ChannelListEntryType
>= :: ChannelListEntryType -> ChannelListEntryType -> Bool
$c>= :: ChannelListEntryType -> ChannelListEntryType -> Bool
> :: ChannelListEntryType -> ChannelListEntryType -> Bool
$c> :: ChannelListEntryType -> ChannelListEntryType -> Bool
<= :: ChannelListEntryType -> ChannelListEntryType -> Bool
$c<= :: ChannelListEntryType -> ChannelListEntryType -> Bool
< :: ChannelListEntryType -> ChannelListEntryType -> Bool
$c< :: ChannelListEntryType -> ChannelListEntryType -> Bool
compare :: ChannelListEntryType -> ChannelListEntryType -> Ordering
$ccompare :: ChannelListEntryType -> ChannelListEntryType -> Ordering
$cp1Ord :: Eq ChannelListEntryType
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 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 -> 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 -> Bool
configShowTypingIndicator :: Bool
           -- ^ Whether to show the typing indicator for other users,
           -- and whether to send typing notifications to other users.
           , Config -> Maybe String
configAbsPath :: Maybe FilePath
           -- ^ A book-keeping field for the absolute path to the
           -- configuration. (Not a user setting.)
           , Config -> KeyConfig
configUserKeys :: KeyConfig
           -- ^ The user's keybinding configuration.
           , Config -> Bool
configHyperlinkingMode :: Bool
           -- ^ Whether to enable terminal hyperlinking mode.
           , Config -> [String]
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 String
configDefaultAttachmentPath :: Maybe FilePath
           -- ^ The default path for browsing attachments
           , Config -> ChannelListOrientation
configChannelListOrientation :: ChannelListOrientation
           -- ^ The orientation of the channel list.
           , Config -> Bool
configMouseMode :: Bool
           -- ^ Whether to enable mouse support in matterhorn
           } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
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 -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
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
(CPUUsagePolicy -> CPUUsagePolicy -> Bool)
-> (CPUUsagePolicy -> CPUUsagePolicy -> Bool) -> Eq CPUUsagePolicy
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 -> String
(Int -> CPUUsagePolicy -> ShowS)
-> (CPUUsagePolicy -> String)
-> ([CPUUsagePolicy] -> ShowS)
-> Show CPUUsagePolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CPUUsagePolicy] -> ShowS
$cshowList :: [CPUUsagePolicy] -> ShowS
show :: CPUUsagePolicy -> String
$cshow :: CPUUsagePolicy -> String
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
(BackgroundInfo -> BackgroundInfo -> Bool)
-> (BackgroundInfo -> BackgroundInfo -> Bool) -> Eq BackgroundInfo
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 -> String
(Int -> BackgroundInfo -> ShowS)
-> (BackgroundInfo -> String)
-> ([BackgroundInfo] -> ShowS)
-> Show BackgroundInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BackgroundInfo] -> ShowS
$cshowList :: [BackgroundInfo] -> ShowS
show :: BackgroundInfo -> String
$cshow :: BackgroundInfo -> String
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 = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
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
    Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ ChannelInfo -> Int
_cdMentionCount ChannelInfo
info Int -> Int -> Bool
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) ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
> ServerTime
lastViewTime) Bool -> Bool -> Bool
||
               (Maybe ServerTime -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ServerTime -> Bool) -> Maybe ServerTime -> Bool
forall a b. (a -> b) -> a -> b
$ ChannelInfo -> Maybe ServerTime
_cdEditedMessageThreshold ChannelInfo
info)))

mkChannelZipperList :: UTCTime
                    -> Config
                    -> TeamId
                    -> Maybe ClientConfig
                    -> UserPreferences
                    -> ClientChannels
                    -> Users
                    -> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList :: UTCTime
-> Config
-> TeamId
-> Maybe ClientConfig
-> UserPreferences
-> ClientChannels
-> Users
-> [(ChannelListGroup, [ChannelListEntry])]
mkChannelZipperList UTCTime
now Config
config TeamId
tId Maybe ClientConfig
cconfig UserPreferences
prefs ClientChannels
cs Users
us =
    let ([ChannelListEntry]
privFavs, [ChannelListEntry]
privEntries) = [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites ([ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry]))
-> [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
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 ([ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry]))
-> [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
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 ([ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry]))
-> [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
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 [ChannelListEntry] -> [ChannelListEntry] -> [ChannelListEntry]
forall a. Semigroup a => a -> a -> a
<> [ChannelListEntry]
normFavs [ChannelListEntry] -> [ChannelListEntry] -> [ChannelListEntry]
forall a. Semigroup a => a -> a -> a
<> [ChannelListEntry]
dmFavs
    in [ let unread :: Int
unread = [ChannelListEntry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ChannelListEntry] -> Int) -> [ChannelListEntry] -> Int
forall a b. (a -> b) -> a -> b
$ (ChannelListEntry -> Bool)
-> [ChannelListEntry] -> [ChannelListEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
favEntries
         in (Int -> ChannelListGroup
ChannelGroupFavoriteChannels Int
unread, [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries [ChannelListEntry]
favEntries)
       , let unread :: Int
unread = [ChannelListEntry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ChannelListEntry] -> Int) -> [ChannelListEntry] -> Int
forall a b. (a -> b) -> a -> b
$ (ChannelListEntry -> Bool)
-> [ChannelListEntry] -> [ChannelListEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
normEntries
         in (Int -> ChannelListGroup
ChannelGroupPublicChannels Int
unread, [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries [ChannelListEntry]
normEntries)
       , let unread :: Int
unread = [ChannelListEntry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ChannelListEntry] -> Int) -> [ChannelListEntry] -> Int
forall a b. (a -> b) -> a -> b
$ (ChannelListEntry -> Bool)
-> [ChannelListEntry] -> [ChannelListEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
privEntries
         in (Int -> ChannelListGroup
ChannelGroupPrivateChannels Int
unread, [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries [ChannelListEntry]
privEntries)
       , let unread :: Int
unread = [ChannelListEntry] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ChannelListEntry] -> Int) -> [ChannelListEntry] -> Int
forall a b. (a -> b) -> a -> b
$ (ChannelListEntry -> Bool)
-> [ChannelListEntry] -> [ChannelListEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ChannelListEntry -> Bool
channelListEntryUnread [ChannelListEntry]
dmEntries
         in (Int -> ChannelListGroup
ChannelGroupDirectMessages Int
unread, [ChannelListEntry] -> [ChannelListEntry]
sortDMChannelListEntries [ChannelListEntry]
dmEntries)
       ]

sortChannelListEntries :: [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries :: [ChannelListEntry] -> [ChannelListEntry]
sortChannelListEntries = (ChannelListEntry -> ChannelListEntry -> Ordering)
-> [ChannelListEntry] -> [ChannelListEntry]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ChannelListEntry -> Text)
-> ChannelListEntry -> ChannelListEntry -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ChannelListEntry -> Text
channelListEntrySortValue)

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

partitionFavorites :: [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites :: [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
partitionFavorites = (ChannelListEntry -> Bool)
-> [ChannelListEntry] -> ([ChannelListEntry], [ChannelListEntry])
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
infoClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ty Bool -> Bool -> Bool
&&
                            ClientChannel
infoClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId Maybe TeamId -> Maybe TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId -> Maybe TeamId
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 ((ChannelId, ClientChannel) -> ChannelListEntry)
-> [(ChannelId, ClientChannel)] -> [ChannelListEntry]
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 :: ChannelId
-> ChannelListEntryType -> Bool -> Text -> Bool -> ChannelListEntry
ChannelListEntry { channelListEntryChannelId :: ChannelId
channelListEntryChannelId = ChannelId
cId
                                             , channelListEntryType :: ChannelListEntryType
channelListEntryType = ChannelListEntryType
CLChannel
                                             , channelListEntryUnread :: Bool
channelListEntryUnread = ClientChannel -> Bool
hasUnread' ClientChannel
ch
                                             , channelListEntrySortValue :: Text
channelListEntrySortValue = ClientChannel
chClientChannel -> Getting Text ClientChannel Text -> Text
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Text ChannelInfo)
-> ClientChannel -> Const Text ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Text ChannelInfo)
 -> ClientChannel -> Const Text ClientChannel)
-> ((Text -> Const Text Text)
    -> ChannelInfo -> Const Text ChannelInfo)
-> Getting Text ClientChannel Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text) -> ChannelInfo -> Const Text ChannelInfo
Lens' ChannelInfo Text
cdDisplayName((Text -> Const Text Text)
 -> ChannelInfo -> Const Text ChannelInfo)
-> ((Text -> Const Text Text) -> Text -> Const Text Text)
-> (Text -> Const Text Text)
-> ChannelInfo
-> Const Text ChannelInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Text) -> SimpleGetter Text Text
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 [ChannelListEntry] -> [ChannelListEntry] -> [ChannelListEntry]
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 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
u2
       then Text -> Text -> Ordering
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
clientConfigMaybe ClientConfig
-> Getting
     (First TeammateNameDisplayMode)
     (Maybe ClientConfig)
     TeammateNameDisplayMode
-> Maybe TeammateNameDisplayMode
forall s a. s -> Getting (First a) s a -> Maybe a
^?(ClientConfig
 -> Const (First TeammateNameDisplayMode) ClientConfig)
-> Maybe ClientConfig
-> Const (First TeammateNameDisplayMode) (Maybe ClientConfig)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just((ClientConfig
  -> Const (First TeammateNameDisplayMode) ClientConfig)
 -> Maybe ClientConfig
 -> Const (First TeammateNameDisplayMode) (Maybe ClientConfig))
-> ((TeammateNameDisplayMode
     -> Const (First TeammateNameDisplayMode) TeammateNameDisplayMode)
    -> ClientConfig
    -> Const (First TeammateNameDisplayMode) ClientConfig)
-> Getting
     (First TeammateNameDisplayMode)
     (Maybe ClientConfig)
     TeammateNameDisplayMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ClientConfig -> TeammateNameDisplayMode)
-> SimpleGetter ClientConfig TeammateNameDisplayMode
forall s a. (s -> a) -> SimpleGetter s a
to ClientConfig -> TeammateNameDisplayMode
clientConfigTeammateNameDisplay of
            Just TeammateNameDisplayMode
TMNicknameOrFullname -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
            Maybe TeammateNameDisplayMode
_                         -> Maybe Bool
forall a. Maybe a
Nothing
        accountSetting :: Maybe Bool
accountSetting = (TeammateNameDisplayMode -> TeammateNameDisplayMode -> Bool
forall a. Eq a => a -> a -> Bool
== TeammateNameDisplayMode
TMNicknameOrFullname) (TeammateNameDisplayMode -> Bool)
-> Maybe TeammateNameDisplayMode -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UserPreferences -> Maybe TeammateNameDisplayMode
_userPrefTeammateNameDisplayMode UserPreferences
prefs)
        fallback :: Bool
fallback = Bool
False
    in Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
fallback (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
accountSetting Maybe Bool -> Maybe Bool -> Maybe Bool
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 =
        Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName) (UserInfo
uUserInfo
-> Getting (Maybe Text) UserInfo (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Text) UserInfo (Maybe Text)
Lens' UserInfo (Maybe Text)
uiNickName)
    | Bool
otherwise =
        UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
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
infoClientChannel -> Getting Type ClientChannel Type -> Type
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Type ChannelInfo)
-> ClientChannel -> Const Type ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Type ChannelInfo)
 -> ClientChannel -> Const Type ClientChannel)
-> ((Type -> Const Type Type)
    -> ChannelInfo -> Const Type ChannelInfo)
-> Getting Type ClientChannel Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Type -> Const Type Type) -> ChannelInfo -> Const Type ChannelInfo
Lens' ChannelInfo Type
cdType Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
Group Bool -> Bool -> Bool
&&
                            ClientChannel
infoClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId Maybe TeamId -> Maybe TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe TeamId
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&&
                            UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
groupChannelShouldAppear UTCTime
now Config
config UserPreferences
prefs ClientChannel
info
    in ((ChannelId, ClientChannel) -> ChannelListEntry)
-> [(ChannelId, ClientChannel)] -> [ChannelListEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ChannelId
cId, ClientChannel
ch) -> ChannelListEntry :: ChannelId
-> ChannelListEntryType -> Bool -> Text -> Bool -> ChannelListEntry
ChannelListEntry { channelListEntryChannelId :: ChannelId
channelListEntryChannelId = ChannelId
cId
                                            , channelListEntryType :: ChannelListEntryType
channelListEntryType = ChannelListEntryType
CLGroupDM
                                            , channelListEntryUnread :: Bool
channelListEntryUnread = ClientChannel -> Bool
hasUnread' ClientChannel
ch
                                            , channelListEntrySortValue :: Text
channelListEntrySortValue = ClientChannel
chClientChannel -> Getting Text ClientChannel Text -> Text
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Text ChannelInfo)
-> ClientChannel -> Const Text ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Text ChannelInfo)
 -> ClientChannel -> Const Text ClientChannel)
-> ((Text -> Const Text Text)
    -> ChannelInfo -> Const Text ChannelInfo)
-> Getting Text ClientChannel Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text) -> ChannelInfo -> Const Text ChannelInfo
Lens' ChannelInfo Text
cdDisplayName
                                            , channelListEntryFavorite :: Bool
channelListEntryFavorite = UserPreferences -> ChannelId -> Bool
isFavorite UserPreferences
prefs ChannelId
cId
                                            }) ([(ChannelId, ClientChannel)] -> [ChannelListEntry])
-> [(ChannelId, ClientChannel)] -> [ChannelListEntry]
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 = [Maybe ChannelListEntry] -> [ChannelListEntry]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ChannelListEntry] -> [ChannelListEntry])
-> [Maybe ChannelListEntry] -> [ChannelListEntry]
forall a b. (a -> b) -> a -> b
$ (UserId, ChannelId) -> Maybe ChannelListEntry
getInfo ((UserId, ChannelId) -> Maybe ChannelListEntry)
-> [(UserId, ChannelId)] -> [Maybe ChannelListEntry]
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
uUserInfo -> Getting Bool UserInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool UserInfo Bool
Lens' UserInfo Bool
uiDeleted of
                Bool
True -> Maybe ChannelListEntry
forall a. Maybe a
Nothing
                Bool
False ->
                    if UTCTime -> Config -> UserPreferences -> ClientChannel -> Bool
dmChannelShouldAppear UTCTime
now Config
config UserPreferences
prefs ClientChannel
c
                    then ChannelListEntry -> Maybe ChannelListEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (ChannelListEntry :: ChannelId
-> ChannelListEntryType -> Bool -> Text -> Bool -> ChannelListEntry
ChannelListEntry { channelListEntryChannelId :: ChannelId
channelListEntryChannelId = ChannelId
cId
                                                  , channelListEntryType :: ChannelListEntryType
channelListEntryType = UserId -> ChannelListEntryType
CLUserDM UserId
uId
                                                  , 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 Maybe ChannelListEntry
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 Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe 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 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* (-(Int -> NominalDiffTime
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
cClientChannel
-> Getting ServerTime ClientChannel ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ServerTime ChannelInfo)
-> ClientChannel -> Const ServerTime ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ServerTime ChannelInfo)
 -> ClientChannel -> Const ServerTime ClientChannel)
-> ((ServerTime -> Const ServerTime ServerTime)
    -> ChannelInfo -> Const ServerTime ChannelInfo)
-> Getting ServerTime ClientChannel ServerTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ServerTime -> Const ServerTime ServerTime)
-> ChannelInfo -> Const ServerTime ChannelInfo
Lens' ChannelInfo ServerTime
cdUpdated
        Just UserId
uId = ClientChannel
cClientChannel
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
-> Maybe UserId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> ClientChannel -> Const (Maybe UserId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UserId) ChannelInfo)
 -> ClientChannel -> Const (Maybe UserId) ClientChannel)
-> ((Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
    -> ChannelInfo -> Const (Maybe UserId) ChannelInfo)
-> Getting (Maybe UserId) ClientChannel (Maybe UserId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UserId -> Const (Maybe UserId) (Maybe UserId))
-> ChannelInfo -> Const (Maybe UserId) ChannelInfo
Lens' ChannelInfo (Maybe UserId)
cdDMUserId
        cId :: ChannelId
cId = ClientChannel
cClientChannel
-> Getting ChannelId ClientChannel ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ChannelId ChannelInfo)
-> ClientChannel -> Const ChannelId ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ChannelId ChannelInfo)
 -> ClientChannel -> Const ChannelId ClientChannel)
-> ((ChannelId -> Const ChannelId ChannelId)
    -> ChannelInfo -> Const ChannelId ChannelInfo)
-> Getting ChannelId ClientChannel ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> ChannelInfo -> Const ChannelId ChannelInfo
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
|| Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
localCutoff) (ClientChannel
cClientChannel
-> Getting (Maybe UTCTime) ClientChannel (Maybe UTCTime)
-> Maybe UTCTime
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UTCTime) ChannelInfo)
-> ClientChannel -> Const (Maybe UTCTime) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UTCTime) ChannelInfo)
 -> ClientChannel -> Const (Maybe UTCTime) ClientChannel)
-> ((Maybe UTCTime -> Const (Maybe UTCTime) (Maybe UTCTime))
    -> ChannelInfo -> Const (Maybe UTCTime) ChannelInfo)
-> Getting (Maybe UTCTime) ClientChannel (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Const (Maybe UTCTime) (Maybe UTCTime))
-> ChannelInfo -> Const (Maybe UTCTime) ChannelInfo
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
_ -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
                                -- The channel was updated recently enough
                                ServerTime
updated ServerTime -> ServerTime -> Bool
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 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* (-(Int -> NominalDiffTime
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
cClientChannel
-> Getting ServerTime ClientChannel ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ServerTime ChannelInfo)
-> ClientChannel -> Const ServerTime ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ServerTime ChannelInfo)
 -> ClientChannel -> Const ServerTime ClientChannel)
-> ((ServerTime -> Const ServerTime ServerTime)
    -> ChannelInfo -> Const ServerTime ChannelInfo)
-> Getting ServerTime ClientChannel ServerTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ServerTime -> Const ServerTime ServerTime)
-> ChannelInfo -> Const ServerTime ChannelInfo
Lens' ChannelInfo ServerTime
cdUpdated
        cId :: ChannelId
cId = ClientChannel
cClientChannel
-> Getting ChannelId ClientChannel ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const ChannelId ChannelInfo)
-> ClientChannel -> Const ChannelId ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const ChannelId ChannelInfo)
 -> ClientChannel -> Const ChannelId ClientChannel)
-> ((ChannelId -> Const ChannelId ChannelId)
    -> ChannelInfo -> Const ChannelId ChannelInfo)
-> Getting ChannelId ClientChannel ChannelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelId -> Const ChannelId ChannelId)
-> ChannelInfo -> Const ChannelId ChannelInfo
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
|| Bool -> (UTCTime -> Bool) -> Maybe UTCTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
localCutoff) (ClientChannel
cClientChannel
-> Getting (Maybe UTCTime) ClientChannel (Maybe UTCTime)
-> Maybe UTCTime
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe UTCTime) ChannelInfo)
-> ClientChannel -> Const (Maybe UTCTime) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe UTCTime) ChannelInfo)
 -> ClientChannel -> Const (Maybe UTCTime) ClientChannel)
-> ((Maybe UTCTime -> Const (Maybe UTCTime) (Maybe UTCTime))
    -> ChannelInfo -> Const (Maybe UTCTime) ChannelInfo)
-> Getting (Maybe UTCTime) ClientChannel (Maybe UTCTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe UTCTime -> Const (Maybe UTCTime) (Maybe UTCTime))
-> ChannelInfo -> Const (Maybe UTCTime) ChannelInfo
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
_ -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
                                -- The channel was updated recently enough
                                ServerTime
updated ServerTime -> ServerTime -> Bool
forall a. Ord a => a -> a -> Bool
>= ServerTime
cutoff
                            ])

dmChannelShowPreference :: UserPreferences -> UserId -> Maybe Bool
dmChannelShowPreference :: UserPreferences -> UserId -> Maybe Bool
dmChannelShowPreference UserPreferences
ps UserId
uId = UserId -> HashMap UserId Bool -> Maybe Bool
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 = ChannelId -> HashMap ChannelId Bool -> Maybe Bool
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 = ChannelId -> HashMap ChannelId Bool -> Maybe Bool
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ChannelId
cId (UserPreferences -> HashMap ChannelId Bool
_userPrefFavoriteChannelPrefs UserPreferences
ps)

-- * Internal Names and References

-- | This 'Name' type is the type used in 'brick' to identify various
-- parts of the interface.
data Name =
    ChannelMessages ChannelId
    | MessageInput TeamId
    | ChannelList TeamId
    | HelpViewport
    | HelpText
    | ScriptHelpText
    | ThemeHelpText
    | SyntaxHighlightHelpText
    | KeybindingHelpText
    | ChannelSelectString TeamId
    | ChannelSelectEntry ChannelSelectMatch
    | CompletionAlternatives TeamId
    | CompletionList TeamId
    | JoinChannelList TeamId
    | UrlList TeamId
    | MessagePreviewViewport TeamId
    | ThemeListSearchInput TeamId
    | UserListSearchInput TeamId
    | JoinChannelListSearchInput TeamId
    | UserListSearchResults TeamId
    | ThemeListSearchResults TeamId
    | ViewMessageArea TeamId
    | ViewMessageReactionsArea TeamId
    | ChannelSidebar TeamId
    | ChannelSelectInput TeamId
    | AttachmentList TeamId
    | AttachmentFileBrowser TeamId
    | MessageReactionsArea TeamId
    | ReactionEmojiList TeamId
    | ReactionEmojiListInput TeamId
    | TabbedWindowTabBar TeamId
    | MuteToggleField TeamId
    | ChannelMentionsField TeamId
    | DesktopNotificationsField TeamId (WithDefault NotifyOption)
    | PushNotificationsField TeamId (WithDefault NotifyOption)
    | ChannelTopicEditor TeamId
    | ChannelTopicSaveButton TeamId
    | ChannelTopicCancelButton TeamId
    | ChannelTopicEditorPreview TeamId
    | ChannelTopic
    | TeamList
    | ClickableChannelListEntry ChannelId
    | ClickableTeamListEntry TeamId
    | ClickableURL Name Int LinkTarget
    | ClickableURLInMessage MessageId Int LinkTarget
    | ClickableUsernameInMessage MessageId Int Text
    | ClickableUsername Name Int Text
    | ClickableURLListEntry Int LinkTarget
    | ClickableReactionInMessage PostId Text (Set UserId)
    | ClickableReaction PostId Text (Set UserId)
    | AttachmentPathEditor TeamId
    | AttachmentPathSaveButton TeamId
    | AttachmentPathCancelButton TeamId
    | RenderedMessage MessageId
    | ReactionEmojiListOverlayEntry (Bool, T.Text)
    deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Eq Name
Eq Name
-> (Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
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 :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c< :: Name -> Name -> Bool
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
$cp1Ord :: Eq Name
Ord)

-- | 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 (ClickableURLInMessage MessageId
mId1 Int
_ LinkTarget
t1) (ClickableURLInMessage MessageId
mId2 Int
_ LinkTarget
t2) = MessageId
mId1 MessageId -> MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId
mId2 Bool -> Bool -> Bool
&& LinkTarget
t1 LinkTarget -> LinkTarget -> Bool
forall a. Eq a => a -> a -> Bool
== LinkTarget
t2
    semeq (ClickableUsernameInMessage MessageId
mId1 Int
_ Text
n) (ClickableUsernameInMessage MessageId
mId2 Int
_ Text
n2) = MessageId
mId1 MessageId -> MessageId -> Bool
forall a. Eq a => a -> a -> Bool
== MessageId
mId2 Bool -> Bool -> Bool
&& Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n2
    semeq Name
a Name
b = Name
a Name -> Name -> Bool
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 a -> a -> Bool
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
    | OtherAuthError SomeException
    deriving (Int -> AuthenticationException -> ShowS
[AuthenticationException] -> ShowS
AuthenticationException -> String
(Int -> AuthenticationException -> ShowS)
-> (AuthenticationException -> String)
-> ([AuthenticationException] -> ShowS)
-> Show AuthenticationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthenticationException] -> ShowS
$cshowList :: [AuthenticationException] -> ShowS
show :: AuthenticationException -> String
$cshow :: AuthenticationException -> String
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 -> 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
(PostRef -> PostRef -> Bool)
-> (PostRef -> PostRef -> Bool) -> Eq PostRef
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 -> String
(Int -> PostRef -> ShowS)
-> (PostRef -> String) -> ([PostRef] -> ShowS) -> Show PostRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PostRef] -> ShowS
$cshowList :: [PostRef] -> ShowS
show :: PostRef -> String
$cshow :: PostRef -> String
showsPrec :: Int -> PostRef -> ShowS
$cshowsPrec :: Int -> PostRef -> ShowS
Show)

-- ** Channel-matching types

-- | A match in channel selection mode.
data ChannelSelectMatch =
    ChannelSelectMatch { ChannelSelectMatch -> Text
nameBefore :: Text
                       -- ^ The content of the match before the user's
                       -- matching input.
                       , ChannelSelectMatch -> Text
nameMatched :: Text
                       -- ^ The potion of the name that matched the
                       -- user's input.
                       , ChannelSelectMatch -> Text
nameAfter :: Text
                       -- ^ The portion of the name that came after the
                       -- user's matching input.
                       , ChannelSelectMatch -> Text
matchFull :: Text
                       -- ^ The full string for this entry so it doesn't
                       -- have to be reassembled from the parts above.
                       , ChannelSelectMatch -> ChannelListEntry
matchEntry :: ChannelListEntry
                       -- ^ The original entry data corresponding to the
                       -- text match.
                       }
                       deriving (ChannelSelectMatch -> ChannelSelectMatch -> Bool
(ChannelSelectMatch -> ChannelSelectMatch -> Bool)
-> (ChannelSelectMatch -> ChannelSelectMatch -> Bool)
-> Eq ChannelSelectMatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
$c/= :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
== :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
$c== :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
Eq, Int -> ChannelSelectMatch -> ShowS
[ChannelSelectMatch] -> ShowS
ChannelSelectMatch -> String
(Int -> ChannelSelectMatch -> ShowS)
-> (ChannelSelectMatch -> String)
-> ([ChannelSelectMatch] -> ShowS)
-> Show ChannelSelectMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelSelectMatch] -> ShowS
$cshowList :: [ChannelSelectMatch] -> ShowS
show :: ChannelSelectMatch -> String
$cshow :: ChannelSelectMatch -> String
showsPrec :: Int -> ChannelSelectMatch -> ShowS
$cshowsPrec :: Int -> ChannelSelectMatch -> ShowS
Show, Eq ChannelSelectMatch
Eq ChannelSelectMatch
-> (ChannelSelectMatch -> ChannelSelectMatch -> Ordering)
-> (ChannelSelectMatch -> ChannelSelectMatch -> Bool)
-> (ChannelSelectMatch -> ChannelSelectMatch -> Bool)
-> (ChannelSelectMatch -> ChannelSelectMatch -> Bool)
-> (ChannelSelectMatch -> ChannelSelectMatch -> Bool)
-> (ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch)
-> (ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch)
-> Ord ChannelSelectMatch
ChannelSelectMatch -> ChannelSelectMatch -> Bool
ChannelSelectMatch -> ChannelSelectMatch -> Ordering
ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch
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 :: ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch
$cmin :: ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch
max :: ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch
$cmax :: ChannelSelectMatch -> ChannelSelectMatch -> ChannelSelectMatch
>= :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
$c>= :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
> :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
$c> :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
<= :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
$c<= :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
< :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
$c< :: ChannelSelectMatch -> ChannelSelectMatch -> Bool
compare :: ChannelSelectMatch -> ChannelSelectMatch -> Ordering
$ccompare :: ChannelSelectMatch -> ChannelSelectMatch -> Ordering
$cp1Ord :: Eq ChannelSelectMatch
Ord)

data ChannelSelectPattern = CSP MatchType Text
                          | CSPAny
                          deriving (ChannelSelectPattern -> ChannelSelectPattern -> Bool
(ChannelSelectPattern -> ChannelSelectPattern -> Bool)
-> (ChannelSelectPattern -> ChannelSelectPattern -> Bool)
-> Eq ChannelSelectPattern
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 -> String
(Int -> ChannelSelectPattern -> ShowS)
-> (ChannelSelectPattern -> String)
-> ([ChannelSelectPattern] -> ShowS)
-> Show ChannelSelectPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelSelectPattern] -> ShowS
$cshowList :: [ChannelSelectPattern] -> ShowS
show :: ChannelSelectPattern -> String
$cshow :: ChannelSelectPattern -> String
showsPrec :: Int -> ChannelSelectPattern -> ShowS
$cshowsPrec :: Int -> ChannelSelectPattern -> ShowS
Show)

data MatchType =
    Prefix
    | Suffix
    | Infix
    | Equal
    | PrefixDMOnly
    | PrefixNonDMOnly
    deriving (MatchType -> MatchType -> Bool
(MatchType -> MatchType -> Bool)
-> (MatchType -> MatchType -> Bool) -> Eq MatchType
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 -> String
(Int -> MatchType -> ShowS)
-> (MatchType -> String)
-> ([MatchType] -> ShowS)
-> Show MatchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchType] -> ShowS
$cshowList :: [MatchType] -> ShowS
show :: MatchType -> String
$cshow :: MatchType -> String
showsPrec :: Int -> MatchType -> ShowS
$cshowsPrec :: Int -> MatchType -> ShowS
Show)

-- * Application State Values

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

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

setUserPreferences :: Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences :: Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences = (UserPreferences -> Seq Preference -> UserPreferences)
-> Seq Preference -> UserPreferences -> UserPreferences
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Preference -> UserPreferences -> UserPreferences)
-> UserPreferences -> Seq Preference -> UserPreferences
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 Seq FlaggedPost -> FlaggedPost -> Seq FlaggedPost
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 =
                  UserId -> Bool -> HashMap UserId Bool -> HashMap UserId Bool
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 =
                  ChannelId
-> Bool -> HashMap ChannelId Bool -> HashMap ChannelId Bool
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 =
                  ChannelId
-> Bool -> HashMap ChannelId Bool -> HashMap ChannelId Bool
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 = [TeamId] -> Maybe [TeamId]
forall a. a -> Maybe a
Just [TeamId]
tIds
                }
            | Preference -> PreferenceName
preferenceName Preference
p PreferenceName -> PreferenceName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> PreferenceName
PreferenceName Text
"join_leave" =
              UserPreferences
u { _userPrefShowJoinLeave :: Bool
_userPrefShowJoinLeave =
                  Preference -> PreferenceValue
preferenceValue Preference
p PreferenceValue -> PreferenceValue -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> PreferenceValue
PreferenceValue Text
"false" }
            | Preference -> PreferenceCategory
preferenceCategory Preference
p PreferenceCategory -> PreferenceCategory -> Bool
forall a. Eq a => a -> a -> Bool
== PreferenceCategory
PreferenceCategoryDisplaySettings Bool -> Bool -> Bool
&&
              Preference -> PreferenceName
preferenceName Preference
p PreferenceName -> PreferenceName -> Bool
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 = TeammateNameDisplayMode -> Maybe TeammateNameDisplayMode
forall a. a -> Maybe a
Just (TeammateNameDisplayMode -> Maybe TeammateNameDisplayMode)
-> TeammateNameDisplayMode -> Maybe TeammateNameDisplayMode
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
(LogCategory -> LogCategory -> Bool)
-> (LogCategory -> LogCategory -> Bool) -> Eq LogCategory
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 -> String
(Int -> LogCategory -> ShowS)
-> (LogCategory -> String)
-> ([LogCategory] -> ShowS)
-> Show LogCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogCategory] -> ShowS
$cshowList :: [LogCategory] -> ShowS
show :: LogCategory -> String
$cshow :: LogCategory -> String
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
(LogMessage -> LogMessage -> Bool)
-> (LogMessage -> LogMessage -> Bool) -> Eq LogMessage
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 -> String
(Int -> LogMessage -> ShowS)
-> (LogMessage -> String)
-> ([LogMessage] -> ShowS)
-> Show LogMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage] -> ShowS
$cshowList :: [LogMessage] -> ShowS
show :: LogMessage -> String
$cshow :: LogMessage -> String
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 -> String
(Int -> LogCommand -> ShowS)
-> (LogCommand -> String)
-> ([LogCommand] -> ShowS)
-> Show LogCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogCommand] -> ShowS
$cshowList :: [LogCommand] -> ShowS
show :: LogCommand -> String
$cshow :: LogCommand -> String
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 -> String -> IO ()
startLoggingToFile LogManager
mgr String
loc = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr (LogCommand -> IO ()) -> LogCommand -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> LogCommand
LogToFile String
loc

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

requestLogSnapshot :: LogManager -> FilePath -> IO ()
requestLogSnapshot :: LogManager -> String -> IO ()
requestLogSnapshot LogManager
mgr String
path = LogManager -> LogCommand -> IO ()
sendLogCommand LogManager
mgr (LogCommand -> IO ()) -> LogCommand -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> LogCommand
LogSnapshot String
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 (LogCommand -> IO ()) -> LogCommand -> IO ()
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 =
    STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan LogCommand -> LogCommand -> STM ()
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
                  }

-- | A "special" mention that does not map to a specific user, but is an
-- alias that the server uses to notify users.
data SpecialMention =
    MentionAll
    -- ^ @all: notify everyone in the channel.
    | MentionChannel
    -- ^ @channel: notify everyone in the channel.

data AutocompleteAlternative =
    UserCompletion User Bool
    -- ^ User, plus whether the user is in the channel that triggered
    -- the autocomplete
    | SpecialMention SpecialMention
    -- ^ A special mention.
    | ChannelCompletion Bool Channel
    -- ^ Channel, plus whether the user is a member of the channel
    | SyntaxCompletion Text
    -- ^ Name of a skylighting syntax definition
    | CommandCompletion CompletionSource Text Text Text
    -- ^ Source, name of a slash command, argspec, and description
    | EmojiCompletion Text
    -- ^ The text of an emoji completion

-- | The source of an autocompletion alternative.
data CompletionSource = Server | Client
                      deriving (CompletionSource -> CompletionSource -> Bool
(CompletionSource -> CompletionSource -> Bool)
-> (CompletionSource -> CompletionSource -> Bool)
-> Eq CompletionSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionSource -> CompletionSource -> Bool
$c/= :: CompletionSource -> CompletionSource -> Bool
== :: CompletionSource -> CompletionSource -> Bool
$c== :: CompletionSource -> CompletionSource -> Bool
Eq, Int -> CompletionSource -> ShowS
[CompletionSource] -> ShowS
CompletionSource -> String
(Int -> CompletionSource -> ShowS)
-> (CompletionSource -> String)
-> ([CompletionSource] -> ShowS)
-> Show CompletionSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionSource] -> ShowS
$cshowList :: [CompletionSource] -> ShowS
show :: CompletionSource -> String
$cshow :: CompletionSource -> String
showsPrec :: Int -> CompletionSource -> ShowS
$cshowsPrec :: Int -> CompletionSource -> ShowS
Show)

specialMentionName :: SpecialMention -> Text
specialMentionName :: SpecialMention -> Text
specialMentionName SpecialMention
MentionChannel = Text
"channel"
specialMentionName SpecialMention
MentionAll = Text
"all"

isSpecialMention :: T.Text -> Bool
isSpecialMention :: Text -> Bool
isSpecialMention Text
n = Maybe SpecialMention -> Bool
forall a. Maybe a -> Bool
isJust (Maybe SpecialMention -> Bool) -> Maybe SpecialMention -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, SpecialMention)] -> Maybe SpecialMention
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimUserSigil Text
n) [(Text, SpecialMention)]
pairs
    where
        pairs :: [(Text, SpecialMention)]
pairs = SpecialMention -> (Text, SpecialMention)
mkPair (SpecialMention -> (Text, SpecialMention))
-> [SpecialMention] -> [(Text, SpecialMention)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SpecialMention]
mentions
        mentions :: [SpecialMention]
mentions = [ SpecialMention
MentionChannel
                   , SpecialMention
MentionAll
                   ]
        mkPair :: SpecialMention -> (Text, SpecialMention)
mkPair SpecialMention
v = (SpecialMention -> Text
specialMentionName SpecialMention
v, SpecialMention
v)

autocompleteAlternativeReplacement :: AutocompleteAlternative -> Text
autocompleteAlternativeReplacement :: AutocompleteAlternative -> Text
autocompleteAlternativeReplacement (EmojiCompletion Text
e) =
    Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
autocompleteAlternativeReplacement (SpecialMention SpecialMention
m) =
    Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SpecialMention -> Text
specialMentionName SpecialMention
m
autocompleteAlternativeReplacement (UserCompletion User
u Bool
_) =
    Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> User -> Text
userUsername User
u
autocompleteAlternativeReplacement (ChannelCompletion Bool
_ Channel
c) =
    Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
c)
autocompleteAlternativeReplacement (SyntaxCompletion Text
t) =
    Text
"```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
autocompleteAlternativeReplacement (CommandCompletion CompletionSource
_ Text
t Text
_ Text
_) =
    Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

-- | The type of data that the autocompletion logic supports. We use
-- this to track the kind of completion underway in case the type of
-- completion needs to change.
data AutocompletionType =
    ACUsers
    | ACChannels
    | ACCodeBlockLanguage
    | ACEmoji
    | ACCommands
    deriving (AutocompletionType -> AutocompletionType -> Bool
(AutocompletionType -> AutocompletionType -> Bool)
-> (AutocompletionType -> AutocompletionType -> Bool)
-> Eq AutocompletionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocompletionType -> AutocompletionType -> Bool
$c/= :: AutocompletionType -> AutocompletionType -> Bool
== :: AutocompletionType -> AutocompletionType -> Bool
$c== :: AutocompletionType -> AutocompletionType -> Bool
Eq, Int -> AutocompletionType -> ShowS
[AutocompletionType] -> ShowS
AutocompletionType -> String
(Int -> AutocompletionType -> ShowS)
-> (AutocompletionType -> String)
-> ([AutocompletionType] -> ShowS)
-> Show AutocompletionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocompletionType] -> ShowS
$cshowList :: [AutocompletionType] -> ShowS
show :: AutocompletionType -> String
$cshow :: AutocompletionType -> String
showsPrec :: Int -> AutocompletionType -> ShowS
$cshowsPrec :: Int -> AutocompletionType -> ShowS
Show)

data AutocompleteState =
    AutocompleteState { AutocompleteState -> Text
_acPreviousSearchString :: Text
                      -- ^ The search string used for the
                      -- currently-displayed autocomplete results, for
                      -- use in deciding whether to issue another server
                      -- query
                      , AutocompleteState -> List Name AutocompleteAlternative
_acCompletionList :: List Name AutocompleteAlternative
                      -- ^ The list of alternatives that the user
                      -- selects from
                      , AutocompleteState -> AutocompletionType
_acType :: AutocompletionType
                      -- ^ The type of data that we're completing
                      , AutocompleteState -> HashMap Text [AutocompleteAlternative]
_acCachedResponses :: HM.HashMap Text [AutocompleteAlternative]
                      -- ^ A cache of alternative lists, keyed on search
                      -- string, for use in avoiding server requests.
                      -- The idea here is that users type quickly enough
                      -- (and edit their input) that would normally lead
                      -- to rapid consecutive requests, some for the
                      -- same strings during editing, that we can avoid
                      -- that by caching them here. Note that this cache
                      -- gets destroyed whenever autocompletion is not
                      -- on, so this cache does not live very long.
                      }

-- | The 'ChatEditState' value contains the editor widget itself as well
-- as history and metadata we need for editing-related operations.
data ChatEditState =
    ChatEditState { ChatEditState -> Editor Text Name
_cedEditor :: Editor Text Name
                  , ChatEditState -> EditMode
_cedEditMode :: EditMode
                  , ChatEditState -> EphemeralEditState
_cedEphemeral :: EphemeralEditState
                  , ChatEditState -> Text
_cedYankBuffer :: Text
                  , ChatEditState -> Maybe (Aspell, IO ())
_cedSpellChecker :: Maybe (Aspell, IO ())
                  , ChatEditState -> Set Text
_cedMisspellings :: Set Text
                  , ChatEditState -> Maybe AutocompleteState
_cedAutocomplete :: Maybe AutocompleteState
                  -- ^ The autocomplete state. The autocompletion UI is
                  -- showing only when this state is present.
                  , ChatEditState -> Maybe Text
_cedAutocompletePending :: Maybe Text
                  -- ^ The search string associated with the latest
                  -- in-flight autocompletion request. This is used to
                  -- determine whether any (potentially late-arriving)
                  -- API responses are for stale queries since the user
                  -- can type more quickly than the server can get us
                  -- the results, and we wouldn't want to show results
                  -- associated with old editor states.
                  , ChatEditState -> List Name AttachmentData
_cedAttachmentList :: List Name AttachmentData
                  -- ^ The list of attachments to be uploaded with the
                  -- post being edited.
                  , ChatEditState -> Maybe (FileBrowser Name)
_cedFileBrowser :: Maybe (FB.FileBrowser Name)
                  -- ^ The browser for selecting attachment files.
                  -- This is a Maybe because the instantiation of the
                  -- FileBrowser causes it to read and ingest the
                  -- target directory, so this action is deferred
                  -- until the browser is needed.
                  , ChatEditState -> Bool
_cedJustCompleted :: Bool
                  -- A flag that indicates whether the most recent
                  -- editing event was a tab-completion. This is used by
                  -- the smart trailing space handling.
                  }

-- | An attachment.
data AttachmentData =
    AttachmentData { AttachmentData -> FileInfo
attachmentDataFileInfo :: FB.FileInfo
                   , AttachmentData -> ByteString
attachmentDataBytes :: BS.ByteString
                   }
                   deriving (AttachmentData -> AttachmentData -> Bool
(AttachmentData -> AttachmentData -> Bool)
-> (AttachmentData -> AttachmentData -> Bool) -> Eq AttachmentData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachmentData -> AttachmentData -> Bool
$c/= :: AttachmentData -> AttachmentData -> Bool
== :: AttachmentData -> AttachmentData -> Bool
$c== :: AttachmentData -> AttachmentData -> Bool
Eq, Int -> AttachmentData -> ShowS
[AttachmentData] -> ShowS
AttachmentData -> String
(Int -> AttachmentData -> ShowS)
-> (AttachmentData -> String)
-> ([AttachmentData] -> ShowS)
-> Show AttachmentData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachmentData] -> ShowS
$cshowList :: [AttachmentData] -> ShowS
show :: AttachmentData -> String
$cshow :: AttachmentData -> String
showsPrec :: Int -> AttachmentData -> ShowS
$cshowsPrec :: Int -> AttachmentData -> ShowS
Show)

-- | We can initialize a new 'ChatEditState' value with just an edit
-- history, which we save locally.
emptyEditState :: TeamId -> ChatEditState
emptyEditState :: TeamId -> ChatEditState
emptyEditState TeamId
tId =
    ChatEditState :: Editor Text Name
-> EditMode
-> EphemeralEditState
-> Text
-> Maybe (Aspell, IO ())
-> Set Text
-> Maybe AutocompleteState
-> Maybe Text
-> List Name AttachmentData
-> Maybe (FileBrowser Name)
-> Bool
-> ChatEditState
ChatEditState { _cedEditor :: Editor Text Name
_cedEditor               = Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
MessageInput TeamId
tId) Maybe Int
forall a. Maybe a
Nothing Text
""
                  , _cedEphemeral :: EphemeralEditState
_cedEphemeral            = EphemeralEditState
defaultEphemeralEditState
                  , _cedEditMode :: EditMode
_cedEditMode             = EditMode
NewPost
                  , _cedYankBuffer :: Text
_cedYankBuffer           = Text
""
                  , _cedSpellChecker :: Maybe (Aspell, IO ())
_cedSpellChecker         = Maybe (Aspell, IO ())
forall a. Maybe a
Nothing
                  , _cedMisspellings :: Set Text
_cedMisspellings         = Set Text
forall a. Monoid a => a
mempty
                  , _cedAutocomplete :: Maybe AutocompleteState
_cedAutocomplete         = Maybe AutocompleteState
forall a. Maybe a
Nothing
                  , _cedAutocompletePending :: Maybe Text
_cedAutocompletePending  = Maybe Text
forall a. Maybe a
Nothing
                  , _cedAttachmentList :: List Name AttachmentData
_cedAttachmentList       = Name -> Vector AttachmentData -> Int -> List Name AttachmentData
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
AttachmentList TeamId
tId) Vector AttachmentData
forall a. Monoid a => a
mempty Int
1
                  , _cedFileBrowser :: Maybe (FileBrowser Name)
_cedFileBrowser          = Maybe (FileBrowser Name)
forall a. Maybe a
Nothing
                  , _cedJustCompleted :: Bool
_cedJustCompleted        = Bool
False
                  }

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

-- | The 'HelpScreen' type represents the set of possible 'Help'
-- dialogues we have to choose from.
data HelpScreen =
    MainHelp
    | ScriptHelp
    | ThemeHelp
    | SyntaxHighlightHelp
    | KeybindingHelp
    deriving (HelpScreen -> HelpScreen -> Bool
(HelpScreen -> HelpScreen -> Bool)
-> (HelpScreen -> HelpScreen -> Bool) -> Eq HelpScreen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HelpScreen -> HelpScreen -> Bool
$c/= :: HelpScreen -> HelpScreen -> Bool
== :: HelpScreen -> HelpScreen -> Bool
$c== :: HelpScreen -> HelpScreen -> Bool
Eq)

-- | Help topics
data HelpTopic =
    HelpTopic { HelpTopic -> Text
helpTopicName         :: Text
              , HelpTopic -> Text
helpTopicDescription  :: Text
              , HelpTopic -> HelpScreen
helpTopicScreen       :: HelpScreen
              , HelpTopic -> Name
helpTopicViewportName :: Name
              }
              deriving (HelpTopic -> HelpTopic -> Bool
(HelpTopic -> HelpTopic -> Bool)
-> (HelpTopic -> HelpTopic -> Bool) -> Eq HelpTopic
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)

-- | Mode type for the current contents of the post list overlay
data PostListContents =
    PostListFlagged
    | PostListPinned ChannelId
    | PostListSearch Text Bool -- for the query and search status
    deriving (PostListContents -> PostListContents -> Bool
(PostListContents -> PostListContents -> Bool)
-> (PostListContents -> PostListContents -> Bool)
-> Eq PostListContents
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)

-- | The 'Mode' represents the current dominant UI activity
data Mode =
    Main
    | ShowHelp HelpTopic Mode
    | ChannelSelect
    | UrlSelect
    | LeaveChannelConfirm
    | DeleteChannelConfirm
    | MessageSelect
    | MessageSelectDeleteConfirm
    | PostListOverlay PostListContents
    | UserListOverlay
    | ReactionEmojiListOverlay
    | ChannelListOverlay
    | ThemeListOverlay
    | ViewMessage
    | ManageAttachments
    | ManageAttachmentsBrowseFiles
    | EditNotifyPrefs
    | ChannelTopicWindow
    | SaveAttachmentWindow LinkChoice
    deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
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)

-- | We're either connected or we're not.
data ConnectionStatus = Connected | Disconnected deriving (ConnectionStatus -> ConnectionStatus -> Bool
(ConnectionStatus -> ConnectionStatus -> Bool)
-> (ConnectionStatus -> ConnectionStatus -> Bool)
-> Eq ConnectionStatus
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)

-- | An entry in a tabbed window corresponding to a tab and its content.
-- Parameterized over an abstract handle type ('a') for the tabs so we
-- can give each a unique handle.
data TabbedWindowEntry a =
    TabbedWindowEntry { TabbedWindowEntry a -> a
tweValue :: a
                      -- ^ The handle for this tab.
                      , TabbedWindowEntry a -> a -> ChatState -> Widget Name
tweRender :: a -> ChatState -> Widget Name
                      -- ^ The rendering function to use when this tab
                      -- is selected.
                      , TabbedWindowEntry a -> a -> Event -> MH ()
tweHandleEvent :: a -> Vty.Event -> MH ()
                      -- ^ The event-handling function to use when this
                      -- tab is selected.
                      , TabbedWindowEntry a -> a -> Bool -> Text
tweTitle :: a -> Bool -> T.Text
                      -- ^ Title function for this tab, with a boolean
                      -- indicating whether this is the current tab.
                      , TabbedWindowEntry a -> a -> MH ()
tweShowHandler :: a -> MH ()
                      -- ^ A handler to be invoked when this tab is
                      -- shown.
                      }

-- | The definition of a tabbed window. Note that this does not track
-- the *state* of the window; it merely provides a collection of tab
-- window entries (see above). To track the state of a tabbed window,
-- use a TabbedWindow.
--
-- Parameterized over an abstract handle type ('a') for the tabs so we
-- can give each a unique handle.
data TabbedWindowTemplate a =
    TabbedWindowTemplate { TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries :: [TabbedWindowEntry a]
                         -- ^ The entries in tabbed windows with this
                         -- structure.
                         , TabbedWindowTemplate a -> a -> Widget Name
twtTitle :: a -> Widget Name
                         -- ^ The title-rendering function for this kind
                         -- of tabbed window.
                         }

-- | An instantiated tab window. This is based on a template and tracks
-- the state of the tabbed window (current tab).
--
-- Parameterized over an abstract handle type ('a') for the tabs so we
-- can give each a unique handle.
data TabbedWindow a =
    TabbedWindow { TabbedWindow a -> a
twValue :: a
                 -- ^ The handle of the currently-selected tab.
                 , TabbedWindow a -> Mode
twReturnMode :: Mode
                 -- ^ The mode to return to when the tab is closed.
                 , TabbedWindow a -> TabbedWindowTemplate a
twTemplate :: TabbedWindowTemplate a
                 -- ^ The template to use as a basis for rendering the
                 -- window and handling user input.
                 , TabbedWindow a -> Int
twWindowWidth :: Int
                 , TabbedWindow a -> Int
twWindowHeight :: Int
                 -- ^ Window dimensions
                 }

-- | Construct a new tabbed window from a template. This will raise an
-- exception if the initially-selected tab does not exist in the window
-- template, or if the window template has any duplicated tab handles.
--
-- Note that the caller is responsible for determining whether to call
-- the initially-selected tab's on-show handler.
tabbedWindow :: (Show a, Eq a)
             => a
             -- ^ The handle corresponding to the tab that should be
             -- selected initially.
             -> TabbedWindowTemplate a
             -- ^ The template for the window to construct.
             -> Mode
             -- ^ When the window is closed, return to this application
             -- mode.
             -> (Int, Int)
             -- ^ The window dimensions (width, height).
             -> TabbedWindow a
tabbedWindow :: a -> TabbedWindowTemplate a -> Mode -> (Int, Int) -> TabbedWindow a
tabbedWindow a
initialVal TabbedWindowTemplate a
t Mode
retMode (Int
width, Int
height) =
    let handles :: [a]
handles = TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue (TabbedWindowEntry a -> a) -> [TabbedWindowEntry a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries TabbedWindowTemplate a
t
    in if | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
handles ->
              String -> TabbedWindow a
forall a. HasCallStack => String -> a
error String
"BUG: tabbed window template must provide at least one entry"
          | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
handles Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
handles) ->
              String -> TabbedWindow a
forall a. HasCallStack => String -> a
error String
"BUG: tabbed window should have one entry per handle"
          | Bool -> Bool
not (a
initialVal a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
handles) ->
              String -> TabbedWindow a
forall a. HasCallStack => String -> a
error (String -> TabbedWindow a) -> String -> TabbedWindow a
forall a b. (a -> b) -> a -> b
$ String
"BUG: tabbed window handle " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                      a -> String
forall a. Show a => a -> String
show a
initialVal String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not present in template"
          | Bool
otherwise ->
              TabbedWindow :: forall a.
a -> Mode -> TabbedWindowTemplate a -> Int -> Int -> TabbedWindow a
TabbedWindow { twTemplate :: TabbedWindowTemplate a
twTemplate = TabbedWindowTemplate a
t
                           , twValue :: a
twValue = a
initialVal
                           , twReturnMode :: Mode
twReturnMode = Mode
retMode
                           , twWindowWidth :: Int
twWindowWidth = Int
width
                           , twWindowHeight :: Int
twWindowHeight = Int
height
                           }

-- | Get the currently-selected tab entry for a tabbed window. Raise
-- an exception if the window's selected tab handle is not found in its
-- template (which is a bug in the tabbed window infrastructure).
getCurrentTabbedWindowEntry :: (Show a, Eq a)
                            => TabbedWindow a
                            -> TabbedWindowEntry a
getCurrentTabbedWindowEntry :: TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w =
    a -> TabbedWindow a -> TabbedWindowEntry a
forall a.
(Eq a, Show a) =>
a -> TabbedWindow a -> TabbedWindowEntry a
lookupTabbedWindowEntry (TabbedWindow a -> a
forall a. TabbedWindow a -> a
twValue TabbedWindow a
w) TabbedWindow a
w

-- | Run the on-show handler for the window tab entry with the specified
-- handle.
runTabShowHandlerFor :: (Eq a, Show a) => a -> TabbedWindow a -> MH ()
runTabShowHandlerFor :: a -> TabbedWindow a -> MH ()
runTabShowHandlerFor a
handle TabbedWindow a
w = do
    let entry :: TabbedWindowEntry a
entry = a -> TabbedWindow a -> TabbedWindowEntry a
forall a.
(Eq a, Show a) =>
a -> TabbedWindow a -> TabbedWindowEntry a
lookupTabbedWindowEntry a
handle TabbedWindow a
w
    TabbedWindowEntry a -> a -> MH ()
forall a. TabbedWindowEntry a -> a -> MH ()
tweShowHandler TabbedWindowEntry a
entry a
handle

-- | Look up a tabbed window entry by handle. Raises an exception if no
-- such entry exists.
lookupTabbedWindowEntry :: (Eq a, Show a)
                        => a
                        -> TabbedWindow a
                        -> TabbedWindowEntry a
lookupTabbedWindowEntry :: a -> TabbedWindow a -> TabbedWindowEntry a
lookupTabbedWindowEntry a
handle TabbedWindow a
w =
    let matchesVal :: TabbedWindowEntry a -> Bool
matchesVal TabbedWindowEntry a
e = TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
handle
    in case (TabbedWindowEntry a -> Bool)
-> [TabbedWindowEntry a] -> [TabbedWindowEntry a]
forall a. (a -> Bool) -> [a] -> [a]
filter TabbedWindowEntry a -> Bool
matchesVal (TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindowTemplate a -> [TabbedWindowEntry a])
-> TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a b. (a -> b) -> a -> b
$ TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w) of
        [TabbedWindowEntry a
e] -> TabbedWindowEntry a
e
        [TabbedWindowEntry a]
_ -> String -> TabbedWindowEntry a
forall a. HasCallStack => String -> a
error (String -> TabbedWindowEntry a) -> String -> TabbedWindowEntry a
forall a b. (a -> b) -> a -> b
$ String
"BUG: tabbed window entry for " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show (TabbedWindow a -> a
forall a. TabbedWindow a -> a
twValue TabbedWindow a
w) String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                     String
" should have matched a single entry"

-- | Switch a tabbed window's selected tab to its next tab, cycling back
-- to the first tab if the last tab is the selected tab. This also
-- invokes the on-show handler for the newly-selected tab.
--
-- Note that this does nothing if the window has only one tab.
tabbedWindowNextTab :: (Show a, Eq a)
                    => TabbedWindow a
                    -> MH (TabbedWindow a)
tabbedWindowNextTab :: TabbedWindow a -> MH (TabbedWindow a)
tabbedWindowNextTab TabbedWindow a
w | [TabbedWindowEntry a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindowTemplate a -> [TabbedWindowEntry a])
-> TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a b. (a -> b) -> a -> b
$ TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = TabbedWindow a -> MH (TabbedWindow a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow a
w
tabbedWindowNextTab TabbedWindow a
w = do
    let curIdx :: Int
curIdx = case a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
curEntry) [a]
allHandles of
            Maybe Int
Nothing ->
                String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"BUG: tabbedWindowNextTab: could not find " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                        String
"current handle in handle list"
            Just Int
i -> Int
i
        nextIdx :: Int
nextIdx = if Int
curIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
allHandles Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                  then Int
0
                  else Int
curIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        newHandle :: a
newHandle = [a]
allHandles [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
nextIdx
        allHandles :: [a]
allHandles = TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue (TabbedWindowEntry a -> a) -> [TabbedWindowEntry a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w)
        curEntry :: TabbedWindowEntry a
curEntry = TabbedWindow a -> TabbedWindowEntry a
forall a. (Show a, Eq a) => TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w
        newWin :: TabbedWindow a
newWin = TabbedWindow a
w { twValue :: a
twValue = a
newHandle }

    a -> TabbedWindow a -> MH ()
forall a. (Eq a, Show a) => a -> TabbedWindow a -> MH ()
runTabShowHandlerFor a
newHandle TabbedWindow a
newWin
    TabbedWindow a -> MH (TabbedWindow a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow a
newWin

-- | Switch a tabbed window's selected tab to its previous tab, cycling
-- to the last tab if the first tab is the selected tab. This also
-- invokes the on-show handler for the newly-selected tab.
--
-- Note that this does nothing if the window has only one tab.
tabbedWindowPreviousTab :: (Show a, Eq a)
                        => TabbedWindow a
                        -> MH (TabbedWindow a)
tabbedWindowPreviousTab :: TabbedWindow a -> MH (TabbedWindow a)
tabbedWindowPreviousTab TabbedWindow a
w | [TabbedWindowEntry a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindowTemplate a -> [TabbedWindowEntry a])
-> TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a b. (a -> b) -> a -> b
$ TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = TabbedWindow a -> MH (TabbedWindow a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow a
w
tabbedWindowPreviousTab TabbedWindow a
w = do
    let curIdx :: Int
curIdx = case a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
curEntry) [a]
allHandles of
            Maybe Int
Nothing ->
                String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"BUG: tabbedWindowPreviousTab: could not find " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
                        String
"current handle in handle list"
            Just Int
i -> Int
i
        nextIdx :: Int
nextIdx = if Int
curIdx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                  then [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
allHandles Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                  else Int
curIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        newHandle :: a
newHandle = [a]
allHandles [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
nextIdx
        allHandles :: [a]
allHandles = TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue (TabbedWindowEntry a -> a) -> [TabbedWindowEntry a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w)
        curEntry :: TabbedWindowEntry a
curEntry = TabbedWindow a -> TabbedWindowEntry a
forall a. (Show a, Eq a) => TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w
        newWin :: TabbedWindow a
newWin = TabbedWindow a
w { twValue :: a
twValue = a
newHandle }

    a -> TabbedWindow a -> MH ()
forall a. (Eq a, Show a) => a -> TabbedWindow a -> MH ()
runTabShowHandlerFor a
newHandle TabbedWindow a
newWin
    TabbedWindow a -> MH (TabbedWindow a)
forall (m :: * -> *) a. Monad m => a -> m a
return TabbedWindow a
newWin

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
(ChannelListOrientation -> ChannelListOrientation -> Bool)
-> (ChannelListOrientation -> ChannelListOrientation -> Bool)
-> Eq ChannelListOrientation
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 -> String
(Int -> ChannelListOrientation -> ShowS)
-> (ChannelListOrientation -> String)
-> ([ChannelListOrientation] -> ShowS)
-> Show ChannelListOrientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListOrientation] -> ShowS
$cshowList :: [ChannelListOrientation] -> ShowS
show :: ChannelListOrientation -> String
$cshow :: ChannelListOrientation -> String
showsPrec :: Int -> ChannelListOrientation -> ShowS
$cshowsPrec :: Int -> ChannelListOrientation -> 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 -> 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 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.
              }

-- | 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 -> 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 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 -> ChatEditState
_tsEditState :: ChatEditState
              -- ^ The state of the input box used for composing and
              -- editing messages and commands.
              , TeamState -> MessageSelectState
_tsMessageSelect :: MessageSelectState
              -- ^ The state of message selection mode.
              , TeamState -> Team
_tsTeam :: Team
              -- ^ The team data.
              , TeamState -> ChannelSelectState
_tsChannelSelectState :: ChannelSelectState
              -- ^ The state of the user's input and selection for
              -- channel selection mode.
              , TeamState -> List Name (Int, LinkChoice)
_tsUrlList :: List Name (Int, LinkChoice)
              -- ^ The URL list used to show URLs drawn from messages in
              -- a channel.
              , TeamState -> Maybe (Message, TabbedWindow ViewMessageWindowTab)
_tsViewedMessage :: Maybe (Message, TabbedWindow 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 -> PostListOverlayState
_tsPostListOverlay :: PostListOverlayState
              -- ^ The state of the post list overlay.
              , TeamState -> ListOverlayState UserInfo UserSearchScope
_tsUserListOverlay :: ListOverlayState UserInfo UserSearchScope
              -- ^ The state of the user list overlay.
              , TeamState -> ListOverlayState Channel ChannelSearchScope
_tsChannelListOverlay :: ListOverlayState Channel ChannelSearchScope
              -- ^ The state of the user list overlay.
              , 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 -> Mode
_tsMode :: Mode
              -- ^ The current application mode when viewing this team.
              -- This is used to dispatch to different rendering and
              -- event handling routines.
              , TeamState -> ListOverlayState (Bool, Text) ()
_tsReactionEmojiListOverlay :: ListOverlayState (Bool, T.Text) ()
              -- ^ The state of the reaction emoji list overlay.
              , TeamState -> ListOverlayState InternalTheme ()
_tsThemeListOverlay :: ListOverlayState InternalTheme ()
              -- ^ The state of the theme list overlay.
              , TeamState -> SaveAttachmentDialogState
_tsSaveAttachmentDialog :: SaveAttachmentDialogState
              -- ^ The state for the interactive attachment-saving
              -- editor window.
              }

-- | Handles for the View Message window's tabs.
data ViewMessageWindowTab =
    VMTabMessage
    -- ^ The message tab.
    | VMTabReactions
    -- ^ The reactions tab.
    deriving (ViewMessageWindowTab -> ViewMessageWindowTab -> Bool
(ViewMessageWindowTab -> ViewMessageWindowTab -> Bool)
-> (ViewMessageWindowTab -> ViewMessageWindowTab -> Bool)
-> Eq ViewMessageWindowTab
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 -> String
(Int -> ViewMessageWindowTab -> ShowS)
-> (ViewMessageWindowTab -> String)
-> ([ViewMessageWindowTab] -> ShowS)
-> Show ViewMessageWindowTab
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewMessageWindowTab] -> ShowS
$cshowList :: [ViewMessageWindowTab] -> ShowS
show :: ViewMessageWindowTab -> String
$cshow :: ViewMessageWindowTab -> String
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)
                            }

-- | The state of the attachment path window.
data SaveAttachmentDialogState =
    SaveAttachmentDialogState { SaveAttachmentDialogState -> Editor Text Name
_attachmentPathEditor :: Editor T.Text Name
                              -- ^ The attachment path editor state.
                              , SaveAttachmentDialogState -> FocusRing Name
_attachmentPathDialogFocus :: FocusRing Name
                              -- ^ The window focus state (editor/buttons)
                              }

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

mkTeamZipper :: HM.HashMap TeamId TeamState -> Z.Zipper () TeamId
mkTeamZipper :: HashMap TeamId TeamState -> Zipper () TeamId
mkTeamZipper HashMap TeamId TeamState
m =
    let sortedTeams :: [Team]
sortedTeams = [Team] -> [Team]
sortTeams ([Team] -> [Team]) -> [Team] -> [Team]
forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam (TeamState -> Team) -> [TeamState] -> [Team]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap TeamId TeamState -> [TeamState]
forall k v. HashMap k v -> [v]
HM.elems HashMap TeamId TeamState
m
    in [TeamId] -> Zipper () TeamId
mkTeamZipperFromIds ([TeamId] -> Zipper () TeamId) -> [TeamId] -> Zipper () TeamId
forall a b. (a -> b) -> a -> b
$ Team -> TeamId
teamId (Team -> TeamId) -> [Team] -> [TeamId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Team]
sortedTeams

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

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

newTeamState :: Team
             -> Z.Zipper ChannelListGroup ChannelListEntry
             -> Maybe (Aspell, IO ())
             -> TeamState
newTeamState :: Team
-> Zipper ChannelListGroup ChannelListEntry
-> Maybe (Aspell, IO ())
-> TeamState
newTeamState Team
team Zipper ChannelListGroup ChannelListEntry
chanList Maybe (Aspell, IO ())
spellChecker =
    let tId :: TeamId
tId = Team -> TeamId
teamId Team
team
    in TeamState :: Zipper ChannelListGroup ChannelListEntry
-> Maybe PendingChannelChange
-> Maybe ChannelId
-> Maybe ChannelId
-> ChatEditState
-> MessageSelectState
-> Team
-> ChannelSelectState
-> List Name (Int, LinkChoice)
-> Maybe (Message, TabbedWindow ViewMessageWindowTab)
-> PostListOverlayState
-> ListOverlayState UserInfo UserSearchScope
-> ListOverlayState Channel ChannelSearchScope
-> Maybe (Form ChannelNotifyProps MHEvent Name)
-> ChannelTopicDialogState
-> Mode
-> ListOverlayState (Bool, Text) ()
-> ListOverlayState InternalTheme ()
-> SaveAttachmentDialogState
-> TeamState
TeamState { _tsMode :: Mode
_tsMode                     = Mode
Main
                 , _tsFocus :: Zipper ChannelListGroup ChannelListEntry
_tsFocus                    = Zipper ChannelListGroup ChannelListEntry
chanList
                 , _tsEditState :: ChatEditState
_tsEditState                = (TeamId -> ChatEditState
emptyEditState TeamId
tId) { _cedSpellChecker :: Maybe (Aspell, IO ())
_cedSpellChecker = Maybe (Aspell, IO ())
spellChecker }
                 , _tsTeam :: Team
_tsTeam                     = Team
team
                 , _tsUrlList :: List Name (Int, LinkChoice)
_tsUrlList                  = Name
-> Vector (Int, LinkChoice) -> Int -> List Name (Int, LinkChoice)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
UrlList TeamId
tId) Vector (Int, LinkChoice)
forall a. Monoid a => a
mempty Int
2
                 , _tsPostListOverlay :: PostListOverlayState
_tsPostListOverlay          = Messages -> Maybe PostId -> PostListOverlayState
PostListOverlayState Messages
forall dir a. DirectionalSeq dir a
emptyDirSeq Maybe PostId
forall a. Maybe a
Nothing
                 , _tsUserListOverlay :: ListOverlayState UserInfo UserSearchScope
_tsUserListOverlay          = TeamId -> ListOverlayState UserInfo UserSearchScope
nullUserListOverlayState TeamId
tId
                 , _tsChannelListOverlay :: ListOverlayState Channel ChannelSearchScope
_tsChannelListOverlay       = TeamId -> ListOverlayState Channel ChannelSearchScope
nullChannelListOverlayState TeamId
tId
                 , _tsChannelSelectState :: ChannelSelectState
_tsChannelSelectState       = TeamId -> ChannelSelectState
emptyChannelSelectState TeamId
tId
                 , _tsChannelTopicDialog :: ChannelTopicDialogState
_tsChannelTopicDialog       = TeamId -> Text -> ChannelTopicDialogState
newChannelTopicDialog TeamId
tId Text
""
                 , _tsMessageSelect :: MessageSelectState
_tsMessageSelect            = Maybe MessageId -> MessageSelectState
MessageSelectState Maybe MessageId
forall a. Maybe a
Nothing
                 , _tsNotifyPrefs :: Maybe (Form ChannelNotifyProps MHEvent Name)
_tsNotifyPrefs              = Maybe (Form ChannelNotifyProps MHEvent Name)
forall a. Maybe a
Nothing
                 , _tsPendingChannelChange :: Maybe PendingChannelChange
_tsPendingChannelChange     = Maybe PendingChannelChange
forall a. Maybe a
Nothing
                 , _tsRecentChannel :: Maybe ChannelId
_tsRecentChannel            = Maybe ChannelId
forall a. Maybe a
Nothing
                 , _tsReturnChannel :: Maybe ChannelId
_tsReturnChannel            = Maybe ChannelId
forall a. Maybe a
Nothing
                 , _tsViewedMessage :: Maybe (Message, TabbedWindow ViewMessageWindowTab)
_tsViewedMessage            = Maybe (Message, TabbedWindow ViewMessageWindowTab)
forall a. Maybe a
Nothing
                 , _tsThemeListOverlay :: ListOverlayState InternalTheme ()
_tsThemeListOverlay         = TeamId -> ListOverlayState InternalTheme ()
nullThemeListOverlayState TeamId
tId
                 , _tsReactionEmojiListOverlay :: ListOverlayState (Bool, Text) ()
_tsReactionEmojiListOverlay = TeamId -> ListOverlayState (Bool, Text) ()
nullEmojiListOverlayState TeamId
tId
                 , _tsSaveAttachmentDialog :: SaveAttachmentDialogState
_tsSaveAttachmentDialog     = TeamId -> Text -> SaveAttachmentDialogState
newSaveAttachmentDialog TeamId
tId Text
""
                 }

-- | Make a new channel topic editor window state.
newChannelTopicDialog :: TeamId -> T.Text -> ChannelTopicDialogState
newChannelTopicDialog :: TeamId -> Text -> ChannelTopicDialogState
newChannelTopicDialog TeamId
tId Text
t =
    ChannelTopicDialogState :: Editor Text Name -> FocusRing Name -> ChannelTopicDialogState
ChannelTopicDialogState { _channelTopicDialogEditor :: Editor Text Name
_channelTopicDialogEditor = Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ChannelTopicEditor TeamId
tId) Maybe Int
forall a. Maybe a
Nothing Text
t
                            , _channelTopicDialogFocus :: FocusRing Name
_channelTopicDialogFocus = [Name] -> FocusRing Name
forall n. [n] -> FocusRing n
focusRing [ TeamId -> Name
ChannelTopicEditor TeamId
tId
                                                                   , TeamId -> Name
ChannelTopicSaveButton TeamId
tId
                                                                   , TeamId -> Name
ChannelTopicCancelButton TeamId
tId
                                                                   ]
                            }

-- | Make a new attachment-saving editor window state.
newSaveAttachmentDialog :: TeamId -> T.Text -> SaveAttachmentDialogState
newSaveAttachmentDialog :: TeamId -> Text -> SaveAttachmentDialogState
newSaveAttachmentDialog TeamId
tId Text
t =
    SaveAttachmentDialogState :: Editor Text Name -> FocusRing Name -> SaveAttachmentDialogState
SaveAttachmentDialogState { _attachmentPathEditor :: Editor Text Name
_attachmentPathEditor = (TextZipper Text -> TextZipper Text)
-> Editor Text Name -> Editor Text Name
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
Z2.gotoEOL (Editor Text Name -> Editor Text Name)
-> Editor Text Name -> Editor Text Name
forall a b. (a -> b) -> a -> b
$
                                                        Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
AttachmentPathEditor TeamId
tId) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
t
                              , _attachmentPathDialogFocus :: FocusRing Name
_attachmentPathDialogFocus = [Name] -> FocusRing Name
forall n. [n] -> FocusRing n
focusRing [ TeamId -> Name
AttachmentPathEditor TeamId
tId
                                                                       , TeamId -> Name
AttachmentPathSaveButton TeamId
tId
                                                                       , TeamId -> Name
AttachmentPathCancelButton TeamId
tId
                                                                       ]
                              }

nullChannelListOverlayState :: TeamId -> ListOverlayState Channel ChannelSearchScope
nullChannelListOverlayState :: TeamId -> ListOverlayState Channel ChannelSearchScope
nullChannelListOverlayState TeamId
tId =
    let newList :: Vector Channel -> GenericList Name Vector Channel
newList Vector Channel
rs = Name -> Vector Channel -> Int -> GenericList Name Vector Channel
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
JoinChannelList TeamId
tId) Vector Channel
rs Int
2
    in ListOverlayState :: forall a b.
List Name a
-> Editor Text Name
-> b
-> Bool
-> (a -> MH Bool)
-> (Vector a -> List Name a)
-> (b -> Session -> Text -> IO (Vector a))
-> Maybe Int
-> Mode
-> ListOverlayState a b
ListOverlayState { _listOverlaySearchResults :: GenericList Name Vector Channel
_listOverlaySearchResults  = Vector Channel -> GenericList Name Vector Channel
newList Vector Channel
forall a. Monoid a => a
mempty
                        , _listOverlaySearchInput :: Editor Text Name
_listOverlaySearchInput    = Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
JoinChannelListSearchInput TeamId
tId) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
""
                        , _listOverlaySearchScope :: ChannelSearchScope
_listOverlaySearchScope    = ChannelSearchScope
AllChannels
                        , _listOverlaySearching :: Bool
_listOverlaySearching      = Bool
False
                        , _listOverlayEnterHandler :: Channel -> MH Bool
_listOverlayEnterHandler   = MH Bool -> Channel -> MH Bool
forall a b. a -> b -> a
const (MH Bool -> Channel -> MH Bool) -> MH Bool -> Channel -> MH Bool
forall a b. (a -> b) -> a -> b
$ Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        , _listOverlayNewList :: Vector Channel -> GenericList Name Vector Channel
_listOverlayNewList        = Vector Channel -> GenericList Name Vector Channel
newList
                        , _listOverlayFetchResults :: ChannelSearchScope -> Session -> Text -> IO (Vector Channel)
_listOverlayFetchResults   = (Session -> Text -> IO (Vector Channel))
-> ChannelSearchScope -> Session -> Text -> IO (Vector Channel)
forall a b. a -> b -> a
const ((Session -> Text -> IO (Vector Channel))
 -> ChannelSearchScope -> Session -> Text -> IO (Vector Channel))
-> (Session -> Text -> IO (Vector Channel))
-> ChannelSearchScope
-> Session
-> Text
-> IO (Vector Channel)
forall a b. (a -> b) -> a -> b
$ (Text -> IO (Vector Channel))
-> Session -> Text -> IO (Vector Channel)
forall a b. a -> b -> a
const ((Text -> IO (Vector Channel))
 -> Session -> Text -> IO (Vector Channel))
-> (Text -> IO (Vector Channel))
-> Session
-> Text
-> IO (Vector Channel)
forall a b. (a -> b) -> a -> b
$ IO (Vector Channel) -> Text -> IO (Vector Channel)
forall a b. a -> b -> a
const (IO (Vector Channel) -> Text -> IO (Vector Channel))
-> IO (Vector Channel) -> Text -> IO (Vector Channel)
forall a b. (a -> b) -> a -> b
$ Vector Channel -> IO (Vector Channel)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Channel
forall a. Monoid a => a
mempty
                        , _listOverlayRecordCount :: Maybe Int
_listOverlayRecordCount    = Maybe Int
forall a. Maybe a
Nothing
                        , _listOverlayReturnMode :: Mode
_listOverlayReturnMode     = Mode
Main
                        }

nullThemeListOverlayState :: TeamId -> ListOverlayState InternalTheme ()
nullThemeListOverlayState :: TeamId -> ListOverlayState InternalTheme ()
nullThemeListOverlayState TeamId
tId =
    let newList :: Vector InternalTheme -> GenericList Name Vector InternalTheme
newList Vector InternalTheme
rs = Name
-> Vector InternalTheme
-> Int
-> GenericList Name Vector InternalTheme
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
ThemeListSearchResults TeamId
tId) Vector InternalTheme
rs Int
3
    in ListOverlayState :: forall a b.
List Name a
-> Editor Text Name
-> b
-> Bool
-> (a -> MH Bool)
-> (Vector a -> List Name a)
-> (b -> Session -> Text -> IO (Vector a))
-> Maybe Int
-> Mode
-> ListOverlayState a b
ListOverlayState { _listOverlaySearchResults :: GenericList Name Vector InternalTheme
_listOverlaySearchResults  = Vector InternalTheme -> GenericList Name Vector InternalTheme
newList Vector InternalTheme
forall a. Monoid a => a
mempty
                        , _listOverlaySearchInput :: Editor Text Name
_listOverlaySearchInput    = Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ThemeListSearchInput TeamId
tId) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
""
                        , _listOverlaySearchScope :: ()
_listOverlaySearchScope    = ()
                        , _listOverlaySearching :: Bool
_listOverlaySearching      = Bool
False
                        , _listOverlayEnterHandler :: InternalTheme -> MH Bool
_listOverlayEnterHandler   = MH Bool -> InternalTheme -> MH Bool
forall a b. a -> b -> a
const (MH Bool -> InternalTheme -> MH Bool)
-> MH Bool -> InternalTheme -> MH Bool
forall a b. (a -> b) -> a -> b
$ Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        , _listOverlayNewList :: Vector InternalTheme -> GenericList Name Vector InternalTheme
_listOverlayNewList        = Vector InternalTheme -> GenericList Name Vector InternalTheme
newList
                        , _listOverlayFetchResults :: () -> Session -> Text -> IO (Vector InternalTheme)
_listOverlayFetchResults   = (Session -> Text -> IO (Vector InternalTheme))
-> () -> Session -> Text -> IO (Vector InternalTheme)
forall a b. a -> b -> a
const ((Session -> Text -> IO (Vector InternalTheme))
 -> () -> Session -> Text -> IO (Vector InternalTheme))
-> (Session -> Text -> IO (Vector InternalTheme))
-> ()
-> Session
-> Text
-> IO (Vector InternalTheme)
forall a b. (a -> b) -> a -> b
$ (Text -> IO (Vector InternalTheme))
-> Session -> Text -> IO (Vector InternalTheme)
forall a b. a -> b -> a
const ((Text -> IO (Vector InternalTheme))
 -> Session -> Text -> IO (Vector InternalTheme))
-> (Text -> IO (Vector InternalTheme))
-> Session
-> Text
-> IO (Vector InternalTheme)
forall a b. (a -> b) -> a -> b
$ IO (Vector InternalTheme) -> Text -> IO (Vector InternalTheme)
forall a b. a -> b -> a
const (IO (Vector InternalTheme) -> Text -> IO (Vector InternalTheme))
-> IO (Vector InternalTheme) -> Text -> IO (Vector InternalTheme)
forall a b. (a -> b) -> a -> b
$ Vector InternalTheme -> IO (Vector InternalTheme)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector InternalTheme
forall a. Monoid a => a
mempty
                        , _listOverlayRecordCount :: Maybe Int
_listOverlayRecordCount    = Maybe Int
forall a. Maybe a
Nothing
                        , _listOverlayReturnMode :: Mode
_listOverlayReturnMode     = Mode
Main
                        }

nullUserListOverlayState :: TeamId -> ListOverlayState UserInfo UserSearchScope
nullUserListOverlayState :: TeamId -> ListOverlayState UserInfo UserSearchScope
nullUserListOverlayState TeamId
tId =
    let newList :: Vector UserInfo -> GenericList Name Vector UserInfo
newList Vector UserInfo
rs = Name -> Vector UserInfo -> Int -> GenericList Name Vector UserInfo
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
UserListSearchResults TeamId
tId) Vector UserInfo
rs Int
1
    in ListOverlayState :: forall a b.
List Name a
-> Editor Text Name
-> b
-> Bool
-> (a -> MH Bool)
-> (Vector a -> List Name a)
-> (b -> Session -> Text -> IO (Vector a))
-> Maybe Int
-> Mode
-> ListOverlayState a b
ListOverlayState { _listOverlaySearchResults :: GenericList Name Vector UserInfo
_listOverlaySearchResults  = Vector UserInfo -> GenericList Name Vector UserInfo
newList Vector UserInfo
forall a. Monoid a => a
mempty
                        , _listOverlaySearchInput :: Editor Text Name
_listOverlaySearchInput    = Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
UserListSearchInput TeamId
tId) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
""
                        , _listOverlaySearchScope :: UserSearchScope
_listOverlaySearchScope    = Maybe TeamId -> UserSearchScope
AllUsers Maybe TeamId
forall a. Maybe a
Nothing
                        , _listOverlaySearching :: Bool
_listOverlaySearching      = Bool
False
                        , _listOverlayEnterHandler :: UserInfo -> MH Bool
_listOverlayEnterHandler   = MH Bool -> UserInfo -> MH Bool
forall a b. a -> b -> a
const (MH Bool -> UserInfo -> MH Bool) -> MH Bool -> UserInfo -> MH Bool
forall a b. (a -> b) -> a -> b
$ Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        , _listOverlayNewList :: Vector UserInfo -> GenericList Name Vector UserInfo
_listOverlayNewList        = Vector UserInfo -> GenericList Name Vector UserInfo
newList
                        , _listOverlayFetchResults :: UserSearchScope -> Session -> Text -> IO (Vector UserInfo)
_listOverlayFetchResults   = (Session -> Text -> IO (Vector UserInfo))
-> UserSearchScope -> Session -> Text -> IO (Vector UserInfo)
forall a b. a -> b -> a
const ((Session -> Text -> IO (Vector UserInfo))
 -> UserSearchScope -> Session -> Text -> IO (Vector UserInfo))
-> (Session -> Text -> IO (Vector UserInfo))
-> UserSearchScope
-> Session
-> Text
-> IO (Vector UserInfo)
forall a b. (a -> b) -> a -> b
$ (Text -> IO (Vector UserInfo))
-> Session -> Text -> IO (Vector UserInfo)
forall a b. a -> b -> a
const ((Text -> IO (Vector UserInfo))
 -> Session -> Text -> IO (Vector UserInfo))
-> (Text -> IO (Vector UserInfo))
-> Session
-> Text
-> IO (Vector UserInfo)
forall a b. (a -> b) -> a -> b
$ IO (Vector UserInfo) -> Text -> IO (Vector UserInfo)
forall a b. a -> b -> a
const (IO (Vector UserInfo) -> Text -> IO (Vector UserInfo))
-> IO (Vector UserInfo) -> Text -> IO (Vector UserInfo)
forall a b. (a -> b) -> a -> b
$ Vector UserInfo -> IO (Vector UserInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector UserInfo
forall a. Monoid a => a
mempty
                        , _listOverlayRecordCount :: Maybe Int
_listOverlayRecordCount    = Maybe Int
forall a. Maybe a
Nothing
                        , _listOverlayReturnMode :: Mode
_listOverlayReturnMode     = Mode
Main
                        }

nullEmojiListOverlayState :: TeamId -> ListOverlayState (Bool, T.Text) ()
nullEmojiListOverlayState :: TeamId -> ListOverlayState (Bool, Text) ()
nullEmojiListOverlayState TeamId
tId =
    let newList :: Vector (Bool, Text) -> GenericList Name Vector (Bool, Text)
newList Vector (Bool, Text)
rs = Name
-> Vector (Bool, Text)
-> Int
-> GenericList Name Vector (Bool, Text)
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list (TeamId -> Name
ReactionEmojiList TeamId
tId) Vector (Bool, Text)
rs Int
1
    in ListOverlayState :: forall a b.
List Name a
-> Editor Text Name
-> b
-> Bool
-> (a -> MH Bool)
-> (Vector a -> List Name a)
-> (b -> Session -> Text -> IO (Vector a))
-> Maybe Int
-> Mode
-> ListOverlayState a b
ListOverlayState { _listOverlaySearchResults :: GenericList Name Vector (Bool, Text)
_listOverlaySearchResults  = Vector (Bool, Text) -> GenericList Name Vector (Bool, Text)
newList Vector (Bool, Text)
forall a. Monoid a => a
mempty
                        , _listOverlaySearchInput :: Editor Text Name
_listOverlaySearchInput    = Name -> Maybe Int -> Text -> Editor Text Name
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor (TeamId -> Name
ReactionEmojiListInput TeamId
tId) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
""
                        , _listOverlaySearchScope :: ()
_listOverlaySearchScope    = ()
                        , _listOverlaySearching :: Bool
_listOverlaySearching      = Bool
False
                        , _listOverlayEnterHandler :: (Bool, Text) -> MH Bool
_listOverlayEnterHandler   = MH Bool -> (Bool, Text) -> MH Bool
forall a b. a -> b -> a
const (MH Bool -> (Bool, Text) -> MH Bool)
-> MH Bool -> (Bool, Text) -> MH Bool
forall a b. (a -> b) -> a -> b
$ Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        , _listOverlayNewList :: Vector (Bool, Text) -> GenericList Name Vector (Bool, Text)
_listOverlayNewList        = Vector (Bool, Text) -> GenericList Name Vector (Bool, Text)
newList
                        , _listOverlayFetchResults :: () -> Session -> Text -> IO (Vector (Bool, Text))
_listOverlayFetchResults   = (Session -> Text -> IO (Vector (Bool, Text)))
-> () -> Session -> Text -> IO (Vector (Bool, Text))
forall a b. a -> b -> a
const ((Session -> Text -> IO (Vector (Bool, Text)))
 -> () -> Session -> Text -> IO (Vector (Bool, Text)))
-> (Session -> Text -> IO (Vector (Bool, Text)))
-> ()
-> Session
-> Text
-> IO (Vector (Bool, Text))
forall a b. (a -> b) -> a -> b
$ (Text -> IO (Vector (Bool, Text)))
-> Session -> Text -> IO (Vector (Bool, Text))
forall a b. a -> b -> a
const ((Text -> IO (Vector (Bool, Text)))
 -> Session -> Text -> IO (Vector (Bool, Text)))
-> (Text -> IO (Vector (Bool, Text)))
-> Session
-> Text
-> IO (Vector (Bool, Text))
forall a b. (a -> b) -> a -> b
$ IO (Vector (Bool, Text)) -> Text -> IO (Vector (Bool, Text))
forall a b. a -> b -> a
const (IO (Vector (Bool, Text)) -> Text -> IO (Vector (Bool, Text)))
-> IO (Vector (Bool, Text)) -> Text -> IO (Vector (Bool, Text))
forall a b. (a -> b) -> a -> b
$ Vector (Bool, Text) -> IO (Vector (Bool, Text))
forall (m :: * -> *) a. Monad m => a -> m a
return Vector (Bool, Text)
forall a. Monoid a => a
mempty
                        , _listOverlayRecordCount :: Maybe Int
_listOverlayRecordCount    = Maybe Int
forall a. Maybe a
Nothing
                        , _listOverlayReturnMode :: Mode
_listOverlayReturnMode     = Mode
MessageSelect
                        }

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

-- | The state of message selection mode.
data MessageSelectState =
    MessageSelectState { MessageSelectState -> Maybe MessageId
selectMessageId :: Maybe MessageId
                       }

-- | The state of the post list overlay.
data PostListOverlayState =
    PostListOverlayState { PostListOverlayState -> Messages
_postListPosts    :: Messages
                         , PostListOverlayState -> 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 overlay. Type 'a' is the type
-- of data in the list. Type 'b' is the search scope type.
data ListOverlayState a b =
    ListOverlayState { ListOverlayState a b -> List Name a
_listOverlaySearchResults :: List Name a
                     -- ^ The list of search results currently shown in
                     -- the overlay.
                     , ListOverlayState a b -> Editor Text Name
_listOverlaySearchInput :: Editor Text Name
                     -- ^ The editor for the overlay's search input.
                     , ListOverlayState a b -> b
_listOverlaySearchScope :: b
                     -- ^ The overlay's current search scope.
                     , ListOverlayState a b -> Bool
_listOverlaySearching :: Bool
                     -- ^ Whether a search is in progress (i.e. whether
                     -- we are currently awaiting a response from a
                     -- search query to the server).
                     , ListOverlayState a b -> a -> MH Bool
_listOverlayEnterHandler :: a -> MH Bool
                     -- ^ The handler to invoke on the selected element
                     -- when the user presses Enter.
                     , ListOverlayState a b -> Vector a -> List Name a
_listOverlayNewList :: Vec.Vector a -> List Name a
                     -- ^ The function to build a new brick List from a
                     -- vector of search results.
                     , ListOverlayState a b -> b -> Session -> Text -> IO (Vector a)
_listOverlayFetchResults :: b -> Session -> Text -> IO (Vec.Vector a)
                     -- ^ The function to call to issue a search query
                     -- to the server.
                     , ListOverlayState a b -> Maybe Int
_listOverlayRecordCount :: Maybe Int
                     -- ^ The total number of available records, if known.
                     , ListOverlayState a b -> Mode
_listOverlayReturnMode :: Mode
                     -- ^ The mode to return to when the window closes.
                     }

-- | The scope for searching for users in a user list overlay.
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]
(Int -> ReadS WebsocketAction)
-> ReadS [WebsocketAction]
-> ReadPrec WebsocketAction
-> ReadPrec [WebsocketAction]
-> Read 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 -> String
(Int -> WebsocketAction -> ShowS)
-> (WebsocketAction -> String)
-> ([WebsocketAction] -> ShowS)
-> Show WebsocketAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsocketAction] -> ShowS
$cshowList :: [WebsocketAction] -> ShowS
show :: WebsocketAction -> String
$cshow :: WebsocketAction -> String
showsPrec :: Int -> WebsocketAction -> ShowS
$cshowsPrec :: Int -> WebsocketAction -> ShowS
Show, WebsocketAction -> WebsocketAction -> Bool
(WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> Eq WebsocketAction
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
Eq WebsocketAction
-> (WebsocketAction -> WebsocketAction -> Ordering)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> Bool)
-> (WebsocketAction -> WebsocketAction -> WebsocketAction)
-> (WebsocketAction -> WebsocketAction -> WebsocketAction)
-> Ord 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
$cp1Ord :: Eq WebsocketAction
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
(LogContext -> LogContext -> Bool)
-> (LogContext -> LogContext -> Bool) -> Eq LogContext
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 -> String
(Int -> LogContext -> ShowS)
-> (LogContext -> String)
-> ([LogContext] -> ShowS)
-> Show LogContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogContext] -> ShowS
$cshowList :: [LogContext] -> ShowS
show :: LogContext -> String
$cshow :: LogContext -> String
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
(UserFetch -> UserFetch -> Bool)
-> (UserFetch -> UserFetch -> Bool) -> Eq UserFetch
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 -> String
(Int -> UserFetch -> ShowS)
-> (UserFetch -> String)
-> ([UserFetch] -> ShowS)
-> Show UserFetch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserFetch] -> ShowS
$cshowList :: [UserFetch] -> ShowS
show :: UserFetch -> String
$cshow :: UserFetch -> String
showsPrec :: Int -> UserFetch -> ShowS
$cshowsPrec :: Int -> UserFetch -> ShowS
Show)

data MHState =
    MHState { MHState -> ChatState
mhCurrentState :: ChatState
            , MHState -> ChatState -> EventM Name (Next ChatState)
mhNextAction :: ChatState -> EventM Name (Next ChatState)
            , 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 { MH a -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
fromMH :: R.ReaderT (Maybe LogContext) (St.StateT MHState (EventM Name)) a }

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

withLogContextChannelId :: ChannelId -> MH a -> MH a
withLogContextChannelId :: ChannelId -> MH a -> MH a
withLogContextChannelId ChannelId
cId MH a
act =
    let f :: Maybe LogContext -> Maybe LogContext
f Maybe LogContext
Nothing = LogContext -> Maybe LogContext
forall a. a -> Maybe a
Just (LogContext -> Maybe LogContext) -> LogContext -> Maybe LogContext
forall a b. (a -> b) -> a -> b
$ Maybe ChannelId -> LogContext
LogContext (ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId)
        f (Just LogContext
c) = LogContext -> Maybe LogContext
forall a. a -> Maybe a
Just (LogContext -> Maybe LogContext) -> LogContext -> Maybe LogContext
forall a b. (a -> b) -> a -> b
$ LogContext
c { logContextChannelId :: Maybe ChannelId
logContextChannelId = ChannelId -> Maybe ChannelId
forall a. a -> Maybe a
Just ChannelId
cId }
    in (Maybe LogContext -> Maybe LogContext) -> MH a -> MH a
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 = ReaderT
  (Maybe LogContext)
  (StateT MHState (EventM Name))
  (Maybe LogContext)
-> MH (Maybe LogContext)
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH ReaderT
  (Maybe LogContext)
  (StateT MHState (EventM Name))
  (Maybe LogContext)
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
    IO () -> MH ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MH ()) -> IO () -> MH ()
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 <- Getting LogManager ChatState LogManager -> MH LogManager
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatState -> LogManager) -> SimpleGetter ChatState LogManager
forall s a. (s -> a) -> SimpleGetter s a
to (ChatResources -> LogManager
_crLogManager (ChatResources -> LogManager)
-> (ChatState -> ChatResources) -> ChatState -> LogManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatState -> ChatResources
_csResources))
    (LogCategory -> Text -> IO ()) -> MH (LogCategory -> Text -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((LogCategory -> Text -> IO ())
 -> MH (LogCategory -> Text -> IO ()))
-> (LogCategory -> Text -> IO ())
-> MH (LogCategory -> Text -> IO ())
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 :: Text -> Maybe LogContext -> LogCategory -> UTCTime -> LogMessage
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 'MM' computation, choosing whether to continue or halt based
-- on the resulting
runMHEvent :: ChatState -> MH () -> EventM Name (Next ChatState)
runMHEvent :: ChatState -> MH () -> EventM Name (Next ChatState)
runMHEvent ChatState
st (MH ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
mote) = do
  let mhSt :: MHState
mhSt = MHState :: ChatState
-> (ChatState -> EventM Name (Next ChatState))
-> [UserFetch]
-> Maybe [UserId]
-> MHState
MHState { mhCurrentState :: ChatState
mhCurrentState = ChatState
st
                     , mhNextAction :: ChatState -> EventM Name (Next ChatState)
mhNextAction = ChatState -> EventM Name (Next ChatState)
forall s n. s -> EventM n (Next s)
Brick.continue
                     , mhUsersToFetch :: [UserFetch]
mhUsersToFetch = []
                     , mhPendingStatusList :: Maybe [UserId]
mhPendingStatusList = Maybe [UserId]
forall a. Maybe a
Nothing
                     }
  ((), MHState
st') <- StateT MHState (EventM Name) ()
-> MHState -> EventM Name ((), MHState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
St.runStateT (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> Maybe LogContext -> StateT MHState (EventM Name) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
mote Maybe LogContext
forall a. Maybe a
Nothing) MHState
mhSt
  (MHState -> ChatState -> EventM Name (Next ChatState)
mhNextAction MHState
st') (MHState -> ChatState
mhCurrentState MHState
st')

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

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

getScheduledUserFetches :: MH [UserFetch]
getScheduledUserFetches :: MH [UserFetch]
getScheduledUserFetches = ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name)) [UserFetch]
-> MH [UserFetch]
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT
   (Maybe LogContext) (StateT MHState (EventM Name)) [UserFetch]
 -> MH [UserFetch])
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name)) [UserFetch]
-> MH [UserFetch]
forall a b. (a -> b) -> a -> b
$ (MHState -> [UserFetch])
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name)) [UserFetch]
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 = ReaderT
  (Maybe LogContext) (StateT MHState (EventM Name)) (Maybe [UserId])
-> MH (Maybe [UserId])
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT
   (Maybe LogContext) (StateT MHState (EventM Name)) (Maybe [UserId])
 -> MH (Maybe [UserId]))
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name)) (Maybe [UserId])
-> MH (Maybe [UserId])
forall a b. (a -> b) -> a -> b
$ (MHState -> Maybe [UserId])
-> ReaderT
     (Maybe LogContext) (StateT MHState (EventM Name)) (Maybe [UserId])
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 a -> MH a
mh :: EventM Name a -> MH a
mh = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
 -> MH a)
-> (EventM Name a
    -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a)
-> EventM Name a
-> MH a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT MHState (EventM Name) a
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (StateT MHState (EventM Name) a
 -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a)
-> (EventM Name a -> StateT MHState (EventM Name) a)
-> EventM Name a
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventM Name a -> StateT MHState (EventM Name) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift

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

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

mhHandleEventLensed :: Lens' ChatState b -> (e -> b -> EventM Name b) -> e -> MH ()
mhHandleEventLensed :: Lens' ChatState b -> (e -> b -> EventM Name b) -> e -> MH ()
mhHandleEventLensed Lens' ChatState b
ln e -> b -> EventM Name b
f e
event = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
 -> MH ())
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a b. (a -> b) -> a -> b
$ do
    MHState
s <- ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
forall s (m :: * -> *). MonadState s m => m s
St.get
    let st :: ChatState
st = MHState -> ChatState
mhCurrentState MHState
s
    b
n <- StateT MHState (EventM Name) b
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (StateT MHState (EventM Name) b
 -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) b)
-> StateT MHState (EventM Name) b
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) b
forall a b. (a -> b) -> a -> b
$ EventM Name b -> StateT MHState (EventM Name) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift (EventM Name b -> StateT MHState (EventM Name) b)
-> EventM Name b -> StateT MHState (EventM Name) b
forall a b. (a -> b) -> a -> b
$ e -> b -> EventM Name b
f e
event (ChatState
st ChatState -> Getting b ChatState b -> b
forall s a. s -> Getting a s a -> a
^. Getting b ChatState b
Lens' ChatState b
ln)
    MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
St.put (MHState
s { mhCurrentState :: ChatState
mhCurrentState = ChatState
st ChatState -> (ChatState -> ChatState) -> ChatState
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> ChatState -> Identity ChatState
Lens' ChatState b
ln ((b -> Identity b) -> ChatState -> Identity ChatState)
-> b -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
n })

mhHandleEventLensed' :: Lens' ChatState b -> (b -> EventM Name b) -> MH ()
mhHandleEventLensed' :: Lens' ChatState b -> (b -> EventM Name b) -> MH ()
mhHandleEventLensed' Lens' ChatState b
ln b -> EventM Name b
f = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
 -> MH ())
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a b. (a -> b) -> a -> b
$ do
    MHState
s <- ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
forall s (m :: * -> *). MonadState s m => m s
St.get
    let st :: ChatState
st = MHState -> ChatState
mhCurrentState MHState
s
    b
n <- StateT MHState (EventM Name) b
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
R.lift (StateT MHState (EventM Name) b
 -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) b)
-> StateT MHState (EventM Name) b
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) b
forall a b. (a -> b) -> a -> b
$ EventM Name b -> StateT MHState (EventM Name) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
St.lift (EventM Name b -> StateT MHState (EventM Name) b)
-> EventM Name b -> StateT MHState (EventM Name) b
forall a b. (a -> b) -> a -> b
$ b -> EventM Name b
f (ChatState
st ChatState -> Getting b ChatState b -> b
forall s a. s -> Getting a s a -> a
^. Getting b ChatState b
Lens' ChatState b
ln)
    MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
St.put (MHState
s { mhCurrentState :: ChatState
mhCurrentState = ChatState
st ChatState -> (ChatState -> ChatState) -> ChatState
forall a b. a -> (a -> b) -> b
& (b -> Identity b) -> ChatState -> Identity ChatState
Lens' ChatState b
ln ((b -> Identity b) -> ChatState -> Identity ChatState)
-> b -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ b
n })

mhSuspendAndResume :: (ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume :: (ChatState -> IO ChatState) -> MH ()
mhSuspendAndResume ChatState -> IO ChatState
mote = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
 -> MH ())
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a b. (a -> b) -> a -> b
$ do
    MHState
s <- ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
forall s (m :: * -> *). MonadState s m => m s
St.get
    MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
St.put (MHState
 -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ())
-> MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall a b. (a -> b) -> a -> b
$ MHState
s { mhNextAction :: ChatState -> EventM Name (Next ChatState)
mhNextAction = \ ChatState
_ -> IO ChatState -> EventM Name (Next ChatState)
forall s n. IO s -> EventM n (Next s)
Brick.suspendAndResume (ChatState -> IO ChatState
mote (ChatState -> IO ChatState) -> ChatState -> IO ChatState
forall a b. (a -> b) -> a -> b
$ MHState -> ChatState
mhCurrentState MHState
s) }

-- | This will request that after this computation finishes the
-- application should exit
requestQuit :: MH ()
requestQuit :: MH ()
requestQuit = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
 -> MH ())
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a b. (a -> b) -> a -> b
$ do
    MHState
s <- ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
forall s (m :: * -> *). MonadState s m => m s
St.get
    MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
St.put (MHState
 -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ())
-> MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall a b. (a -> b) -> a -> b
$ MHState
s { mhNextAction :: ChatState -> EventM Name (Next ChatState)
mhNextAction = ChatState -> EventM Name (Next ChatState)
forall s n. s -> EventM n (Next s)
Brick.halt }

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

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

instance MHF.MonadFail MH where
    fail :: String -> MH a
fail = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
 -> MH a)
-> (String
    -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a)
-> String
-> MH a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
forall (m :: * -> *) a. MonadFail m => String -> m a
MHF.fail

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

-- We want to pretend that the state is only the ChatState, rather
-- than the ChatState and the Brick continuation
instance St.MonadState ChatState MH where
    get :: MH ChatState
get = MHState -> ChatState
mhCurrentState (MHState -> ChatState) -> MH MHState -> MH ChatState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
-> MH MHState
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
forall s (m :: * -> *). MonadState s m => m s
St.get
    put :: ChatState -> MH ()
put ChatState
st = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
 -> MH ())
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
-> MH ()
forall a b. (a -> b) -> a -> b
$ do
        MHState
s <- ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) MHState
forall s (m :: * -> *). MonadState s m => m s
St.get
        MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
St.put (MHState
 -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ())
-> MHState
-> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) ()
forall a b. (a -> b) -> a -> b
$ MHState
s { mhCurrentState :: ChatState
mhCurrentState = ChatState
st }

instance St.MonadIO MH where
    liftIO :: IO a -> MH a
liftIO = ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
forall a.
ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a -> MH a
MH (ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
 -> MH a)
-> (IO a
    -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a)
-> IO a
-> MH a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT (Maybe LogContext) (StateT MHState (EventM Name)) a
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 -> String
(Int -> MHError -> ShowS)
-> (MHError -> String) -> ([MHError] -> ShowS) -> Show MHError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MHError] -> ShowS
$cshowList :: [MHError] -> ShowS
show :: MHError -> String
$cshow :: MHError -> String
showsPrec :: Int -> MHError -> ShowS
$cshowsPrec :: Int -> MHError -> ShowS
Show)

-- ** Application State Lenses

makeLenses ''ChatResources
makeLenses ''ChatState
makeLenses ''TeamState
makeLenses ''ChatEditState
makeLenses ''AutocompleteState
makeLenses ''PostListOverlayState
makeLenses ''ListOverlayState
makeLenses ''ChannelSelectState
makeLenses ''UserPreferences
makeLenses ''ConnectionInfo
makeLenses ''ChannelTopicDialogState
makeLenses ''SaveAttachmentDialogState
Brick.suffixLenses ''Config

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

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

applyTeamOrder :: [TeamId] -> MH ()
applyTeamOrder :: [TeamId] -> MH ()
applyTeamOrder [TeamId]
tIds = (ChatState -> ChatState) -> MH ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
St.modify (Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref (Maybe [TeamId] -> ChatState -> ChatState)
-> Maybe [TeamId] -> ChatState -> ChatState
forall a b. (a -> b) -> a -> b
$ [TeamId] -> Maybe [TeamId]
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 Maybe [TeamId] -> ChatState -> ChatState
applyTeamOrderPref (UserPreferences -> Maybe [TeamId]
_userPrefTeamOrder (UserPreferences -> Maybe [TeamId])
-> UserPreferences -> Maybe [TeamId]
forall a b. (a -> b) -> a -> b
$ ChatResources -> UserPreferences
_crUserPreferences ChatResources
startupStateResources) (ChatState -> ChatState) -> ChatState -> ChatState
forall a b. (a -> b) -> a -> b
$
       ChatState :: ChatResources
-> Maybe (BrickEvent Name MHEvent)
-> HashMap TeamId TeamState
-> Zipper () TeamId
-> ChannelListOrientation
-> User
-> ClientChannels
-> HashMap PostId Message
-> Users
-> TimeZoneSeries
-> ConnectionStatus
-> Maybe (Maybe Int)
-> Maybe ClientConfig
-> InputHistory
-> ChatState
ChatState { _csResources :: ChatResources
_csResources                   = ChatResources
startupStateResources
                 , _csLastMouseDownEvent :: Maybe (BrickEvent Name MHEvent)
_csLastMouseDownEvent          = Maybe (BrickEvent Name MHEvent)
forall a. Maybe a
Nothing
                 , _csTeamZipper :: Zipper () TeamId
_csTeamZipper                  = (TeamId -> Bool) -> Zipper () TeamId -> Zipper () TeamId
forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight (TeamId -> TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== TeamId
startupStateInitialTeam) (Zipper () TeamId -> Zipper () TeamId)
-> Zipper () TeamId -> Zipper () TeamId
forall a b. (a -> b) -> a -> b
$
                                                    HashMap TeamId TeamState -> Zipper () TeamId
mkTeamZipper 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                     = HashMap PostId Message
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                = Maybe (Maybe Int)
forall a. Maybe a
Nothing
                 , _csClientConfig :: Maybe ClientConfig
_csClientConfig                = Maybe ClientConfig
forall a. Maybe a
Nothing
                 , _csInputHistory :: InputHistory
_csInputHistory                = InputHistory
startupStateInitialHistory
                 }

getServerBaseUrl :: TeamId -> MH TeamBaseURL
getServerBaseUrl :: TeamId -> MH TeamBaseURL
getServerBaseUrl TeamId
tId = do
    ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
forall a. a -> a
id
    TeamBaseURL -> MH TeamBaseURL
forall (m :: * -> *) a. Monad m => a -> m a
return (TeamBaseURL -> MH TeamBaseURL) -> TeamBaseURL -> MH TeamBaseURL
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 (ConnectionData -> ServerBaseURL)
-> ConnectionData -> ServerBaseURL
forall a b. (a -> b) -> a -> b
$ ChatResources -> ConnectionData
_crConn (ChatResources -> ConnectionData)
-> ChatResources -> ConnectionData
forall a b. (a -> b) -> a -> b
$ ChatState -> ChatResources
_csResources ChatState
st
        tName :: UserText
tName = Team -> UserText
teamName (Team -> UserText) -> Team -> UserText
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Team ChatState Team -> Team
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const Team TeamState)
 -> ChatState -> Const Team ChatState)
-> ((Team -> Const Team Team) -> TeamState -> Const Team TeamState)
-> Getting Team ChatState Team
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Team -> Const Team Team) -> TeamState -> Const Team TeamState
Lens' TeamState Team
tsTeam
    in TeamURLName -> ServerBaseURL -> TeamBaseURL
TeamBaseURL (Text -> TeamURLName
TeamURLName (Text -> TeamURLName) -> Text -> TeamURLName
forall a b. (a -> b) -> a -> b
$ UserText -> Text
sanitizeUserText UserText
tName) ServerBaseURL
baseUrl

unsafeCedFileBrowser :: Lens' ChatEditState (FB.FileBrowser Name)
unsafeCedFileBrowser :: (FileBrowser Name -> f (FileBrowser Name))
-> ChatEditState -> f ChatEditState
unsafeCedFileBrowser =
     (ChatEditState -> FileBrowser Name)
-> (ChatEditState -> FileBrowser Name -> ChatEditState)
-> Lens
     ChatEditState ChatEditState (FileBrowser Name) (FileBrowser Name)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ChatEditState
st   -> ChatEditState
stChatEditState
-> Getting
     (Maybe (FileBrowser Name)) ChatEditState (Maybe (FileBrowser Name))
-> Maybe (FileBrowser Name)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (FileBrowser Name)) ChatEditState (Maybe (FileBrowser Name))
Lens' ChatEditState (Maybe (FileBrowser Name))
cedFileBrowser Maybe (FileBrowser Name)
-> Getting
     (Endo (FileBrowser Name))
     (Maybe (FileBrowser Name))
     (FileBrowser Name)
-> FileBrowser Name
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting
  (Endo (FileBrowser Name))
  (Maybe (FileBrowser Name))
  (FileBrowser Name)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just)
          (\ChatEditState
st FileBrowser Name
t -> ChatEditState
st ChatEditState -> (ChatEditState -> ChatEditState) -> ChatEditState
forall a b. a -> (a -> b) -> b
& (Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name)))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Maybe (FileBrowser Name))
cedFileBrowser ((Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name)))
 -> ChatEditState -> Identity ChatEditState)
-> Maybe (FileBrowser Name) -> ChatEditState -> ChatEditState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FileBrowser Name -> Maybe (FileBrowser Name)
forall a. a -> Maybe a
Just FileBrowser Name
t)

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

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

whenMode :: Mode -> MH () -> MH ()
whenMode :: Mode -> MH () -> MH ()
whenMode Mode
m MH ()
act = do
    Mode
curMode <- Getting Mode ChatState Mode -> MH Mode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const Mode TeamState)
-> ChatState -> Const Mode ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const Mode TeamState)
 -> ChatState -> Const Mode ChatState)
-> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState)
-> Getting Mode ChatState Mode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState
Lens' TeamState Mode
tsMode)
    Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Mode
curMode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
m) MH ()
act

setMode :: Mode -> MH ()
setMode :: Mode -> MH ()
setMode Mode
m = do
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Mode -> Identity Mode) -> TeamState -> Identity TeamState)
-> (Mode -> Identity Mode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Identity Mode) -> TeamState -> Identity TeamState
Lens' TeamState Mode
tsMode ((Mode -> Identity Mode) -> ChatState -> Identity ChatState)
-> Mode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Mode
m
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache

setMode' :: Mode -> ChatState -> ChatState
setMode' :: Mode -> ChatState -> ChatState
setMode' Mode
m = (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Mode -> Identity Mode) -> TeamState -> Identity TeamState)
-> (Mode -> Identity Mode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Mode -> Identity Mode) -> TeamState -> Identity TeamState
Lens' TeamState Mode
tsMode ((Mode -> Identity Mode) -> ChatState -> Identity ChatState)
-> Mode -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Mode
m

resetSpellCheckTimer :: ChatEditState -> IO ()
resetSpellCheckTimer :: ChatEditState -> IO ()
resetSpellCheckTimer ChatEditState
s =
    case ChatEditState
sChatEditState
-> Getting
     (Maybe (Aspell, IO ())) ChatEditState (Maybe (Aspell, IO ()))
-> Maybe (Aspell, IO ())
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (Aspell, IO ())) ChatEditState (Maybe (Aspell, IO ()))
Lens' ChatEditState (Maybe (Aspell, IO ()))
cedSpellChecker of
        Maybe (Aspell, IO ())
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (Aspell
_, IO ()
reset) -> IO ()
reset

-- ** Utility Lenses
csCurrentChannelId :: TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId :: TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId TeamId
tId =
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const r TeamState)
 -> ChatState -> Const r ChatState)
-> ((ChannelId -> Const r ChannelId)
    -> TeamState -> Const r TeamState)
-> (ChannelId -> Const r ChannelId)
-> ChatState
-> Const r ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry
 -> Const r (Zipper ChannelListGroup ChannelListEntry))
-> TeamState -> Const r TeamState
Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus((Zipper ChannelListGroup ChannelListEntry
  -> Const r (Zipper ChannelListGroup ChannelListEntry))
 -> TeamState -> Const r TeamState)
-> ((ChannelId -> Const r ChannelId)
    -> Zipper ChannelListGroup ChannelListEntry
    -> Const r (Zipper ChannelListGroup ChannelListEntry))
-> (ChannelId -> Const r ChannelId)
-> TeamState
-> Const r TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper ChannelListGroup ChannelListEntry -> ChannelListEntry)
-> SimpleGetter
     (Zipper ChannelListGroup ChannelListEntry) ChannelListEntry
forall s a. (s -> a) -> SimpleGetter s a
to Zipper ChannelListGroup ChannelListEntry -> ChannelListEntry
forall a b. Zipper a b -> b
Z.unsafeFocusGetting
  r (Zipper ChannelListGroup ChannelListEntry) ChannelListEntry
-> ((ChannelId -> Const r ChannelId)
    -> ChannelListEntry -> Const r ChannelListEntry)
-> (ChannelId -> Const r ChannelId)
-> Zipper ChannelListGroup ChannelListEntry
-> Const r (Zipper ChannelListGroup ChannelListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelListEntry -> ChannelId)
-> SimpleGetter ChannelListEntry ChannelId
forall s a. (s -> a) -> SimpleGetter s a
to ChannelListEntry -> ChannelId
channelListEntryChannelId

csCurrentTeamId :: SimpleGetter ChatState TeamId
csCurrentTeamId :: Getting r ChatState TeamId
csCurrentTeamId =
    (Zipper () TeamId -> Const r (Zipper () TeamId))
-> ChatState -> Const r ChatState
Lens' ChatState (Zipper () TeamId)
csTeamZipper((Zipper () TeamId -> Const r (Zipper () TeamId))
 -> ChatState -> Const r ChatState)
-> ((TeamId -> Const r TeamId)
    -> Zipper () TeamId -> Const r (Zipper () TeamId))
-> Getting r ChatState TeamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Zipper () TeamId -> TeamId)
-> SimpleGetter (Zipper () TeamId) TeamId
forall s a. (s -> a) -> SimpleGetter s a
to Zipper () TeamId -> TeamId
forall a b. Zipper a b -> b
Z.unsafeFocus

csCurrentTeam :: Lens' ChatState TeamState
csCurrentTeam :: (TeamState -> f TeamState) -> ChatState -> f ChatState
csCurrentTeam =
    (ChatState -> TeamState)
-> (ChatState -> TeamState -> ChatState)
-> Lens' ChatState TeamState
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ChatState
st   -> ChatState
stChatState -> Getting TeamState ChatState TeamState -> TeamState
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId))
         (\ChatState
st TeamState
t -> ChatState
st ChatState -> (ChatState -> ChatState) -> ChatState
forall a b. a -> (a -> b) -> b
& TeamId -> Lens' ChatState TeamState
csTeam(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId) ((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> TeamState -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TeamState
t)

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

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

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

csCurrentChannel :: Lens' ChatState ClientChannel
csCurrentChannel :: (ClientChannel -> f ClientChannel) -> ChatState -> f ChatState
csCurrentChannel =
    (ChatState -> ClientChannel)
-> (ChatState -> ClientChannel -> ChatState)
-> Lens ChatState ChatState ClientChannel ClientChannel
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\ ChatState
st -> ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById (ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId)) (ChatState
stChatState
-> Getting ClientChannels ChatState ClientChannels
-> ClientChannels
forall s a. s -> Getting a s a -> a
^.Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels) Maybe ClientChannel
-> Getting (Endo ClientChannel) (Maybe ClientChannel) ClientChannel
-> ClientChannel
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting (Endo ClientChannel) (Maybe ClientChannel) ClientChannel
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just)
         (\ ChatState
st ClientChannel
n -> ChatState
st ChatState -> (ChatState -> ChatState) -> ChatState
forall a b. a -> (a -> b) -> b
& (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
 -> ChatState -> Identity ChatState)
-> (ClientChannels -> ClientChannels) -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ChannelId -> ClientChannel -> ClientChannels -> ClientChannels
addChannel (ChatState
stChatState -> Getting ChannelId ChatState ChannelId -> ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState ChannelId
csCurrentChannelId(ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId)) ClientChannel
n)

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

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

withChannelOrDefault :: ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault :: ChannelId -> a -> (ClientChannel -> MH a) -> MH a
withChannelOrDefault ChannelId
cId a
deflt ClientChannel -> MH a
mote = do
    Maybe ClientChannel
chan <- Getting (First ClientChannel) ChatState ClientChannel
-> MH (Maybe ClientChannel)
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 -> a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return a
deflt
        Just ClientChannel
c  -> ClientChannel -> MH a
mote ClientChannel
c

-- ** 'ChatState' Helper Functions

raiseInternalEvent :: InternalEvent -> MH ()
raiseInternalEvent :: InternalEvent -> MH ()
raiseInternalEvent InternalEvent
ev = do
    BChan MHEvent
queue <- Getting (BChan MHEvent) ChatState (BChan MHEvent)
-> MH (BChan MHEvent)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((ChatResources -> Const (BChan MHEvent) ChatResources)
-> ChatState -> Const (BChan MHEvent) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (BChan MHEvent) ChatResources)
 -> ChatState -> Const (BChan MHEvent) ChatState)
-> ((BChan MHEvent -> Const (BChan MHEvent) (BChan MHEvent))
    -> ChatResources -> Const (BChan MHEvent) ChatResources)
-> Getting (BChan MHEvent) ChatState (BChan MHEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BChan MHEvent -> Const (BChan MHEvent) (BChan MHEvent))
-> ChatResources -> Const (BChan MHEvent) ChatResources
Lens' ChatResources (BChan MHEvent)
crEventQueue)
    BChan MHEvent -> MHEvent -> MH ()
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 :: BChan MHEvent -> MHEvent -> m ()
writeBChan BChan MHEvent
chan MHEvent
e = do
    Bool
written <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ BChan MHEvent -> MHEvent -> IO Bool
forall a. BChan a -> a -> IO Bool
BCH.writeBChanNonBlocking BChan MHEvent
chan MHEvent
e
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
written) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"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 (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ MHError -> String
forall a. Show a => a -> String
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
msgMessage -> Getting UserRef Message UserRef -> UserRef
forall s a. s -> Getting a s a -> a
^.Getting UserRef Message UserRef
Lens' Message UserRef
mUser of
        UserI Bool
_ UserId
uid -> UserId
uid UserId -> UserId -> Bool
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
stChatState
-> Getting (Maybe Message) ChatState (Maybe Message)
-> Maybe Message
forall s a. s -> Getting a s a -> a
^.(HashMap PostId Message
 -> Const (Maybe Message) (HashMap PostId Message))
-> ChatState -> Const (Maybe Message) ChatState
Lens' ChatState (HashMap PostId Message)
csPostMap((HashMap PostId Message
  -> Const (Maybe Message) (HashMap PostId Message))
 -> ChatState -> Const (Maybe Message) ChatState)
-> ((Maybe Message -> Const (Maybe Message) (Maybe Message))
    -> HashMap PostId Message
    -> Const (Maybe Message) (HashMap PostId Message))
-> Getting (Maybe Message) ChatState (Maybe Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Index (HashMap PostId Message)
-> Lens'
     (HashMap PostId Message) (Maybe (IxValue (HashMap PostId Message)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at(PostId
Index (HashMap PostId Message)
pId)

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

getReplyRootMessage :: Message -> MH Message
getReplyRootMessage :: Message -> MH Message
getReplyRootMessage Message
msg = do
    case Post -> Maybe PostId
postRootId (Post -> Maybe PostId) -> Maybe Post -> Maybe PostId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Message
msgMessage -> Getting (Maybe Post) Message (Maybe Post) -> Maybe Post
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Post) Message (Maybe Post)
Lens' Message (Maybe Post)
mOriginalPost) of
        Maybe PostId
Nothing -> Message -> MH Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
msg
        Just PostId
rootId -> do
            ChatState
st <- Getting ChatState ChatState ChatState -> MH ChatState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ChatState ChatState ChatState
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 -> Message -> MH Message
forall (m :: * -> *) a. Monad m => a -> m a
return Message
msg
                Just Message
m -> Message -> MH Message
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
    (Users -> Identity Users) -> ChatState -> Identity ChatState
Lens' ChatState Users
csUsers ((Users -> Identity Users) -> ChatState -> Identity ChatState)
-> (Users -> Users) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= UserId -> (UserInfo -> UserInfo) -> Users -> Users
modifyUserById UserId
uId ((UserStatus -> Identity UserStatus)
-> UserInfo -> Identity UserInfo
Lens' UserInfo UserStatus
uiStatus ((UserStatus -> Identity UserStatus)
 -> UserInfo -> Identity UserInfo)
-> UserStatus -> UserInfo -> UserInfo
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text -> UserStatus
statusFromText Text
t)
    ClientChannels
cs <- Getting ClientChannels ChatState ClientChannels
-> MH ClientChannels
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels
    [TeamId] -> (TeamId -> MH ()) -> MH ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ClientChannels -> [TeamId]
allTeamIds ClientChannels
cs) ((TeamId -> MH ()) -> MH ()) -> (TeamId -> MH ()) -> MH ()
forall a b. (a -> b) -> a -> b
$ \TeamId
tId ->
        EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh (EventM Name () -> MH ()) -> EventM Name () -> MH ()
forall a b. (a -> b) -> a -> b
$ Name -> EventM Name ()
forall n. Ord n => n -> EventM n ()
invalidateCacheEntry (Name -> EventM Name ()) -> Name -> EventM Name ()
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 (UserInfo -> Text) -> Maybe UserInfo -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserId -> Users -> Maybe UserInfo
findUserById UserId
uId (ChatState
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
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
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
Lens' ChatState Users
csUsers)
    Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ UserInfo -> Maybe ClientConfig -> UserPreferences -> Text
displayNameForUser UserInfo
u (ChatState
stChatState
-> Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
-> Maybe ClientConfig
forall s a. s -> Getting a s a -> a
^.Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
Lens' ChatState (Maybe ClientConfig)
csClientConfig) (ChatState
stChatState
-> Getting UserPreferences ChatState UserPreferences
-> UserPreferences
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
 -> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
    -> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
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 =
    (UserId, UserInfo) -> UserId
forall a b. (a, b) -> a
fst ((UserId, UserInfo) -> UserId)
-> Maybe (UserId, UserInfo) -> Maybe UserId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Users -> Maybe (UserId, UserInfo)
findUserByUsername Text
name (Users -> Maybe (UserId, UserInfo))
-> Users -> Maybe (UserId, UserInfo)
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
Lens' ChatState Users
csUsers)

channelIdByChannelName :: Text -> ChatState -> Maybe ChannelId
channelIdByChannelName :: Text -> ChatState -> Maybe ChannelId
channelIdByChannelName Text
name ChatState
st =
    let matches :: (ChannelId, ClientChannel) -> Bool
matches (ChannelId
_, ClientChannel
cc) = ClientChannel
ccClientChannel -> Getting Text ClientChannel Text -> Text
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const Text ChannelInfo)
-> ClientChannel -> Const Text ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const Text ChannelInfo)
 -> ClientChannel -> Const Text ClientChannel)
-> ((Text -> Const Text Text)
    -> ChannelInfo -> Const Text ChannelInfo)
-> Getting Text ClientChannel Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Const Text Text) -> ChannelInfo -> Const Text ChannelInfo
Lens' ChannelInfo Text
cdName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Text
trimChannelSigil Text
name) Bool -> Bool -> Bool
&&
                          ClientChannel
ccClientChannel
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
-> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> ClientChannel -> Const (Maybe TeamId) ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
 -> ClientChannel -> Const (Maybe TeamId) ClientChannel)
-> ((Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
    -> ChannelInfo -> Const (Maybe TeamId) ChannelInfo)
-> Getting (Maybe TeamId) ClientChannel (Maybe TeamId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe TeamId -> Const (Maybe TeamId) (Maybe TeamId))
-> ChannelInfo -> Const (Maybe TeamId) ChannelInfo
Lens' ChannelInfo (Maybe TeamId)
cdTeamId Maybe TeamId -> Maybe TeamId -> Bool
forall a. Eq a => a -> a -> Bool
== (TeamId -> Maybe TeamId
forall a. a -> Maybe a
Just (TeamId -> Maybe TeamId) -> TeamId -> Maybe TeamId
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId)
    in [ChannelId] -> Maybe ChannelId
forall a. [a] -> Maybe a
listToMaybe ([ChannelId] -> Maybe ChannelId) -> [ChannelId] -> Maybe ChannelId
forall a b. (a -> b) -> a -> b
$ (ChannelId, ClientChannel) -> ChannelId
forall a b. (a, b) -> a
fst ((ChannelId, ClientChannel) -> ChannelId)
-> [(ChannelId, ClientChannel)] -> [ChannelId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ChannelId, ClientChannel) -> Bool)
-> ClientChannels -> [(ChannelId, ClientChannel)]
filteredChannels (ChannelId, ClientChannel) -> Bool
matches (ChatState
stChatState
-> Getting ClientChannels ChatState ClientChannels
-> ClientChannels
forall s a. s -> Getting a s a -> a
^.Getting ClientChannels ChatState ClientChannels
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
stChatState
-> Getting ClientChannels ChatState ClientChannels
-> ClientChannels
forall s a. s -> Getting a s a -> a
^.Getting ClientChannels ChatState ClientChannels
Lens' ChatState ClientChannels
csChannels)

useNickname :: ChatState -> Bool
useNickname :: ChatState -> Bool
useNickname ChatState
st =
    Maybe ClientConfig -> UserPreferences -> Bool
useNickname' (ChatState
stChatState
-> Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
-> Maybe ClientConfig
forall s a. s -> Getting a s a -> a
^.Getting (Maybe ClientConfig) ChatState (Maybe ClientConfig)
Lens' ChatState (Maybe ClientConfig)
csClientConfig) (ChatState
stChatState
-> Getting UserPreferences ChatState UserPreferences
-> UserPreferences
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const UserPreferences ChatResources)
-> ChatState -> Const UserPreferences ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const UserPreferences ChatResources)
 -> ChatState -> Const UserPreferences ChatState)
-> ((UserPreferences -> Const UserPreferences UserPreferences)
    -> ChatResources -> Const UserPreferences ChatResources)
-> Getting UserPreferences ChatState UserPreferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserPreferences -> Const UserPreferences UserPreferences)
-> ChatResources -> Const UserPreferences ChatResources
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
    (Users -> Identity Users) -> ChatState -> Identity ChatState
Lens' ChatState Users
csUsers ((Users -> Identity Users) -> ChatState -> Identity ChatState)
-> (Users -> Users) -> MH ()
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.
    EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
invalidateCache

data SidebarUpdate =
    SidebarUpdateImmediate
    | SidebarUpdateDeferred
    deriving (SidebarUpdate -> SidebarUpdate -> Bool
(SidebarUpdate -> SidebarUpdate -> Bool)
-> (SidebarUpdate -> SidebarUpdate -> Bool) -> Eq SidebarUpdate
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 -> String
(Int -> SidebarUpdate -> ShowS)
-> (SidebarUpdate -> String)
-> ([SidebarUpdate] -> ShowS)
-> Show SidebarUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SidebarUpdate] -> ShowS
$cshowList :: [SidebarUpdate] -> ShowS
show :: SidebarUpdate -> String
$cshow :: SidebarUpdate -> String
showsPrec :: Int -> SidebarUpdate -> ShowS
$cshowsPrec :: Int -> SidebarUpdate -> ShowS
Show)


resetAutocomplete :: MH ()
resetAutocomplete :: MH ()
resetAutocomplete = do
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
    -> TeamState -> Identity TeamState)
-> (Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Maybe AutocompleteState)
cedAutocomplete ((Maybe AutocompleteState -> Identity (Maybe AutocompleteState))
 -> ChatState -> Identity ChatState)
-> Maybe AutocompleteState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe AutocompleteState
forall a. Maybe a
Nothing
    (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((Maybe Text -> Identity (Maybe Text))
    -> TeamState -> Identity TeamState)
-> (Maybe Text -> Identity (Maybe Text))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChatEditState -> Identity ChatEditState)
-> TeamState -> Identity TeamState
Lens' TeamState ChatEditState
tsEditState((ChatEditState -> Identity ChatEditState)
 -> TeamState -> Identity TeamState)
-> ((Maybe Text -> Identity (Maybe Text))
    -> ChatEditState -> Identity ChatEditState)
-> (Maybe Text -> Identity (Maybe Text))
-> TeamState
-> Identity TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Identity (Maybe Text))
-> ChatEditState -> Identity ChatEditState
Lens' ChatEditState (Maybe Text)
cedAutocompletePending ((Maybe Text -> Identity (Maybe Text))
 -> ChatState -> Identity ChatState)
-> Maybe Text -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
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 = (UserInfo -> Bool) -> [UserInfo] -> [UserInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter UserInfo -> Bool
showUser ([UserInfo] -> [UserInfo]) -> [UserInfo] -> [UserInfo]
forall a b. (a -> b) -> a -> b
$ Users -> [UserInfo]
allUsers (ChatState
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
Lens' ChatState Users
csUsers)
    where showUser :: UserInfo -> Bool
showUser UserInfo
u = Bool -> Bool
not (UserInfo -> Bool
isSelf UserInfo
u) Bool -> Bool -> Bool
&& (UserInfo
uUserInfo -> Getting Bool UserInfo Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool UserInfo Bool
Lens' UserInfo Bool
uiInTeam)
          isSelf :: UserInfo -> Bool
isSelf UserInfo
u = (ChatState -> UserId
myUserId ChatState
st) UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== (UserInfo
uUserInfo -> Getting UserId UserInfo UserId -> UserId
forall s a. s -> Getting a s a -> a
^.Getting UserId UserInfo UserId
Lens' UserInfo UserId
uiId)

allUserIds :: ChatState -> [UserId]
allUserIds :: ChatState -> [UserId]
allUserIds ChatState
st = Users -> [UserId]
getAllUserIds (Users -> [UserId]) -> Users -> [UserId]
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
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
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
Lens' ChatState Users
csUsers)

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

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

myUsername :: ChatState -> Text
myUsername :: ChatState -> Text
myUsername ChatState
st = User -> Text
userUsername (User -> Text) -> User -> Text
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting User ChatState User -> User
forall s a. s -> Getting a s a -> a
^.Getting User ChatState User
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
    (UserId, UserInfo) -> UserInfo
forall a b. (a, b) -> b
snd ((UserId, UserInfo) -> UserInfo)
-> Maybe (UserId, UserInfo) -> Maybe UserInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Users -> Maybe (UserId, UserInfo)
findUserByUsername Text
name (Users -> Maybe (UserId, UserInfo))
-> Users -> Maybe (UserId, UserInfo)
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
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 =
    (UserId, UserInfo) -> UserInfo
forall a b. (a, b) -> b
snd ((UserId, UserInfo) -> UserInfo)
-> Maybe (UserId, UserInfo) -> Maybe UserInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Users -> Maybe (UserId, UserInfo)
findUserByNickname Text
name (Users -> Maybe (UserId, UserInfo))
-> Users -> Maybe (UserId, UserInfo)
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting Users ChatState Users -> Users
forall s a. s -> Getting a s a -> a
^.Getting Users ChatState Users
Lens' ChatState Users
csUsers)

getUsers :: MH Users
getUsers :: MH Users
getUsers = Getting Users ChatState Users -> MH Users
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Users ChatState Users
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 Set Text
forall a. Set a
Set.empty Set Text
forall a. Set a
Set.empty SyntaxMap
forall a. Monoid a => a
mempty

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

attrNameToConfig :: Brick.AttrName -> Text
attrNameToConfig :: AttrName -> Text
attrNameToConfig = String -> Text
T.pack (String -> Text) -> (AttrName -> String) -> AttrName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> String)
-> (AttrName -> [String]) -> AttrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> [String]
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 = (Text -> Set Text -> Set Text) -> Set Text -> [Text] -> Set Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Set Text -> Set Text
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
stChatState
-> Getting (First ClientChannel) ChatState ClientChannel
-> Maybe ClientChannel
forall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId)
    NewMessageIndicator -> Maybe NewMessageIndicator
forall (m :: * -> *) a. Monad m => a -> m a
return (NewMessageIndicator -> Maybe NewMessageIndicator)
-> NewMessageIndicator -> Maybe NewMessageIndicator
forall a b. (a -> b) -> a -> b
$ ClientChannel
ccClientChannel
-> Getting NewMessageIndicator ClientChannel NewMessageIndicator
-> NewMessageIndicator
forall s a. s -> Getting a s a -> a
^.(ChannelInfo -> Const NewMessageIndicator ChannelInfo)
-> ClientChannel -> Const NewMessageIndicator ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo((ChannelInfo -> Const NewMessageIndicator ChannelInfo)
 -> ClientChannel -> Const NewMessageIndicator ClientChannel)
-> ((NewMessageIndicator
     -> Const NewMessageIndicator NewMessageIndicator)
    -> ChannelInfo -> Const NewMessageIndicator ChannelInfo)
-> Getting NewMessageIndicator ClientChannel NewMessageIndicator
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(NewMessageIndicator
 -> Const NewMessageIndicator NewMessageIndicator)
-> ChannelInfo -> Const NewMessageIndicator ChannelInfo
Lens' ChannelInfo NewMessageIndicator
cdNewMessageIndicator

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

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

moveLeft :: (Eq a) => a -> [a] -> [a]
moveLeft :: a -> [a] -> [a]
moveLeft a
v [a]
as =
    case a -> [a] -> Maybe Int
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) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
as
            in [a] -> [a]
forall a. [a] -> [a]
init [a]
h [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
v, [a] -> a
forall a. [a] -> a
last [a]
h] [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a] -> [a]
forall a. [a] -> [a]
tail [a]
t

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