{-# LANGUAGE RankNTypes #-} module Matterhorn.Events.SaveAttachmentWindow ( onEventSaveAttachmentWindow ) where import Prelude () import Matterhorn.Prelude import qualified Control.Exception as E import Brick ( BrickEvent(VtyEvent) ) 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 :: forall i. Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which (Vty.EvKey (Vty.KChar Char '\t') []) = do Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) (SaveAttachmentDialogState n) miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n) attachmentPathDialogFocus forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> (a -> b) -> m () %= forall n. FocusRing n -> FocusRing n focusNext forall (m :: * -> *) a. Monad m => a -> m a return Bool True onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which (Vty.EvKey Key Vty.KBackTab []) = do Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) (SaveAttachmentDialogState n) miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n) attachmentPathDialogFocus forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> (a -> b) -> m () %= forall n. FocusRing n -> FocusRing n focusPrev 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 <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) (SaveAttachmentDialogState n) miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n) attachmentPathDialogFocus) Session session <- MH Session getSession MessageInterfaceMode mode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) MessageInterfaceMode miMode) let link :: LinkChoice link = case MessageInterfaceMode mode of SaveAttachment LinkChoice l -> LinkChoice l MessageInterfaceMode _ -> forall a. HasCallStack => [Char] -> a error forall a b. (a -> b) -> a -> b $ [Char] "BUG: invalid mode " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> [Char] show MessageInterfaceMode mode forall a. Semigroup a => a -> a -> a <> [Char] " in onEventSaveAttachmentWindow" fId :: FileId fId = case LinkChoice linkforall s a. s -> Getting a s a -> a ^.Lens' LinkChoice LinkTarget linkTarget of LinkFileId FileId i -> FileId i LinkTarget _ -> forall a. HasCallStack => [Char] -> a error forall a b. (a -> b) -> a -> b $ [Char] "BUG: invalid link target " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> [Char] show (LinkChoice linkforall s a. s -> Getting a s a -> a ^.Lens' LinkChoice LinkTarget linkTarget) forall a. Semigroup a => a -> a -> a <> [Char] " in onEventSaveAttachmentWindow" save :: MH () save = do Editor Text Name ed <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) (SaveAttachmentDialogState n) miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n) attachmentPathEditor) let path :: [Char] path = Text -> [Char] T.unpack forall a b. (a -> b) -> a -> b $ Text -> Text T.strip forall a b. (a -> b) -> a -> b $ [Text] -> Text T.concat forall a b. (a -> b) -> a -> b $ forall t n. Monoid t => Editor t n -> [t] getEditContents Editor Text Name ed forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Bool -> Bool not forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> Bool null [Char] path) forall a b. (a -> b) -> a -> b $ do AsyncPriority -> IO (Maybe (MH ())) -> MH () doAsyncWith AsyncPriority Normal forall a b. (a -> b) -> a -> b $ do Either SomeException () result <- forall e a. Exception e => IO a -> IO (Either e a) E.try forall a b. (a -> b) -> a -> b $ FileId -> Session -> [Char] -> IO () fetchFileAtPath FileId fId Session session [Char] path forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ do case Either SomeException () result of Left (SomeException e::E.SomeException) -> Text -> MH () postErrorMessage' forall a b. (a -> b) -> a -> b $ [Char] -> Text T.pack forall a b. (a -> b) -> a -> b $ [Char] "Error saving to " forall a. Semigroup a => a -> a -> a <> [Char] path forall a. Semigroup a => a -> a -> a <> [Char] ": " forall a. Semigroup a => a -> a -> a <> forall a. Show a => a -> [Char] show SomeException e Right () -> Text -> MH () postInfoMessage forall a b. (a -> b) -> a -> b $ [Char] -> Text T.pack forall a b. (a -> b) -> a -> b $ [Char] "Attachment saved to " forall a. Semigroup a => a -> a -> a <> [Char] path forall n i. Lens' ChatState (MessageInterface n i) -> MH () closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which case forall n. FocusRing n -> Maybe n focusGetCurrent FocusRing Name f of Just (AttachmentPathSaveButton {}) -> MH () save Just (AttachmentPathEditor {}) -> MH () save Just (AttachmentPathCancelButton {}) -> forall n i. Lens' ChatState (MessageInterface n i) -> MH () closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which Maybe Name _ -> forall n i. Lens' ChatState (MessageInterface n i) -> MH () closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which forall (m :: * -> *) a. Monad m => a -> m a return Bool True onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which (Vty.EvKey Key Vty.KEsc []) = do forall n i. Lens' ChatState (MessageInterface n i) -> MH () closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which forall (m :: * -> *) a. Monad m => a -> m a return Bool True onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i) which Event e = do FocusRing Name f <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use (Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) (SaveAttachmentDialogState n) miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n) attachmentPathDialogFocus) case forall n. FocusRing n -> Maybe n focusGetCurrent FocusRing Name f of Just (AttachmentPathEditor {}) -> do forall b e. Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH () mhZoom (Lens' ChatState (MessageInterface Name i) whichforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n i. Lens' (MessageInterface n i) (SaveAttachmentDialogState n) miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c .forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n) attachmentPathEditor) forall n t e. (Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) => BrickEvent n e -> EventM n (Editor t n) () handleEditorEvent (forall n e. Event -> BrickEvent n e VtyEvent Event e) forall (m :: * -> *) a. Monad m => a -> m a return Bool True Maybe Name _ -> forall (m :: * -> *) a. Monad m => a -> m a return Bool False