{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
module Matterhorn.Types.Core
  ( Name(..)
  , ChannelListEntry(..)
  , ChannelListEntryType(..)
  , ChannelSelectMatch(..)
  , LinkTarget(..)

  , MessageId(..)
  , messageIdPostId

  , ChannelListGroupLabel(..)
  , channelListGroupNames

  , MessageSelectState(..)
  , HelpScreen(..)
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Brick
import           Data.Hashable ( Hashable )
import qualified Data.Text as T
import           Data.UUID ( UUID )
import           GHC.Generics ( Generic )
import           Network.Mattermost.Types

import           Matterhorn.Types.RichText ( URL, TeamURLName )

-- | This 'Name' type is the type used in 'brick' to identify various
-- parts of the interface.
data Name =
    MessageInterfaceMessages Name
    -- ^ The rendering of messages for the specified message interface
    -- (by editor name)
    | MessageInput ChannelId
    -- ^ The message editor for the specified channel's main message
    -- interface
    | MessageInputPrompt Name
    -- ^ A wrapper name for reporting the extent of a message editor's
    -- prompt. The specified name is the name of the editor whose prompt
    -- extent is being reported.
    | ChannelListViewport TeamId
    -- ^ The name of the channel list viewport for the specified team.
    | HelpViewport
    -- ^ The name of the viewport for the help interface.
    | PostList
    -- ^ The tag for messages rendered in the post list window.
    | HelpContent HelpScreen
    -- ^ The cache key constructor for caching help screen content.
    | CompletionList Name
    -- ^ The name of the list of completion alternatives in the
    -- specified editor's autocomplete pop-up.
    | JoinChannelList TeamId
    -- ^ The name of the channel list in the "/join" window.
    | UrlList Name
    -- ^ The name of a URL listing for the specified message interface's
    -- editor name.
    | MessagePreviewViewport Name
    -- ^ The name of the message interface editor's preview area.
    | ThemeListSearchInput TeamId
    -- ^ The list of themes in the "/theme" window for the specified
    -- team.
    | UserListSearchInput TeamId
    -- ^ The editor name for the user search input in the specified
    -- team's user list window.
    | JoinChannelListSearchInput TeamId
    -- ^ The editor name for the search input in the specified team's
    -- "/join" window.
    | UserListSearchResults TeamId
    -- ^ The list name for the specified team's user list window search
    -- results.
    | ThemeListSearchResults TeamId
    -- ^ The list name for the specified team's theme list window search
    -- results.
    | ViewMessageArea TeamId
    -- ^ The viewport for the specified team's single-message view
    -- window.
    | ViewMessageReactionsArea TeamId
    -- ^ The viewport for the specified team's single-message view
    -- window's reaction tab.
    | ChannelSidebar TeamId
    -- ^ The cache key for the specified team's channel list viewport
    -- contents.
    | ChannelSelectInput TeamId
    -- ^ The editor name for the specified team's channel selection mode
    -- editor.
    | AttachmentList ChannelId
    -- ^ The name of the attachment list for the specified channel's
    -- message interface.
    | AttachmentFileBrowser ChannelId
    | ReactionEmojiList TeamId
    -- ^ The name of the list of emoji to choose from for reactions for
    -- the specified team.
    | ReactionEmojiListInput TeamId
    -- ^ The name of the search editor for the specified team's emoji
    -- search window.
    | TabbedWindowTabBar TeamId
    -- ^ The name of the specified team's tabbed window tab bar
    -- viewport.
    | MuteToggleField TeamId
    -- ^ The name of the channel preferences mute form field.
    | ChannelMentionsField TeamId
    -- ^ The name of the channel preferences mentions form field.
    | DesktopNotificationsField TeamId (WithDefault NotifyOption)
    -- ^ The name of the channel preferences desktop notifications form
    -- field.
    | PushNotificationsField TeamId (WithDefault NotifyOption)
    -- ^ The name of the channel preferences push notifications form
    -- field.
    | ChannelTopicEditor TeamId
    -- ^ The specified team's channel topic window editor.
    | ChannelTopicSaveButton TeamId
    -- ^ The specified team's channel topic window save button.
    | ChannelTopicCancelButton TeamId
    -- ^ The specified team's channel topic window canel button.
    | ChannelTopicEditorPreview TeamId
    -- ^ The specified team's channel topic window preview area
    -- viewport.
    | ThreadMessageInput ChannelId
    -- ^ The message editor for the specified channel's thread view.
    | ThreadEditorAttachmentList ChannelId
    -- ^ The list name for the specified channel's thread message
    -- interface's attachment list.
    | ChannelTopic ChannelId
    -- ^ The mouse click area tag for a rendered channel topic.
    | TeamList
    -- ^ The viewport name for the team list.
    | ClickableChannelSelectEntry ChannelSelectMatch
    -- ^ The name of a clickable channel select entry in the channel
    -- select match list.
    | ClickableChannelListEntry ChannelId
    -- ^ The name of a clickable entry in the channel list.
    | ClickableTeamListEntry TeamId
    -- ^ The name of a clickable entry in the team list.
    | ClickableURL (Maybe MessageId) Name Int LinkTarget
    -- ^ The name of a clickable URL rendered in RichText. If provided,
    -- the message ID is the ID of the message in which the URL appears.
    -- The integer is the URL index in the rich text block for unique
    -- identification.
    | ClickableReaction PostId Name Text (Set UserId)
    -- ^ The name of a clickable reaction rendered in RichText when it
    -- is part of a message.
    | ClickableAttachmentInMessage Name FileId
    -- ^ The name of a clickable attachment.
    | ClickableUsername (Maybe MessageId) Name Int Text
    -- ^ The name of a clickable username rendered in RichText. The
    -- message ID and integer sequence number uniquely identify the
    -- clickable region.
    | ClickableURLListEntry Int LinkTarget
    -- ^ The name of a clickable URL list entry. The integer is the list
    -- index.
    | ClickableChannelListGroupHeading ChannelListGroupLabel
    -- ^ The name of a clickable channel list group heading.
    | ClickableReactionEmojiListWindowEntry (Bool, T.Text)
    -- ^ The name of a clickable reaction emoji list entry.
    | AttachmentPathEditor Name
    -- ^ The name of the specified message interface's attachment
    -- browser path editor.
    | AttachmentPathSaveButton Name
    -- ^ The name of the specified message interface's attachment
    -- browser save button.
    | AttachmentPathCancelButton Name
    -- ^ The name of the specified message interface's attachment
    -- browser cancel button.
    | RenderedMessage MessageId
    -- ^ The cache key for the rendering of the specified message.
    | SelectedChannelListEntry TeamId
    -- ^ The name of the specified team's currently selected channel
    -- list entry, used to bring the entry into view in its viewport.
    | VScrollBar Brick.ClickableScrollbarElement Name
    -- ^ The name of the scroll bar elements for the specified viewport
    -- name.
    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)

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

-- | 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
                     , ChannelListEntry -> Bool
channelListEntryMuted :: 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)

