{-# LANGUAGE OverloadedStrings #-}
module Matterhorn.Draw.DeleteChannelConfirm
    ( drawDeleteChannelConfirm
    )
where

import Prelude ()
import Matterhorn.Prelude

import Network.Mattermost.Types ( TeamId )

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center

import Matterhorn.Themes
import Matterhorn.Types


drawDeleteChannelConfirm :: ChatState -> TeamId -> Widget Name
drawDeleteChannelConfirm :: ChatState -> TeamId -> Widget Name
drawDeleteChannelConfirm ChatState
st TeamId
tId =
    case ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId) of
        Maybe ChannelId
Nothing -> forall n. Widget n
emptyWidget
        Just ChannelId
cId ->
            case ChatState
stforall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ClientChannel
csChannel(ChannelId
cId) of
                Maybe ClientChannel
Nothing -> forall n. Widget n
emptyWidget
                Just ClientChannel
chan ->
                    let cName :: Text
cName = ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdName
                    in forall n. Widget n -> Widget n
centerLayer forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
hLimit Int
50 forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
15 forall a b. (a -> b) -> a -> b
$
                       forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dialogAttr forall a b. (a -> b) -> a -> b
$
                       forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Text -> Widget n
txt Text
"Confirm Delete Channel") forall a b. (a -> b) -> a -> b
$
                       forall n. [Widget n] -> Widget n
vBox [ forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Are you sure you want to delete this channel?"
                            , forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dialogEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
cName
                            , forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Press " forall n. Widget n -> Widget n -> Widget n
<+> (forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
dialogEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"Y") forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
" to delete the channel"
                            , forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt Text
"or any other key to cancel."
                            ]