module Matterhorn.Draw.NotifyPrefs
  ( drawNotifyPrefs
  )
where

import Prelude ()
import Matterhorn.Prelude

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Forms (renderForm)
import Data.List (intersperse)
import Data.Maybe (fromJust)

import Network.Mattermost.Types ( TeamId )

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

drawNotifyPrefs :: ChatState -> TeamId -> Widget Name
drawNotifyPrefs :: ChatState -> TeamId -> Widget Name
drawNotifyPrefs ChatState
st TeamId
tId =
    let form :: Form ChannelNotifyProps MHEvent Name
form = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ 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 (Maybe (Form ChannelNotifyProps MHEvent Name))
tsNotifyPrefs
        label :: Widget n
label = forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Notification Preferences"
        formKeys :: [Widget n]
formKeys = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. Text -> Widget n
txt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text
"Tab", Text
"BackTab"]
        bindings :: Widget Name
bindings = forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp ChatState
st Text
"Save" [KeyEvent
FormSubmitEvent] forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
"  " forall n. Widget n -> Widget n -> Widget n
<+>
                                        ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp ChatState
st Text
"Cancel" [KeyEvent
CancelEvent]
                                      , forall n. [Widget n] -> Widget n
hBox ((forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
"/") forall {n}. [Widget n]
formKeys) forall a. Semigroup a => a -> a -> a
<> [forall n. Text -> Widget n
txt (Text
":Cycle form fields")])
                                      , forall n. [Widget n] -> Widget n
hBox [forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Space", forall n. Text -> Widget n
txt Text
":Toggle form field"]
                                      ]
    in forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$
       forall n. Int -> Widget n -> Widget n
vLimit Int
25 forall a b. (a -> b) -> a -> b
$
       forall n. Int -> Widget n -> Widget n
hLimit Int
39 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 forall {n}. Widget n
label forall a b. (a -> b) -> a -> b
$
       (forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$ forall n s e. Eq n => Form s e n -> Widget n
renderForm Form ChannelNotifyProps MHEvent Name
form) forall n. Widget n -> Widget n -> Widget n
<=> forall {n}. Widget n
hBorder forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
bindings