{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module Matterhorn.Events.ManageAttachments ( onEventManageAttachments , attachmentListKeybindings , attachmentBrowseKeyHandlers , attachmentBrowseKeybindings , attachmentListKeyHandlers ) where import Prelude () import Matterhorn.Prelude import qualified Brick.Widgets.FileBrowser as FB import qualified Brick.Widgets.List as L import qualified Data.Text as T import qualified Data.Vector as Vector import qualified Graphics.Vty as V import Lens.Micro.Platform ( (?=), (%=), to ) import Network.Mattermost.Types ( TeamId ) import Matterhorn.Types import Matterhorn.Types.KeyEvents import Matterhorn.Events.Keybindings import Matterhorn.State.Attachments import Matterhorn.State.Common onEventManageAttachments :: TeamId -> V.Event -> MH () onEventManageAttachments tId e = do mode <- use (csTeam(tId).tsMode) case mode of ManageAttachments -> void $ onEventAttachmentList tId e ManageAttachmentsBrowseFiles -> onEventBrowseFile tId e _ -> error "BUG: onEventManageAttachments called in invalid mode" onEventAttachmentList :: TeamId -> V.Event -> MH Bool onEventAttachmentList tId = handleKeyboardEvent (attachmentListKeybindings tId) $ mhHandleEventLensed (csTeam(tId).tsEditState.cedAttachmentList) L.handleListEvent attachmentListKeybindings :: TeamId -> KeyConfig -> KeyHandlerMap attachmentListKeybindings tId = mkKeybindings (attachmentListKeyHandlers tId) attachmentListKeyHandlers :: TeamId -> [KeyEventHandler] attachmentListKeyHandlers tId = [ mkKb CancelEvent "Close attachment list" $ setMode tId Main , mkKb SelectUpEvent "Move cursor up" $ mhHandleEventLensed (csTeam(tId).tsEditState.cedAttachmentList) L.handleListEvent (V.EvKey V.KUp []) , mkKb SelectDownEvent "Move cursor down" $ mhHandleEventLensed (csTeam(tId).tsEditState.cedAttachmentList) L.handleListEvent (V.EvKey V.KDown []) , mkKb AttachmentListAddEvent "Add a new attachment to the attachment list" $ showAttachmentFileBrowser tId , mkKb AttachmentOpenEvent "Open the selected attachment using the URL open command" $ openSelectedAttachment tId , mkKb AttachmentListDeleteEvent "Delete the selected attachment from the attachment list" $ deleteSelectedAttachment tId ] attachmentBrowseKeybindings :: TeamId -> KeyConfig -> KeyHandlerMap attachmentBrowseKeybindings tId = mkKeybindings (attachmentBrowseKeyHandlers tId) attachmentBrowseKeyHandlers :: TeamId -> [KeyEventHandler] attachmentBrowseKeyHandlers tId = [ mkKb CancelEvent "Cancel attachment file browse" $ cancelAttachmentBrowse tId , mkKb AttachmentOpenEvent "Open the selected file using the URL open command" $ openSelectedBrowserEntry tId , mkKb FileBrowserBeginSearchEvent "Begin search for name in list" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserBeginSearch , mkKb FileBrowserSelectEnterEvent "Select file or enter directory" $ do mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserSelectEnter withFileBrowser tId (tryAddAttachment tId . FB.fileBrowserSelection) , mkKb FileBrowserSelectCurrentEvent "Select file" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserSelectCurrent , mkKb FileBrowserListPageUpEvent "Move cursor one page up" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListPageUp , mkKb FileBrowserListPageDownEvent "Move cursor one page down" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListPageDown , mkKb FileBrowserListHalfPageUpEvent "Move cursor one-half page up" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListHalfPageUp , mkKb FileBrowserListHalfPageDownEvent "Move cursor one-half page down" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListHalfPageDown , mkKb FileBrowserListTopEvent "Move cursor to top of list" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListTop , mkKb FileBrowserListBottomEvent "Move cursor to bottom of list" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListBottom , mkKb FileBrowserListNextEvent "Move cursor down" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListNext , mkKb FileBrowserListPrevEvent "Move cursor up" $ mhHandleEventLensed' (csTeam(tId).tsEditState.unsafeCedFileBrowser) FB.actionFileBrowserListPrev ] withFileBrowser :: TeamId -> ((FB.FileBrowser Name) -> MH ()) -> MH () withFileBrowser tId f = do use (csTeam(tId).tsEditState.cedFileBrowser) >>= \case Nothing -> do -- The widget has not been created yet. This should -- normally not occur, because the ManageAttachments -- events should not fire when there is no FileBrowser -- Widget active to cause Brick to generate these events. -- This could therefore be implemented as an `error "BUG: -- ..."` handler, but the more benign approach is to -- simply create an available FileBrowser at this stage. new_b <- liftIO $ FB.newFileBrowser FB.selectNonDirectories (AttachmentFileBrowser tId) Nothing csTeam(tId).tsEditState.cedFileBrowser ?= new_b f new_b Just b -> f b openSelectedAttachment :: TeamId -> MH () openSelectedAttachment tId = do cur <- use (csTeam(tId).tsEditState.cedAttachmentList.to L.listSelectedElement) case cur of Nothing -> return () Just (_, entry) -> void $ openFilePath (FB.fileInfoFilePath $ attachmentDataFileInfo entry) openSelectedBrowserEntry :: TeamId -> MH () openSelectedBrowserEntry tId = withFileBrowser tId $ \b -> case FB.fileBrowserCursor b of Nothing -> return () Just entry -> void $ openFilePath (FB.fileInfoFilePath entry) onEventBrowseFile :: TeamId -> V.Event -> MH () onEventBrowseFile tId e = do withFileBrowser tId $ \b -> do case FB.fileBrowserIsSearching b of False -> void $ handleKeyboardEvent (attachmentBrowseKeybindings tId) (handleFileBrowserEvent tId) e True -> handleFileBrowserEvent tId e -- n.b. the FileBrowser may have been updated above, so re-acquire it withFileBrowser tId $ \b -> do case FB.fileBrowserException b of Nothing -> return () Just ex -> do mhLog LogError $ T.pack $ "FileBrowser exception: " <> show ex cancelAttachmentBrowse :: TeamId -> MH () cancelAttachmentBrowse tId = do es <- use (csTeam(tId).tsEditState.cedAttachmentList.L.listElementsL) case length es of 0 -> setMode tId Main _ -> setMode tId ManageAttachments handleFileBrowserEvent :: TeamId -> V.Event -> MH () handleFileBrowserEvent tId e = do let fbHandle ev = sequence . (fmap (FB.handleFileBrowserEvent ev)) mhHandleEventLensed (csTeam(tId).tsEditState.cedFileBrowser) fbHandle e -- TODO: Check file browser exception state withFileBrowser tId $ \b -> tryAddAttachment tId $ FB.fileBrowserSelection b deleteSelectedAttachment :: TeamId -> MH () deleteSelectedAttachment tId = do es <- use (csTeam(tId).tsEditState.cedAttachmentList.L.listElementsL) mSel <- use (csTeam(tId).tsEditState.cedAttachmentList.to L.listSelectedElement) case mSel of Nothing -> return () Just (pos, _) -> do oldIdx <- use (csTeam(tId).tsEditState.cedAttachmentList.L.listSelectedL) let idx = if Vector.length es == 1 then Nothing else case oldIdx of Nothing -> Just 0 Just old -> if pos >= old then Just $ pos - 1 else Just pos csTeam(tId).tsEditState.cedAttachmentList %= L.listReplace (deleteAt pos es) idx deleteAt :: Int -> Vector.Vector a -> Vector.Vector a deleteAt p as | p < 0 || p >= length as = as | otherwise = Vector.take p as <> Vector.drop (p + 1) as