{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Matterhorn.Draw.ThemeListWindow
  ( drawThemeListWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Keybindings
import qualified Brick.Widgets.List as L
import           Brick.Widgets.Border ( hBorder )
import           Brick.Widgets.Center ( hCenter )

import           Network.Mattermost.Types ( TeamId )

import           Matterhorn.Draw.ListWindow ( drawListWindow, WindowPosition(..) )
import           Matterhorn.Themes
import           Matterhorn.Types


drawThemeListWindow :: ChatState -> TeamId -> Widget Name
drawThemeListWindow :: ChatState -> TeamId -> Widget Name
drawThemeListWindow ChatState
st TeamId
tId =
    let window :: Widget Name
window = forall a b.
ListWindowState a b
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (b -> Widget Name)
-> (Bool -> a -> Widget Name)
-> Maybe (Widget Name)
-> WindowPosition
-> Int
-> Widget Name
drawListWindow (ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (ListWindowState InternalTheme ())
tsThemeListWindow)
                                  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Themes")
                                  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"No matching themes found.")
                                  (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Search built-in themes:")
                                  Bool -> InternalTheme -> Widget Name
renderInternalTheme
                                  (forall a. a -> Maybe a
Just forall {n}. Widget n
footer)
                                  WindowPosition
WindowUpperRight
                                  Int
50
        footer :: Widget n
footer = forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=>
                 (forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [ forall {n}. Widget n
enter
                                 , forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text
":choose theme  "
                                 , forall {n}. Widget n
close
                                 , forall n. Text -> Widget n
txt Text
":close"
                                 ])
        enter :: Widget n
enter = forall n. Widget n -> Widget n
emph forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Maybe Binding -> Text
ppMaybeBinding (forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
ActivateListItemEvent)
        close :: Widget n
close = forall n. Widget n -> Widget n
emph forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Maybe Binding -> Text
ppMaybeBinding (forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
CancelEvent)
        kc :: KeyConfig KeyEvent
kc = ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (KeyConfig KeyEvent)
configUserKeysL
        emph :: Widget n -> Widget n
emph = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr
    in forall n. Widget n -> Widget n
joinBorders Widget Name
window

renderInternalTheme :: Bool -> InternalTheme -> Widget Name
renderInternalTheme :: Bool -> InternalTheme -> Widget Name
renderInternalTheme Bool
foc InternalTheme
it =
    (if Bool
foc then forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
L.listSelectedFocusedAttr else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
    (forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$
     forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$
     forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ InternalTheme -> Text
internalThemeName InternalTheme
it) forall n. Widget n -> Widget n -> Widget n
<=>
    (forall n. Int -> Widget n -> Widget n
vLimit Int
2 forall a b. (a -> b) -> a -> b
$
     (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txtWrap forall a b. (a -> b) -> a -> b
$ InternalTheme -> Text
internalThemeDesc InternalTheme
it) forall n. Widget n -> Widget n -> Widget n
<=> forall n. Char -> Widget n
fill Char
' ')