-- | The 'HelpScreen' type represents the set of possible 'Help' screens
-- 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, Int -> HelpScreen -> ShowS
[HelpScreen] -> ShowS
HelpScreen -> String
(Int -> HelpScreen -> ShowS)
-> (HelpScreen -> String)
-> ([HelpScreen] -> ShowS)
-> Show HelpScreen
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HelpScreen] -> ShowS
$cshowList :: [HelpScreen] -> ShowS
show :: HelpScreen -> String
$cshow :: HelpScreen -> String
showsPrec :: Int -> HelpScreen -> ShowS
$cshowsPrec :: Int -> HelpScreen -> ShowS
Show, Eq HelpScreen
Eq HelpScreen
-> (HelpScreen -> HelpScreen -> Ordering)
-> (HelpScreen -> HelpScreen -> Bool)
-> (HelpScreen -> HelpScreen -> Bool)
-> (HelpScreen -> HelpScreen -> Bool)
-> (HelpScreen -> HelpScreen -> Bool)
-> (HelpScreen -> HelpScreen -> HelpScreen)
-> (HelpScreen -> HelpScreen -> HelpScreen)
-> Ord HelpScreen
HelpScreen -> HelpScreen -> Bool
HelpScreen -> HelpScreen -> Ordering
HelpScreen -> HelpScreen -> HelpScreen
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 :: HelpScreen -> HelpScreen -> HelpScreen
$cmin :: HelpScreen -> HelpScreen -> HelpScreen
max :: HelpScreen -> HelpScreen -> HelpScreen
$cmax :: HelpScreen -> HelpScreen -> HelpScreen
>= :: HelpScreen -> HelpScreen -> Bool
$c>= :: HelpScreen -> HelpScreen -> Bool
> :: HelpScreen -> HelpScreen -> Bool
$c> :: HelpScreen -> HelpScreen -> Bool
<= :: HelpScreen -> HelpScreen -> Bool
$c<= :: HelpScreen -> HelpScreen -> Bool
< :: HelpScreen -> HelpScreen -> Bool
$c< :: HelpScreen -> HelpScreen -> Bool
compare :: HelpScreen -> HelpScreen -> Ordering
$ccompare :: HelpScreen -> HelpScreen -> Ordering
$cp1Ord :: Eq HelpScreen
Ord)

