{-# 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 forall a a'. Traversal (Maybe a) (Maybe a') a 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
_2
        monochrome :: [Widget n] -> [Widget n]
monochrome = (Widget n -> Widget n) -> [Widget n] -> [Widget n]
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
"invalid")
        drawMode :: Mode -> [Mode] -> [Widget Name]
drawMode Mode
m [Mode]
ms =
            let rest :: [Widget Name]
rest = case [Mode]
ms of
                    (a:as) -> Mode -> [Mode] -> [Widget Name]
drawMode Mode
a [Mode]
as
                    [Mode]
_ -> []
            in case Mode
m of
                -- For this first section of modes, we only want
                -- to draw for the current mode and ignore the
                -- mode stack because we expect the current mode
                -- to be all we need to draw what should be on
                -- the screen.
                Mode
Main                          -> ChatState -> Mode -> [Widget Name]
drawMain ChatState
st Mode
m
                ShowHelp HelpTopic
topic                -> HelpTopic -> ChatState -> [Widget Name]
drawShowHelp HelpTopic
topic ChatState
st

                -- For the following modes, we want to draw the
                -- whole mode stack since we expect the UI to
                -- have layers and we want to show prior modes
                -- underneath.
                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. [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 (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