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