module Matterhorn.Draw.TabbedWindow
  ( drawTabbedWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border
import           Brick.Widgets.Center
import           Data.List ( intersperse )
import qualified Graphics.Vty as Vty

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.Draw.Util ( renderKeybindingHelp )
import           Matterhorn.Types
import           Matterhorn.Themes

-- | Render a tabbed window.
drawTabbedWindow :: (Eq a, Show a)
                 => TabbedWindow ChatState m Name a
                 -> ChatState
                 -> TeamId
                 -> Widget Name
drawTabbedWindow :: forall a (m :: * -> *).
(Eq a, Show a) =>
TabbedWindow ChatState m Name a
-> ChatState -> TeamId -> Widget Name
drawTabbedWindow TabbedWindow ChatState m Name a
w ChatState
cs TeamId
tId =
    let cur :: TabbedWindowEntry ChatState m Name a
cur = TabbedWindow ChatState m Name a
-> TabbedWindowEntry ChatState m Name a
forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow ChatState m Name a
w
        tabBody :: Widget Name
tabBody = TabbedWindowEntry ChatState m Name a
-> a -> ChatState -> Widget Name
forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> s -> Widget n
tweRender TabbedWindowEntry ChatState m Name a
cur (TabbedWindow ChatState m Name a -> a
forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow ChatState m Name a
w) ChatState
cs
        title :: Widget Name
title = AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
clientEmphAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ TabbedWindowTemplate ChatState m Name a -> a -> Widget Name
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> a -> Widget n
twtTitle (TabbedWindow ChatState m Name a
-> TabbedWindowTemplate ChatState m Name a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow ChatState m Name a
w) (TabbedWindowEntry ChatState m Name a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry ChatState m Name a
cur)
    in Widget Name -> Widget Name
forall n. Widget n -> Widget n
centerLayer (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit (TabbedWindow ChatState m Name a -> Int
forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowHeight TabbedWindow ChatState m Name a
w) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimit (TabbedWindow ChatState m Name a -> Int
forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowWidth TabbedWindow ChatState m Name a
w) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       Widget Name -> Widget Name
forall n. Widget n -> Widget n
joinBorders (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
       (TeamId -> TabbedWindow ChatState m Name a -> Widget Name
forall a s (m :: * -> *).
(Eq a, Show a) =>
TeamId -> TabbedWindow s m Name a -> Widget Name
tabBar TeamId
tId TabbedWindow ChatState m Name a
w Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
tabBody Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
hBorder Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (ChatState -> Widget Name
keybindingHelp ChatState
cs))

-- | Keybinding help to show at the bottom of a tabbed window.
keybindingHelp :: ChatState -> Widget Name
keybindingHelp :: ChatState -> Widget Name
keybindingHelp ChatState
st =
    let pairs :: [(Text, [KeyEvent])]
pairs = [ (Text
"Switch tabs", [KeyEvent
SelectNextTabEvent, KeyEvent
SelectPreviousTabEvent])
                , (Text
"Scroll", [KeyEvent
ScrollUpEvent, KeyEvent
ScrollDownEvent, KeyEvent
ScrollLeftEvent, KeyEvent
ScrollRightEvent, KeyEvent
PageLeftEvent, KeyEvent
PageRightEvent])
                ]
    in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"  ") ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ ((Text -> [KeyEvent] -> Widget Name)
-> (Text, [KeyEvent]) -> Widget Name
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp ChatState
st)) ((Text, [KeyEvent]) -> Widget Name)
-> [(Text, [KeyEvent])] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, [KeyEvent])]
pairs

-- | The scrollable tab bar to show at the top of a tabbed window.
tabBar :: (Eq a, Show a)
       => TeamId
       -> TabbedWindow s m Name a
       -> Widget Name
tabBar :: forall a s (m :: * -> *).
(Eq a, Show a) =>
TeamId -> TabbedWindow s m Name a -> Widget Name
tabBar TeamId
tId TabbedWindow s m Name a
w =
    let cur :: TabbedWindowEntry s m Name a
cur = TabbedWindow s m Name a -> TabbedWindowEntry s m Name a
forall a s (m :: * -> *) n.
(Show a, Eq a) =>
TabbedWindow s m n a -> TabbedWindowEntry s m n a
getCurrentTabbedWindowEntry TabbedWindow s m Name a
w
        entries :: [TabbedWindowEntry s m Name a]
entries = TabbedWindowTemplate s m Name a -> [TabbedWindowEntry s m Name a]
forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (TabbedWindow s m Name a -> TabbedWindowTemplate s m Name a
forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow s m Name a
w)
        renderEntry :: TabbedWindowEntry s m n a -> Widget n
renderEntry TabbedWindowEntry s m n a
e =
            let useAttr :: Widget n -> Widget n
useAttr = if Bool
isCurrent
                          then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabSelectedAttr
                          else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabUnselectedAttr
                isCurrent :: Bool
isCurrent = TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== TabbedWindowEntry s m Name a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m Name a
cur
                makeTabVisible :: Widget n -> Widget n
makeTabVisible = if Bool
isCurrent then Widget n -> Widget n
forall n. Widget n -> Widget n
visible else Widget n -> Widget n
forall a. a -> a
id
                decorateTab :: Widget n -> Widget n
decorateTab Widget n
v = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
                    Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
v
                    let width :: Int
width = Image -> Int
Vty.imageWidth (Result n
resultResult n -> Getting Image (Result n) Image -> Image
forall s a. s -> Getting a s a -> a
^.Getting Image (Result n) Image
forall n (f :: * -> *).
Functor f =>
(Image -> f Image) -> Result n -> f (Result n)
imageL)
                    if Bool
isCurrent
                       then
                           Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Result n -> Widget n
forall n. Result n -> Widget n
resultToWidget Result n
result
                       else
                           Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox [ Result n -> Widget n
forall n. Result n -> Widget n
resultToWidget Result n
result
                                         , Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width Widget n
forall n. Widget n
hBorder
                                         ]
            in Widget n -> Widget n
forall n. Widget n -> Widget n
makeTabVisible (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               Widget n -> Widget n
forall n. Widget n -> Widget n
decorateTab (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               Widget n -> Widget n
forall n. Widget n -> Widget n
useAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padLeftRight Int
2 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
               Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$
               TabbedWindowEntry s m n a -> a -> Bool -> Text
forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> Bool -> Text
tweTitle TabbedWindowEntry s m n a
e (TabbedWindowEntry s m n a -> a
forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e) Bool
isCurrent
        contents :: Widget n
contents = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
            Context n
ctx <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
            let width :: Int
width = Context n
ctxContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL
            Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
intersperse Widget n
forall n. Widget n
divider ([Widget n] -> [Widget n]) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ TabbedWindowEntry s m Name a -> Widget n
forall {s} {m :: * -> *} {n} {n}.
TabbedWindowEntry s m n a -> Widget n
renderEntry (TabbedWindowEntry s m Name a -> Widget n)
-> [TabbedWindowEntry s m Name a] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TabbedWindowEntry s m Name a]
entries) [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<>
                            [Widget n
forall n. Widget n
divider, Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
width Widget n
forall n. Widget n
hBorder]
        divider :: Widget n
divider = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 Widget n
forall n. Widget n
vBorder Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Edges Bool -> Widget n
forall n. Edges Bool -> Widget n
joinableBorder (Bool -> Bool -> Bool -> Bool -> Edges Bool
forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
False)
    in Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Name -> ViewportType -> Widget Name -> Widget Name
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
TabbedWindowTabBar TeamId
tId) ViewportType
Horizontal Widget Name
forall n. Widget n
contents