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 ( (%=) ) import qualified Graphics.Vty as Vty import Matterhorn.Types import Matterhorn.State.Common ( postInfoMessage, fetchFileAtPath , doAsyncWith, AsyncPriority(Normal) , postErrorMessage' ) onEventSaveAttachmentWindow :: Vty.Event -> MH () onEventSaveAttachmentWindow :: Event -> MH () onEventSaveAttachmentWindow (Vty.EvKey (Vty.KChar Char '\t') []) = (TeamState -> Identity TeamState) -> ChatState -> Identity ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Identity TeamState) -> ChatState -> Identity ChatState) -> ((FocusRing Name -> Identity (FocusRing Name)) -> TeamState -> Identity TeamState) -> (FocusRing Name -> Identity (FocusRing Name)) -> ChatState -> Identity ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(SaveAttachmentDialogState -> Identity SaveAttachmentDialogState) -> TeamState -> Identity TeamState Lens' TeamState SaveAttachmentDialogState tsSaveAttachmentDialog((SaveAttachmentDialogState -> Identity SaveAttachmentDialogState) -> TeamState -> Identity TeamState) -> ((FocusRing Name -> Identity (FocusRing Name)) -> SaveAttachmentDialogState -> Identity SaveAttachmentDialogState) -> (FocusRing Name -> Identity (FocusRing Name)) -> TeamState -> Identity TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(FocusRing Name -> Identity (FocusRing Name)) -> SaveAttachmentDialogState -> Identity SaveAttachmentDialogState Lens' SaveAttachmentDialogState (FocusRing Name) 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 onEventSaveAttachmentWindow (Vty.EvKey Key Vty.KBackTab []) = (TeamState -> Identity TeamState) -> ChatState -> Identity ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Identity TeamState) -> ChatState -> Identity ChatState) -> ((FocusRing Name -> Identity (FocusRing Name)) -> TeamState -> Identity TeamState) -> (FocusRing Name -> Identity (FocusRing Name)) -> ChatState -> Identity ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(SaveAttachmentDialogState -> Identity SaveAttachmentDialogState) -> TeamState -> Identity TeamState Lens' TeamState SaveAttachmentDialogState tsSaveAttachmentDialog((SaveAttachmentDialogState -> Identity SaveAttachmentDialogState) -> TeamState -> Identity TeamState) -> ((FocusRing Name -> Identity (FocusRing Name)) -> SaveAttachmentDialogState -> Identity SaveAttachmentDialogState) -> (FocusRing Name -> Identity (FocusRing Name)) -> TeamState -> Identity TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(FocusRing Name -> Identity (FocusRing Name)) -> SaveAttachmentDialogState -> Identity SaveAttachmentDialogState Lens' SaveAttachmentDialogState (FocusRing Name) 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 onEventSaveAttachmentWindow (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 ((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) Session session <- MH Session getSession Mode mode <- Getting Mode ChatState Mode -> MH Mode forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use ((TeamState -> Const Mode TeamState) -> ChatState -> Const Mode ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Const Mode TeamState) -> ChatState -> Const Mode ChatState) -> ((Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState) -> Getting Mode ChatState Mode forall b c a. (b -> c) -> (a -> b) -> a -> c .(Mode -> Const Mode Mode) -> TeamState -> Const Mode TeamState Lens' TeamState Mode tsMode) let SaveAttachmentWindow LinkChoice link = Mode mode LinkFileId FileId fId = LinkChoice linkLinkChoice -> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget forall s a. s -> Getting a s a -> a ^.Getting LinkTarget LinkChoice LinkTarget Lens' LinkChoice LinkTarget linkTarget 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 ((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) let path :: String path = Text -> String T.unpack (Text -> String) -> Text -> String 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 $ String -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null String 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 -> String -> IO () fetchFileAtPath FileId fId Session session String 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 $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ String "Error saving to " String -> String -> String forall a. Semigroup a => a -> a -> a <> String path String -> String -> String forall a. Semigroup a => a -> a -> a <> String ": " String -> String -> String forall a. Semigroup a => a -> a -> a <> SomeException -> String forall a. Show a => a -> String show SomeException e Right () -> Text -> MH () postInfoMessage (Text -> MH ()) -> Text -> MH () forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ String "Attachment saved to " String -> String -> String forall a. Semigroup a => a -> a -> a <> String path Mode -> MH () setMode Mode UrlSelect 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 {}) -> Mode -> MH () setMode Mode UrlSelect Maybe Name _ -> Mode -> MH () setMode Mode UrlSelect onEventSaveAttachmentWindow (Vty.EvKey Key Vty.KEsc []) = do Mode -> MH () setMode Mode UrlSelect onEventSaveAttachmentWindow 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 ((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) case FocusRing Name -> Maybe Name forall n. FocusRing n -> Maybe n focusGetCurrent FocusRing Name f of Just (AttachmentPathEditor {}) -> 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 ((TeamState -> f TeamState) -> ChatState -> f ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState) -> ((Editor Text Name -> f (Editor Text Name)) -> TeamState -> f TeamState) -> (Editor Text Name -> f (Editor Text Name)) -> ChatState -> f ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(SaveAttachmentDialogState -> f SaveAttachmentDialogState) -> TeamState -> f TeamState Lens' TeamState SaveAttachmentDialogState tsSaveAttachmentDialog((SaveAttachmentDialogState -> f SaveAttachmentDialogState) -> TeamState -> f TeamState) -> ((Editor Text Name -> f (Editor Text Name)) -> SaveAttachmentDialogState -> f SaveAttachmentDialogState) -> (Editor Text Name -> f (Editor Text Name)) -> TeamState -> f TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(Editor Text Name -> f (Editor Text Name)) -> SaveAttachmentDialogState -> f SaveAttachmentDialogState Lens' SaveAttachmentDialogState (Editor Text Name) 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 Maybe Name _ -> () -> MH () forall (m :: * -> *) a. Monad m => a -> m a return ()