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
import           Matterhorn.Types.KeyEvents

-- | Render a tabbed window.
drawTabbedWindow :: (Eq a, Show a)
                 => TabbedWindow a
                 -> ChatState
                 -> Widget Name
drawTabbedWindow :: TabbedWindow a -> ChatState -> Widget Name
drawTabbedWindow TabbedWindow a
w ChatState
cs =
    let cur :: TabbedWindowEntry a
cur = TabbedWindow a -> TabbedWindowEntry a
forall a. (Show a, Eq a) => TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w
        tabBody :: Widget Name
tabBody = TabbedWindowEntry a -> a -> ChatState -> Widget Name
forall a. TabbedWindowEntry a -> a -> ChatState -> Widget Name
tweRender TabbedWindowEntry a
cur (TabbedWindow a -> a
forall a. TabbedWindow a -> a
twValue TabbedWindow 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 a -> a -> Widget Name
forall a. TabbedWindowTemplate a -> a -> Widget Name
twtTitle (TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w) (TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
cur)
        tId :: TeamId
tId = ChatState
csChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
    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 a -> Int
forall a. TabbedWindow a -> Int
twWindowHeight TabbedWindow 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 a -> Int
forall a. TabbedWindow a -> Int
twWindowWidth TabbedWindow 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 a -> Widget Name
forall a. (Eq a, Show a) => TeamId -> TabbedWindow a -> Widget Name
tabBar TeamId
tId TabbedWindow 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 Widget Name
keybindingHelp)

-- | Keybinding help to show at the bottom of a tabbed window.
keybindingHelp :: Widget Name
keybindingHelp :: Widget Name
keybindingHelp =
    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 Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp) ((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 a
       -> Widget Name
tabBar :: TeamId -> TabbedWindow a -> Widget Name
tabBar TeamId
tId TabbedWindow a
w =
    let cur :: TabbedWindowEntry a
cur = TabbedWindow a -> TabbedWindowEntry a
forall a. (Show a, Eq a) => TabbedWindow a -> TabbedWindowEntry a
getCurrentTabbedWindowEntry TabbedWindow a
w
        entries :: [TabbedWindowEntry a]
entries = TabbedWindowTemplate a -> [TabbedWindowEntry a]
forall a. TabbedWindowTemplate a -> [TabbedWindowEntry a]
twtEntries (TabbedWindow a -> TabbedWindowTemplate a
forall a. TabbedWindow a -> TabbedWindowTemplate a
twTemplate TabbedWindow a
w)
        renderEntry :: TabbedWindowEntry a -> Widget n
renderEntry TabbedWindowEntry 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 a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry a
cur
                makeVisible :: Widget n -> Widget n
makeVisible = 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. Lens' (Result n) Image
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
$ 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
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 [ 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
$ Result n -> RenderM n (Result n)
forall (m :: * -> *) a. Monad m => a -> m a
return 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
makeVisible (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 a -> a -> Bool -> Text
forall a. TabbedWindowEntry a -> a -> Bool -> Text
tweTitle TabbedWindowEntry a
e (TabbedWindowEntry a -> a
forall a. TabbedWindowEntry a -> a
tweValue TabbedWindowEntry 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
ctx <- RenderM n Context
forall n. RenderM n Context
getContext
            let width :: Int
width = Context
ctxContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
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 a -> Widget n
forall n. TabbedWindowEntry a -> Widget n
renderEntry (TabbedWindowEntry a -> Widget n)
-> [TabbedWindowEntry a] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TabbedWindowEntry 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