data LinkTarget =
    LinkURL URL
    | LinkFileId FileId
    | LinkPermalink TeamURLName PostId
    deriving (LinkTarget -> LinkTarget -> Bool
(LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool) -> Eq LinkTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LinkTarget -> LinkTarget -> Bool
$c/= :: LinkTarget -> LinkTarget -> Bool
== :: LinkTarget -> LinkTarget -> Bool
$c== :: LinkTarget -> LinkTarget -> Bool
Eq, Int -> LinkTarget -> ShowS
[LinkTarget] -> ShowS
LinkTarget -> String
(Int -> LinkTarget -> ShowS)
-> (LinkTarget -> String)
-> ([LinkTarget] -> ShowS)
-> Show LinkTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LinkTarget] -> ShowS
$cshowList :: [LinkTarget] -> ShowS
show :: LinkTarget -> String
$cshow :: LinkTarget -> String
showsPrec :: Int -> LinkTarget -> ShowS
$cshowsPrec :: Int -> LinkTarget -> ShowS
Show, Eq LinkTarget
Eq LinkTarget
-> (LinkTarget -> LinkTarget -> Ordering)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> Bool)
-> (LinkTarget -> LinkTarget -> LinkTarget)
-> (LinkTarget -> LinkTarget -> LinkTarget)
-> Ord LinkTarget
LinkTarget -> LinkTarget -> Bool
LinkTarget -> LinkTarget -> Ordering
LinkTarget -> LinkTarget -> LinkTarget
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 :: LinkTarget -> LinkTarget -> LinkTarget
$cmin :: LinkTarget -> LinkTarget -> LinkTarget
max :: LinkTarget -> LinkTarget -> LinkTarget
$cmax :: LinkTarget -> LinkTarget -> LinkTarget
>= :: LinkTarget -> LinkTarget -> Bool
$c>= :: LinkTarget -> LinkTarget -> Bool
> :: LinkTarget -> LinkTarget -> Bool
$c> :: LinkTarget -> LinkTarget -> Bool
<= :: LinkTarget -> LinkTarget -> Bool
$c<= :: LinkTarget -> LinkTarget -> Bool
< :: LinkTarget -> LinkTarget -> Bool
$c< :: LinkTarget -> LinkTarget -> Bool
compare :: LinkTarget -> LinkTarget -> Ordering
$ccompare :: LinkTarget -> LinkTarget -> Ordering
$cp1Ord :: Eq LinkTarget
Ord)

data MessageId = MessagePostId PostId
               | MessageUUID UUID
               deriving (MessageId -> MessageId -> Bool
(MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool) -> Eq MessageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageId -> MessageId -> Bool
$c/= :: MessageId -> MessageId -> Bool
== :: MessageId -> MessageId -> Bool
$c== :: MessageId -> MessageId -> Bool
Eq, ReadPrec [MessageId]
ReadPrec MessageId
Int -> ReadS MessageId
ReadS [MessageId]
(Int -> ReadS MessageId)
-> ReadS [MessageId]
-> ReadPrec MessageId
-> ReadPrec [MessageId]
-> Read MessageId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MessageId]
$creadListPrec :: ReadPrec [MessageId]
readPrec :: ReadPrec MessageId
$creadPrec :: ReadPrec MessageId
readList :: ReadS [MessageId]
$creadList :: ReadS [MessageId]
readsPrec :: Int -> ReadS MessageId
$creadsPrec :: Int -> ReadS MessageId
Read, Eq MessageId
Eq MessageId
-> (MessageId -> MessageId -> Ordering)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> Bool)
-> (MessageId -> MessageId -> MessageId)
-> (MessageId -> MessageId -> MessageId)
-> Ord MessageId
MessageId -> MessageId -> Bool
MessageId -> MessageId -> Ordering
MessageId -> MessageId -> MessageId
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 :: MessageId -> MessageId -> MessageId
$cmin :: MessageId -> MessageId -> MessageId
max :: MessageId -> MessageId -> MessageId
$cmax :: MessageId -> MessageId -> MessageId
>= :: MessageId -> MessageId -> Bool
$c>= :: MessageId -> MessageId -> Bool
> :: MessageId -> MessageId -> Bool
$c> :: MessageId -> MessageId -> Bool
<= :: MessageId -> MessageId -> Bool
$c<= :: MessageId -> MessageId -> Bool
< :: MessageId -> MessageId -> Bool
$c< :: MessageId -> MessageId -> Bool
compare :: MessageId -> MessageId -> Ordering
$ccompare :: MessageId -> MessageId -> Ordering
$cp1Ord :: Eq MessageId
Ord, Int -> MessageId -> ShowS
[MessageId] -> ShowS
MessageId -> String
(Int -> MessageId -> ShowS)
-> (MessageId -> String)
-> ([MessageId] -> ShowS)
-> Show MessageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MessageId] -> ShowS
$cshowList :: [MessageId] -> ShowS
show :: MessageId -> String
$cshow :: MessageId -> String
showsPrec :: Int -> MessageId -> ShowS
$cshowsPrec :: Int -> MessageId -> ShowS
Show, (forall x. MessageId -> Rep MessageId x)
-> (forall x. Rep MessageId x -> MessageId) -> Generic MessageId
forall x. Rep MessageId x -> MessageId
forall x. MessageId -> Rep MessageId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageId x -> MessageId
$cfrom :: forall x. MessageId -> Rep MessageId x
Generic, Int -> MessageId -> Int
MessageId -> Int
(Int -> MessageId -> Int)
-> (MessageId -> Int) -> Hashable MessageId
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MessageId -> Int
$chash :: MessageId -> Int
hashWithSalt :: Int -> MessageId -> Int
$chashWithSalt :: Int -> MessageId -> Int
Hashable)

