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 = 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 = forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> s -> Widget n
tweRender TabbedWindowEntry ChatState m Name a
cur (forall s (m :: * -> *) n a. TabbedWindow s m n a -> a
twValue TabbedWindow ChatState m Name a
w) ChatState
cs
        title :: Widget Name
title = forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> a -> Widget n
twtTitle (forall s (m :: * -> *) n a.
TabbedWindow s m n a -> TabbedWindowTemplate s m n a
twTemplate TabbedWindow ChatState m Name a
w) (forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry ChatState m Name a
cur)
    in forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$
       forall n. Int -> Widget n -> Widget n
vLimit (forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowHeight TabbedWindow ChatState m Name a
w) forall a b. (a -> b) -> a -> b
$
       forall n. Int -> Widget n -> Widget n
hLimit (forall s (m :: * -> *) n a. TabbedWindow s m n a -> Int
twWindowWidth TabbedWindow ChatState m Name a
w) forall a b. (a -> b) -> a -> b
$
       forall n. Widget n -> Widget n
joinBorders forall a b. (a -> b) -> a -> b
$
       forall n. Widget n -> Widget n -> Widget n
borderWithLabel Widget Name
title forall a b. (a -> b) -> a -> b
$
       (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 forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
tabBody forall n. Widget n -> Widget n -> Widget n
<=> forall n. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=> 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 forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
"  ") forall a b. (a -> b) -> a -> b
$ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp ChatState
st)) 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 = 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 = forall s (m :: * -> *) n a.
TabbedWindowTemplate s m n a -> [TabbedWindowEntry s m n a]
twtEntries (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 forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabSelectedAttr
                          else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
tabUnselectedAttr
                isCurrent :: Bool
isCurrent = forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e forall a. Eq a => a -> a -> Bool
== 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 forall n. Widget n -> Widget n
visible else forall a. a -> a
id
                decorateTab :: Widget n -> Widget n
decorateTab Widget n
v = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
                    Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
v
                    let width :: Int
width = Image -> Int
Vty.imageWidth (Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageL)
                    if Bool
isCurrent
                       then
                           forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Result n -> Widget n
resultToWidget Result n
result
                       else
                           forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox [ forall n. Result n -> Widget n
resultToWidget Result n
result
                                         , forall n. Int -> Widget n -> Widget n
hLimit Int
width forall n. Widget n
hBorder
                                         ]
            in forall n. Widget n -> Widget n
makeTabVisible forall a b. (a -> b) -> a -> b
$
               forall n. Widget n -> Widget n
decorateTab forall a b. (a -> b) -> a -> b
$
               forall n. Widget n -> Widget n
useAttr forall a b. (a -> b) -> a -> b
$
               forall n. Int -> Widget n -> Widget n
padLeftRight Int
2 forall a b. (a -> b) -> a -> b
$
               forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$
               forall s (m :: * -> *) n a.
TabbedWindowEntry s m n a -> a -> Bool -> Text
tweTitle TabbedWindowEntry s m n a
e (forall s (m :: * -> *) n a. TabbedWindowEntry s m n a -> a
tweValue TabbedWindowEntry s m n a
e) Bool
isCurrent
        contents :: Widget n
contents = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
            Context n
ctx <- forall n. RenderM n (Context n)
getContext
            let width :: Int
width = Context n
ctxforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
            forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
intersperse forall n. Widget n
divider forall a b. (a -> b) -> a -> b
$ forall {s} {m :: * -> *} {n} {n}.
TabbedWindowEntry s m n a -> Widget n
renderEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TabbedWindowEntry s m Name a]
entries) forall a. Semigroup a => a -> a -> a
<>
                            [forall n. Widget n
divider, forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
width forall n. Widget n
hBorder]
        divider :: Widget n
divider = forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall n. Widget n
vBorder forall n. Widget n -> Widget n -> Widget n
<=> forall n. Edges Bool -> Widget n
joinableBorder (forall a. a -> a -> a -> a -> Edges a
Edges Bool
True Bool
False Bool
False Bool
False)
    in forall n. Int -> Widget n -> Widget n
vLimit Int
2 forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (TeamId -> Name
TabbedWindowTabBar TeamId
tId) ViewportType
Horizontal forall n. Widget n
contents