{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PackageImports #-}
module Matterhorn.Draw (draw) where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Lens.Micro.Platform ( _2, singular, _Just )
import Matterhorn.Draw.ChannelTopicWindow
import Matterhorn.Draw.ChannelSelectPrompt
import Matterhorn.Draw.MessageDeleteConfirm
import Matterhorn.Draw.DeleteChannelConfirm
import Matterhorn.Draw.LeaveChannelConfirm
import Matterhorn.Draw.Main
import Matterhorn.Draw.ThemeListWindow
import Matterhorn.Draw.PostListWindow
import Matterhorn.Draw.ShowHelp
import Matterhorn.Draw.UserListWindow
import Matterhorn.Draw.ChannelListWindow
import Matterhorn.Draw.ReactionEmojiListWindow
import Matterhorn.Draw.TabbedWindow
import Matterhorn.Draw.NotifyPrefs
import Matterhorn.Types
draw :: ChatState -> [Widget Name]
draw :: ChatState -> [Widget Name]
draw ChatState
st = [Widget Name] -> Maybe [Widget Name] -> [Widget Name]
forall a. a -> Maybe a -> a
fromMaybe (ChatState -> Mode -> [Widget Name]
drawMain ChatState
st Mode
Main) (Maybe [Widget Name] -> [Widget Name])
-> Maybe [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ do
TeamId
tId <- ChatState
stChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
let messageViewWindow :: TabbedWindow ChatState MH Name ViewMessageWindowTab
messageViewWindow = ChatState
stChatState
-> Getting
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
ChatState
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> TabbedWindow ChatState MH Name ViewMessageWindowTab
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab) TeamState)
-> ChatState
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab) ChatState)
-> ((TabbedWindow ChatState MH Name ViewMessageWindowTab
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> TeamState
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab) TeamState)
-> Getting
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
ChatState
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab) TeamState
Lens'
TeamState
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
tsViewedMessage((Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> TeamState
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab) TeamState)
-> ((TabbedWindow ChatState MH Name ViewMessageWindowTab
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> TeamState
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Traversal
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Lens
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall s t a. HasCallStack => Traversal s t a a -> Lens s t a a
singular ((Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Message,
TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> f (Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
Traversal
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
_Just(((Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)))
-> ((TabbedWindow ChatState MH Name ViewMessageWindowTab
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> (TabbedWindow ChatState MH Name ViewMessageWindowTab
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Maybe
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(TabbedWindow ChatState MH Name ViewMessageWindowTab
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab))
-> (Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
-> Const
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(Message, TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
(TabbedWindow ChatState MH Name ViewMessageWindowTab)
_2
monochrome :: [Widget n] -> [Widget n]
monochrome = (Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr (AttrName -> Widget n -> Widget n)
-> AttrName -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> AttrName
attrName String
"invalid")
drawMode :: Mode -> [Mode] -> [Widget Name]
drawMode Mode
m [Mode]
ms =
let rest :: [Widget Name]
rest = case [Mode]
ms of
(Mode
a:[Mode]
as) -> Mode -> [Mode] -> [Widget Name]
drawMode Mode
a [Mode]
as
[Mode]
_ -> []
in case Mode
m of
Mode
Main -> ChatState -> Mode -> [Widget Name]
drawMain ChatState
st Mode
m
ShowHelp HelpTopic
topic -> HelpTopic -> ChatState -> [Widget Name]
drawShowHelp HelpTopic
topic ChatState
st
Mode
ChannelSelect -> ChatState -> TeamId -> Widget Name
drawChannelSelectPrompt ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: ChatState -> Mode -> [Widget Name]
drawMain ChatState
st Mode
m
MessageSelectDeleteConfirm {} -> Widget Name
drawMessageDeleteConfirm Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name]
rest
Mode
ThemeListWindow -> ChatState -> TeamId -> Widget Name
drawThemeListWindow ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name]
rest
Mode
LeaveChannelConfirm -> ChatState -> TeamId -> Widget Name
drawLeaveChannelConfirm ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
DeleteChannelConfirm -> ChatState -> TeamId -> Widget Name
drawDeleteChannelConfirm ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
PostListWindow PostListContents
contents -> PostListContents -> ChatState -> TeamId -> Widget Name
drawPostListWindow PostListContents
contents ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
UserListWindow -> ChatState -> TeamId -> Widget Name
drawUserListWindow ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
ChannelListWindow -> ChatState -> TeamId -> Widget Name
drawChannelListWindow ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
ReactionEmojiListWindow -> ChatState -> TeamId -> Widget Name
drawReactionEmojiListWindow ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
ViewMessage -> TabbedWindow ChatState MH Name ViewMessageWindowTab
-> ChatState -> TeamId -> Widget Name
forall a (m :: * -> *).
(Eq a, Show a) =>
TabbedWindow ChatState m Name a
-> ChatState -> TeamId -> Widget Name
drawTabbedWindow TabbedWindow ChatState MH Name ViewMessageWindowTab
messageViewWindow ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
EditNotifyPrefs -> ChatState -> TeamId -> Widget Name
drawNotifyPrefs ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
Mode
ChannelTopicWindow -> ChatState -> TeamId -> Widget Name
drawChannelTopicWindow ChatState
st TeamId
tId Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
: [Widget Name] -> [Widget Name]
forall {n}. [Widget n] -> [Widget n]
monochrome [Widget Name]
rest
topMode :: Mode
topMode = TeamState -> Mode
teamMode (TeamState -> Mode) -> TeamState -> Mode
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting TeamState ChatState TeamState -> TeamState
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)
otherModes :: [Mode]
otherModes = [Mode] -> [Mode]
forall a. HasCallStack => [a] -> [a]
tail ([Mode] -> [Mode]) -> [Mode] -> [Mode]
forall a b. (a -> b) -> a -> b
$ TeamState -> [Mode]
teamModes (TeamState -> [Mode]) -> TeamState -> [Mode]
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState -> Getting TeamState ChatState TeamState -> TeamState
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)
[Widget Name] -> Maybe [Widget Name]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Widget Name] -> Maybe [Widget Name])
-> [Widget Name] -> Maybe [Widget Name]
forall a b. (a -> b) -> a -> b
$ Mode -> [Mode] -> [Widget Name]
drawMode Mode
topMode [Mode]
otherModes