messageIdPostId :: MessageId -> Maybe PostId
messageIdPostId :: MessageId -> Maybe PostId
messageIdPostId (MessagePostId PostId
p) = PostId -> Maybe PostId
forall a. a -> Maybe a
Just PostId
p
messageIdPostId MessageId
_ = Maybe PostId
forall a. Maybe a
Nothing

data ChannelListGroupLabel =
    ChannelGroupPublicChannels
    | ChannelGroupPrivateChannels
    | ChannelGroupFavoriteChannels
    | ChannelGroupDirectMessages
    deriving (ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
(ChannelListGroupLabel -> ChannelListGroupLabel -> Bool)
-> (ChannelListGroupLabel -> ChannelListGroupLabel -> Bool)
-> Eq ChannelListGroupLabel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
$c/= :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
== :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
$c== :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
Eq, Eq ChannelListGroupLabel
Eq ChannelListGroupLabel
-> (ChannelListGroupLabel -> ChannelListGroupLabel -> Ordering)
-> (ChannelListGroupLabel -> ChannelListGroupLabel -> Bool)
-> (ChannelListGroupLabel -> ChannelListGroupLabel -> Bool)
-> (ChannelListGroupLabel -> ChannelListGroupLabel -> Bool)
-> (ChannelListGroupLabel -> ChannelListGroupLabel -> Bool)
-> (ChannelListGroupLabel
    -> ChannelListGroupLabel -> ChannelListGroupLabel)
-> (ChannelListGroupLabel
    -> ChannelListGroupLabel -> ChannelListGroupLabel)
-> Ord ChannelListGroupLabel
ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
ChannelListGroupLabel -> ChannelListGroupLabel -> Ordering
ChannelListGroupLabel
-> ChannelListGroupLabel -> ChannelListGroupLabel
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 :: ChannelListGroupLabel
-> ChannelListGroupLabel -> ChannelListGroupLabel
$cmin :: ChannelListGroupLabel
-> ChannelListGroupLabel -> ChannelListGroupLabel
max :: ChannelListGroupLabel
-> ChannelListGroupLabel -> ChannelListGroupLabel
$cmax :: ChannelListGroupLabel
-> ChannelListGroupLabel -> ChannelListGroupLabel
>= :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
$c>= :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
> :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
$c> :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
<= :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
$c<= :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
< :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
$c< :: ChannelListGroupLabel -> ChannelListGroupLabel -> Bool
compare :: ChannelListGroupLabel -> ChannelListGroupLabel -> Ordering
$ccompare :: ChannelListGroupLabel -> ChannelListGroupLabel -> Ordering
$cp1Ord :: Eq ChannelListGroupLabel
Ord, Int -> ChannelListGroupLabel -> ShowS
[ChannelListGroupLabel] -> ShowS
ChannelListGroupLabel -> String
(Int -> ChannelListGroupLabel -> ShowS)
-> (ChannelListGroupLabel -> String)
-> ([ChannelListGroupLabel] -> ShowS)
-> Show ChannelListGroupLabel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelListGroupLabel] -> ShowS
$cshowList :: [ChannelListGroupLabel] -> ShowS
show :: ChannelListGroupLabel -> String
$cshow :: ChannelListGroupLabel -> String
showsPrec :: Int -> ChannelListGroupLabel -> ShowS
$cshowsPrec :: Int -> ChannelListGroupLabel -> ShowS
Show)

channelListGroupNames :: [(T.Text, ChannelListGroupLabel)]
channelListGroupNames :: [(Text, ChannelListGroupLabel)]
channelListGroupNames =
    [ (Text
"public", ChannelListGroupLabel
ChannelGroupPublicChannels)
    , (Text
"private", ChannelListGroupLabel
ChannelGroupPrivateChannels)
    , (Text
"favorite", ChannelListGroupLabel
ChannelGroupFavoriteChannels)
    , (Text
"direct", ChannelListGroupLabel
ChannelGroupDirectMessages)
    ]

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