{-# LANGUAGE LambdaCase #-} module Matterhorn.State.Attachments ( showAttachmentList , resetAttachmentList , showAttachmentFileBrowser , attachFileByPath , tryAddAttachment , tryReadAttachment ) where import Prelude () import Matterhorn.Prelude import Brick ( vScrollToBeginning, viewportScroll ) import qualified Brick.Widgets.List as L import qualified Brick.Widgets.FileBrowser as FB import qualified Control.Exception as E import Data.Bool ( bool ) import qualified Data.ByteString as BS import Data.Either ( isRight ) import Data.Text ( unpack ) import qualified Data.Vector as Vector import GHC.Exception ( toException ) import Lens.Micro.Platform ( (.=), (%=) ) import System.Directory ( doesDirectoryExist, doesFileExist, getDirectoryContents ) import Network.Mattermost.Types ( TeamId ) import Matterhorn.Types validateAttachmentPath :: FilePath -> IO (Maybe FilePath) validateAttachmentPath path = bool Nothing (Just path) <$> do ex <- doesDirectoryExist path case ex of False -> return False True -> do result :: Either E.SomeException [FilePath] <- E.try $ getDirectoryContents path return $ isRight result defaultAttachmentsPath :: Config -> IO (Maybe FilePath) defaultAttachmentsPath = maybe (return Nothing) validateAttachmentPath . configDefaultAttachmentPath showAttachmentList :: TeamId -> MH () showAttachmentList tId = do lst <- use (csTeam(tId).tsEditState.cedAttachmentList) case length (L.listElements lst) of 0 -> showAttachmentFileBrowser tId _ -> setMode tId ManageAttachments resetAttachmentList :: TeamId -> MH () resetAttachmentList tId = do let listName = AttachmentList tId csTeam(tId).tsEditState.cedAttachmentList .= L.list listName mempty 1 mh $ vScrollToBeginning $ viewportScroll listName showAttachmentFileBrowser :: TeamId -> MH () showAttachmentFileBrowser tId = do config <- use (csResources.crConfiguration) filePath <- liftIO $ defaultAttachmentsPath config browser <- liftIO $ Just <$> FB.newFileBrowser FB.selectNonDirectories (AttachmentFileBrowser tId) filePath csTeam(tId).tsEditState.cedFileBrowser .= browser setMode tId ManageAttachmentsBrowseFiles attachFileByPath :: TeamId -> Text -> MH () attachFileByPath tId txtPath = do let strPath = unpack txtPath fileInfo <- liftIO $ FB.getFileInfo strPath strPath case FB.fileInfoFileStatus fileInfo of Left e -> do mhError $ AttachmentException (toException e) Right _ -> tryAddAttachment tId [fileInfo] checkPathIsFile :: FB.FileInfo -> MH Bool checkPathIsFile = liftIO . doesFileExist . FB.fileInfoFilePath tryAddAttachment :: TeamId -> [FB.FileInfo] -> MH () tryAddAttachment tId entries = do forM_ entries $ \entry -> do isFile <- checkPathIsFile entry if not isFile then mhError (BadAttachmentPath "Error attaching file. It either doesn't exist or is a directory, which is not supported.") else do -- Is the entry already present? If so, ignore the selection. es <- use (csTeam(tId).tsEditState.cedAttachmentList.L.listElementsL) let matches = (== FB.fileInfoFilePath entry) . FB.fileInfoFilePath . attachmentDataFileInfo case Vector.find matches es of Just _ -> return () Nothing -> do tryReadAttachment entry >>= \case Right a -> do oldIdx <- use (csTeam(tId).tsEditState.cedAttachmentList.L.listSelectedL) let newIdx = if Vector.null es then Just 0 else oldIdx csTeam(tId).tsEditState.cedAttachmentList %= L.listReplace (Vector.snoc es a) newIdx Left e -> mhError $ AttachmentException e when (not $ null entries) $ setMode tId Main tryReadAttachment :: FB.FileInfo -> MH (Either E.SomeException AttachmentData) tryReadAttachment fi = do let path = FB.fileInfoFilePath fi readResult <- liftIO $ E.try $ BS.readFile path case readResult of Right bytes -> do return $ Right $ AttachmentData { attachmentDataFileInfo = fi , attachmentDataBytes = bytes } Left e -> return $ Left e