{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.SaveAttachmentWindow
  ( onEventSaveAttachmentWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Control.Exception as E

import           Brick.Focus
import           Brick.Widgets.Edit ( handleEditorEvent, getEditContents )
import qualified Data.Text as T
import           Lens.Micro.Platform ( (%=), Lens' )
import qualified Graphics.Vty as Vty

import           Matterhorn.Types
import           Matterhorn.State.SaveAttachmentWindow
import           Matterhorn.State.Common ( postInfoMessage, fetchFileAtPath
                                         , doAsyncWith, AsyncPriority(Normal)
                                         , postErrorMessage'
                                         )


onEventSaveAttachmentWindow :: Lens' ChatState (MessageInterface Name i) -> Vty.Event -> MH Bool
onEventSaveAttachmentWindow :: Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey (Vty.KChar Char
'\t') []) = do
    (MessageInterface Name i -> Identity (MessageInterface Name i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> Identity (MessageInterface Name i))
 -> ChatState -> Identity ChatState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> MessageInterface Name i -> Identity (MessageInterface Name i))
-> (FocusRing Name -> Identity (FocusRing Name))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Identity (SaveAttachmentDialogState Name))
-> MessageInterface Name i -> Identity (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Identity (SaveAttachmentDialogState Name))
 -> MessageInterface Name i -> Identity (MessageInterface Name i))
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> SaveAttachmentDialogState Name
    -> Identity (SaveAttachmentDialogState Name))
-> (FocusRing Name -> Identity (FocusRing Name))
-> MessageInterface Name i
-> Identity (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FocusRing Name -> Identity (FocusRing Name))
-> SaveAttachmentDialogState Name
-> Identity (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus ((FocusRing Name -> Identity (FocusRing Name))
 -> ChatState -> Identity ChatState)
-> (FocusRing Name -> FocusRing Name) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusNext
    Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey Key
Vty.KBackTab []) = do
    (MessageInterface Name i -> Identity (MessageInterface Name i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> Identity (MessageInterface Name i))
 -> ChatState -> Identity ChatState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> MessageInterface Name i -> Identity (MessageInterface Name i))
-> (FocusRing Name -> Identity (FocusRing Name))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Identity (SaveAttachmentDialogState Name))
-> MessageInterface Name i -> Identity (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Identity (SaveAttachmentDialogState Name))
 -> MessageInterface Name i -> Identity (MessageInterface Name i))
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> SaveAttachmentDialogState Name
    -> Identity (SaveAttachmentDialogState Name))
-> (FocusRing Name -> Identity (FocusRing Name))
-> MessageInterface Name i
-> Identity (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FocusRing Name -> Identity (FocusRing Name))
-> SaveAttachmentDialogState Name
-> Identity (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus ((FocusRing Name -> Identity (FocusRing Name))
 -> ChatState -> Identity ChatState)
-> (FocusRing Name -> FocusRing Name) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= FocusRing Name -> FocusRing Name
forall n. FocusRing n -> FocusRing n
focusPrev
    Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey Key
Vty.KEnter []) = do
    FocusRing Name
f <- Getting (FocusRing Name) ChatState (FocusRing Name)
-> MH (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface Name i
 -> Const (FocusRing Name) (MessageInterface Name i))
-> ChatState -> Const (FocusRing Name) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (FocusRing Name) (MessageInterface Name i))
 -> ChatState -> Const (FocusRing Name) ChatState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> MessageInterface Name i
    -> Const (FocusRing Name) (MessageInterface Name i))
-> Getting (FocusRing Name) ChatState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
-> MessageInterface Name i
-> Const (FocusRing Name) (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
 -> MessageInterface Name i
 -> Const (FocusRing Name) (MessageInterface Name i))
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> SaveAttachmentDialogState Name
    -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> MessageInterface Name i
-> Const (FocusRing Name) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> SaveAttachmentDialogState Name
-> Const (FocusRing Name) (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus)
    Session
session <- MH Session
getSession
    MessageInterfaceMode
mode <- Getting MessageInterfaceMode ChatState MessageInterfaceMode
-> MH MessageInterfaceMode
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface Name i
 -> Const MessageInterfaceMode (MessageInterface Name i))
-> ChatState -> Const MessageInterfaceMode ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const MessageInterfaceMode (MessageInterface Name i))
 -> ChatState -> Const MessageInterfaceMode ChatState)
-> ((MessageInterfaceMode
     -> Const MessageInterfaceMode MessageInterfaceMode)
    -> MessageInterface Name i
    -> Const MessageInterfaceMode (MessageInterface Name i))
-> Getting MessageInterfaceMode ChatState MessageInterfaceMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode
 -> Const MessageInterfaceMode MessageInterfaceMode)
-> MessageInterface Name i
-> Const MessageInterfaceMode (MessageInterface Name i)
forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode)

    let link :: LinkChoice
link = case MessageInterfaceMode
mode of
            SaveAttachment LinkChoice
l -> LinkChoice
l
            MessageInterfaceMode
_ -> [Char] -> LinkChoice
forall a. HasCallStack => [Char] -> a
error ([Char] -> LinkChoice) -> [Char] -> LinkChoice
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: invalid mode " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> MessageInterfaceMode -> [Char]
forall a. Show a => a -> [Char]
show MessageInterfaceMode
mode [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" in onEventSaveAttachmentWindow"
        fId :: FileId
fId = case LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget of
            LinkFileId FileId
i -> FileId
i
            LinkTarget
_ -> [Char] -> FileId
forall a. HasCallStack => [Char] -> a
error ([Char] -> FileId) -> [Char] -> FileId
forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: invalid link target " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> LinkTarget -> [Char]
forall a. Show a => a -> [Char]
show (LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" in onEventSaveAttachmentWindow"
        save :: MH ()
save = do
            Editor Text Name
ed <- Getting (Editor Text Name) ChatState (Editor Text Name)
-> MH (Editor Text Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface Name i
 -> Const (Editor Text Name) (MessageInterface Name i))
-> ChatState -> Const (Editor Text Name) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (Editor Text Name) (MessageInterface Name i))
 -> ChatState -> Const (Editor Text Name) ChatState)
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> MessageInterface Name i
    -> Const (Editor Text Name) (MessageInterface Name i))
-> Getting (Editor Text Name) ChatState (Editor Text Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Const (Editor Text Name) (SaveAttachmentDialogState Name))
-> MessageInterface Name i
-> Const (Editor Text Name) (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Const (Editor Text Name) (SaveAttachmentDialogState Name))
 -> MessageInterface Name i
 -> Const (Editor Text Name) (MessageInterface Name i))
-> ((Editor Text Name
     -> Const (Editor Text Name) (Editor Text Name))
    -> SaveAttachmentDialogState Name
    -> Const (Editor Text Name) (SaveAttachmentDialogState Name))
-> (Editor Text Name
    -> Const (Editor Text Name) (Editor Text Name))
-> MessageInterface Name i
-> Const (Editor Text Name) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> Const (Editor Text Name) (Editor Text Name))
-> SaveAttachmentDialogState Name
-> Const (Editor Text Name) (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n)
attachmentPathEditor)
            let path :: [Char]
path = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Editor Text Name -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
ed

            Bool -> MH () -> MH ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
path) (MH () -> MH ()) -> MH () -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                    Either SomeException ()
result <- IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try (IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ FileId -> Session -> [Char] -> IO ()
fetchFileAtPath FileId
fId Session
session [Char]
path
                    Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                        case Either SomeException ()
result of
                            Left (SomeException
e::E.SomeException) ->
                                Text -> MH ()
postErrorMessage' (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Error saving to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
                            Right () ->
                                Text -> MH ()
postInfoMessage (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"Attachment saved to " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
path
                Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which

    case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
f of
        Just (AttachmentPathSaveButton {})   -> MH ()
save
        Just (AttachmentPathEditor {})       -> MH ()
save
        Just (AttachmentPathCancelButton {}) -> Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which
        Maybe Name
_                                    -> Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which

    Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey Key
Vty.KEsc []) = do
    Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which
    Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which Event
e = do
    FocusRing Name
f <- Getting (FocusRing Name) ChatState (FocusRing Name)
-> MH (FocusRing Name)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface Name i
 -> Const (FocusRing Name) (MessageInterface Name i))
-> ChatState -> Const (FocusRing Name) ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i
  -> Const (FocusRing Name) (MessageInterface Name i))
 -> ChatState -> Const (FocusRing Name) ChatState)
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> MessageInterface Name i
    -> Const (FocusRing Name) (MessageInterface Name i))
-> Getting (FocusRing Name) ChatState (FocusRing Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
-> MessageInterface Name i
-> Const (FocusRing Name) (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
 -> MessageInterface Name i
 -> Const (FocusRing Name) (MessageInterface Name i))
-> ((FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
    -> SaveAttachmentDialogState Name
    -> Const (FocusRing Name) (SaveAttachmentDialogState Name))
-> (FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> MessageInterface Name i
-> Const (FocusRing Name) (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(FocusRing Name -> Const (FocusRing Name) (FocusRing Name))
-> SaveAttachmentDialogState Name
-> Const (FocusRing Name) (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus)
    case FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
f of
        Just (AttachmentPathEditor {}) -> do
            Lens' ChatState (Editor Text Name)
-> (Event -> Editor Text Name -> EventM Name (Editor Text Name))
-> Event
-> MH ()
forall b e.
Lens' ChatState b -> (e -> b -> EventM Name b) -> e -> MH ()
mhHandleEventLensed ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((Editor Text Name -> f (Editor Text Name))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (Editor Text Name -> f (Editor Text Name))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState Name
 -> f (SaveAttachmentDialogState Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog((SaveAttachmentDialogState Name
  -> f (SaveAttachmentDialogState Name))
 -> MessageInterface Name i -> f (MessageInterface Name i))
-> ((Editor Text Name -> f (Editor Text Name))
    -> SaveAttachmentDialogState Name
    -> f (SaveAttachmentDialogState Name))
-> (Editor Text Name -> f (Editor Text Name))
-> MessageInterface Name i
-> f (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Editor Text Name -> f (Editor Text Name))
-> SaveAttachmentDialogState Name
-> f (SaveAttachmentDialogState Name)
forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n)
attachmentPathEditor)
                                Event -> Editor Text Name -> EventM Name (Editor Text Name)
forall t n.
(DecodeUtf8 t, Eq t, GenericTextZipper t) =>
Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent Event
e
            Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe Name
_ ->
            Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False