module Matterhorn.Draw.SaveAttachmentWindow
  ( drawSaveAttachmentWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Focus
import           Brick.Widgets.Border
import           Brick.Widgets.Center
import           Brick.Widgets.Edit

import qualified Data.Text as T

import           Matterhorn.Types
import           Matterhorn.Draw.Buttons
import           Matterhorn.Themes


drawSaveAttachmentWindow :: ChatState -> Widget Name
drawSaveAttachmentWindow :: ChatState -> Widget Name
drawSaveAttachmentWindow ChatState
st =
    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
hLimit Int
maxWindowWidth (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 (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
"Save Attachment") (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
vBox [ 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
$
           Text -> Widget Name
forall n. Text -> Widget n
txt Text
"Path: " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
           (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
editorHeight (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            FocusRing Name
-> (Bool -> Editor Text Name -> Widget Name)
-> Editor Text Name
-> Widget Name
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
foc (([Text] -> Widget Name) -> Bool -> Editor Text Name -> Widget Name
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor [Text] -> Widget Name
forall n. [Text] -> Widget n
drawEditorTxt) Editor Text Name
ed)
         , [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  FocusRing Name -> Name -> Text -> Widget Name
forall n. Eq n => FocusRing n -> n -> Text -> Widget n
drawButton FocusRing Name
foc (TeamId -> Name
AttachmentPathSaveButton TeamId
tId) Text
"Save"
                , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  FocusRing Name -> Name -> Text -> Widget Name
forall n. Eq n => FocusRing n -> n -> Text -> Widget n
drawButton FocusRing Name
foc (TeamId -> Name
AttachmentPathCancelButton TeamId
tId) Text
"Cancel"
                ]
         ]
    where
        tId :: TeamId
tId = ChatState
stChatState -> Getting TeamId ChatState TeamId -> TeamId
forall s a. s -> Getting a s a -> a
^.Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
        editorHeight :: Int
editorHeight = Int
1
        maxWindowWidth :: Int
maxWindowWidth = Int
50
        foc :: FocusRing Name
foc = ChatState
stChatState
-> Getting (FocusRing Name) ChatState (FocusRing Name)
-> FocusRing Name
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (FocusRing Name) TeamState)
-> ChatState -> Const (FocusRing Name) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (FocusRing Name) TeamState)
 -> ChatState -> Const (FocusRing Name) ChatState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> TeamState -> Const (FocusRing Name) TeamState)
-> Getting (FocusRing Name) ChatState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState
 -> Const (FocusRing Name) SaveAttachmentDialogState)
-> TeamState -> Const (FocusRing Name) TeamState
Lens' TeamState SaveAttachmentDialogState
tsSaveAttachmentDialog((SaveAttachmentDialogState
  -> Const (FocusRing Name) SaveAttachmentDialogState)
 -> TeamState -> Const (FocusRing Name) TeamState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> SaveAttachmentDialogState
    -> Const (FocusRing Name) SaveAttachmentDialogState)
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> TeamState
-> Const (FocusRing Name) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> SaveAttachmentDialogState
-> Const (FocusRing Name) SaveAttachmentDialogState
Lens' SaveAttachmentDialogState (FocusRing Name)
attachmentPathDialogFocus
        ed :: Editor Text Name
ed = ChatState
stChatState
-> Getting (Editor Text Name) ChatState (Editor Text Name)
-> Editor Text Name
forall s a. s -> Getting a s a -> a
^.(TeamState -> Const (Editor Text Name) TeamState)
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Editor Text Name) TeamState)
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> TeamState -> Const (Editor Text Name) TeamState)
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState
 -> Const (Editor Text Name) SaveAttachmentDialogState)
-> TeamState -> Const (Editor Text Name) TeamState
Lens' TeamState SaveAttachmentDialogState
tsSaveAttachmentDialog((SaveAttachmentDialogState
  -> Const (Editor Text Name) SaveAttachmentDialogState)
 -> TeamState -> Const (Editor Text Name) TeamState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> SaveAttachmentDialogState
    -> Const (Editor Text Name) SaveAttachmentDialogState)
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> TeamState
-> Const (Editor Text Name) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> SaveAttachmentDialogState
-> Const (Editor Text Name) SaveAttachmentDialogState
Lens' SaveAttachmentDialogState (Editor Text Name)
attachmentPathEditor
        drawEditorTxt :: [Text] -> Widget n
drawEditorTxt = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([Text] -> Text) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines