{-# 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