module Matterhorn.State.Attachments ( showAttachmentList , resetAttachmentList , showAttachmentFileBrowser ) where import Prelude () import Matterhorn.Prelude import qualified Control.Exception as E import Data.Either ( isRight ) import System.Directory ( doesDirectoryExist, getDirectoryContents ) import Data.Bool ( bool ) import Brick ( vScrollToBeginning, viewportScroll ) import qualified Brick.Widgets.List as L import qualified Brick.Widgets.FileBrowser as FB import Lens.Micro.Platform ( (.=) ) import Matterhorn.Types validateAttachmentPath :: FilePath -> IO (Maybe FilePath) validateAttachmentPath :: FilePath -> IO (Maybe FilePath) validateAttachmentPath FilePath path = Maybe FilePath -> Maybe FilePath -> Bool -> Maybe FilePath forall a. a -> a -> Bool -> a bool Maybe FilePath forall a. Maybe a Nothing (FilePath -> Maybe FilePath forall a. a -> Maybe a Just FilePath path) (Bool -> Maybe FilePath) -> IO Bool -> IO (Maybe FilePath) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> do Bool ex <- FilePath -> IO Bool doesDirectoryExist FilePath path case Bool ex of Bool False -> Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return Bool False Bool True -> do Either SomeException [FilePath] result :: Either E.SomeException [FilePath] <- IO [FilePath] -> IO (Either SomeException [FilePath]) forall e a. Exception e => IO a -> IO (Either e a) E.try (IO [FilePath] -> IO (Either SomeException [FilePath])) -> IO [FilePath] -> IO (Either SomeException [FilePath]) forall a b. (a -> b) -> a -> b $ FilePath -> IO [FilePath] getDirectoryContents FilePath path Bool -> IO Bool forall (m :: * -> *) a. Monad m => a -> m a return (Bool -> IO Bool) -> Bool -> IO Bool forall a b. (a -> b) -> a -> b $ Either SomeException [FilePath] -> Bool forall a b. Either a b -> Bool isRight Either SomeException [FilePath] result defaultAttachmentsPath :: Config -> IO (Maybe FilePath) defaultAttachmentsPath :: Config -> IO (Maybe FilePath) defaultAttachmentsPath = IO (Maybe FilePath) -> (FilePath -> IO (Maybe FilePath)) -> Maybe FilePath -> IO (Maybe FilePath) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Maybe FilePath -> IO (Maybe FilePath) forall (m :: * -> *) a. Monad m => a -> m a return Maybe FilePath forall a. Maybe a Nothing) FilePath -> IO (Maybe FilePath) validateAttachmentPath (Maybe FilePath -> IO (Maybe FilePath)) -> (Config -> Maybe FilePath) -> Config -> IO (Maybe FilePath) forall b c a. (b -> c) -> (a -> b) -> a -> c . Config -> Maybe FilePath configDefaultAttachmentPath showAttachmentList :: MH () showAttachmentList :: MH () showAttachmentList = do List Name AttachmentData lst <- Getting (List Name AttachmentData) ChatState (List Name AttachmentData) -> MH (List Name AttachmentData) forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use ((TeamState -> Const (List Name AttachmentData) TeamState) -> ChatState -> Const (List Name AttachmentData) ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Const (List Name AttachmentData) TeamState) -> ChatState -> Const (List Name AttachmentData) ChatState) -> ((List Name AttachmentData -> Const (List Name AttachmentData) (List Name AttachmentData)) -> TeamState -> Const (List Name AttachmentData) TeamState) -> Getting (List Name AttachmentData) ChatState (List Name AttachmentData) forall b c a. (b -> c) -> (a -> b) -> a -> c .(ChatEditState -> Const (List Name AttachmentData) ChatEditState) -> TeamState -> Const (List Name AttachmentData) TeamState Lens' TeamState ChatEditState tsEditState((ChatEditState -> Const (List Name AttachmentData) ChatEditState) -> TeamState -> Const (List Name AttachmentData) TeamState) -> ((List Name AttachmentData -> Const (List Name AttachmentData) (List Name AttachmentData)) -> ChatEditState -> Const (List Name AttachmentData) ChatEditState) -> (List Name AttachmentData -> Const (List Name AttachmentData) (List Name AttachmentData)) -> TeamState -> Const (List Name AttachmentData) TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(List Name AttachmentData -> Const (List Name AttachmentData) (List Name AttachmentData)) -> ChatEditState -> Const (List Name AttachmentData) ChatEditState Lens' ChatEditState (List Name AttachmentData) cedAttachmentList) case Vector AttachmentData -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length (List Name AttachmentData -> Vector AttachmentData forall n (t :: * -> *) e. GenericList n t e -> t e L.listElements List Name AttachmentData lst) of Int 0 -> MH () showAttachmentFileBrowser Int _ -> Mode -> MH () setMode Mode ManageAttachments resetAttachmentList :: MH () resetAttachmentList :: MH () resetAttachmentList = do TeamId tId <- Getting TeamId ChatState TeamId -> MH TeamId forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use Getting TeamId ChatState TeamId SimpleGetter ChatState TeamId csCurrentTeamId let listName :: Name listName = TeamId -> Name AttachmentList TeamId tId (TeamState -> Identity TeamState) -> ChatState -> Identity ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Identity TeamState) -> ChatState -> Identity ChatState) -> ((List Name AttachmentData -> Identity (List Name AttachmentData)) -> TeamState -> Identity TeamState) -> (List Name AttachmentData -> Identity (List Name AttachmentData)) -> ChatState -> Identity ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(ChatEditState -> Identity ChatEditState) -> TeamState -> Identity TeamState Lens' TeamState ChatEditState tsEditState((ChatEditState -> Identity ChatEditState) -> TeamState -> Identity TeamState) -> ((List Name AttachmentData -> Identity (List Name AttachmentData)) -> ChatEditState -> Identity ChatEditState) -> (List Name AttachmentData -> Identity (List Name AttachmentData)) -> TeamState -> Identity TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(List Name AttachmentData -> Identity (List Name AttachmentData)) -> ChatEditState -> Identity ChatEditState Lens' ChatEditState (List Name AttachmentData) cedAttachmentList ((List Name AttachmentData -> Identity (List Name AttachmentData)) -> ChatState -> Identity ChatState) -> List Name AttachmentData -> MH () forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> b -> m () .= Name -> Vector AttachmentData -> Int -> List Name AttachmentData forall (t :: * -> *) n e. Foldable t => n -> t e -> Int -> GenericList n t e L.list Name listName Vector AttachmentData forall a. Monoid a => a mempty Int 1 EventM Name () -> MH () forall a. EventM Name a -> MH a mh (EventM Name () -> MH ()) -> EventM Name () -> MH () forall a b. (a -> b) -> a -> b $ ViewportScroll Name -> EventM Name () forall n. ViewportScroll n -> EventM n () vScrollToBeginning (ViewportScroll Name -> EventM Name ()) -> ViewportScroll Name -> EventM Name () forall a b. (a -> b) -> a -> b $ Name -> ViewportScroll Name forall n. n -> ViewportScroll n viewportScroll Name listName showAttachmentFileBrowser :: MH () showAttachmentFileBrowser :: MH () showAttachmentFileBrowser = do Config config <- Getting Config ChatState Config -> MH Config forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use ((ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState Lens' ChatState ChatResources csResources((ChatResources -> Const Config ChatResources) -> ChatState -> Const Config ChatState) -> ((Config -> Const Config Config) -> ChatResources -> Const Config ChatResources) -> Getting Config ChatState Config forall b c a. (b -> c) -> (a -> b) -> a -> c .(Config -> Const Config Config) -> ChatResources -> Const Config ChatResources Lens' ChatResources Config crConfiguration) TeamId tId <- Getting TeamId ChatState TeamId -> MH TeamId forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a use Getting TeamId ChatState TeamId SimpleGetter ChatState TeamId csCurrentTeamId Maybe FilePath filePath <- IO (Maybe FilePath) -> MH (Maybe FilePath) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe FilePath) -> MH (Maybe FilePath)) -> IO (Maybe FilePath) -> MH (Maybe FilePath) forall a b. (a -> b) -> a -> b $ Config -> IO (Maybe FilePath) defaultAttachmentsPath Config config Maybe (FileBrowser Name) browser <- IO (Maybe (FileBrowser Name)) -> MH (Maybe (FileBrowser Name)) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Maybe (FileBrowser Name)) -> MH (Maybe (FileBrowser Name))) -> IO (Maybe (FileBrowser Name)) -> MH (Maybe (FileBrowser Name)) forall a b. (a -> b) -> a -> b $ FileBrowser Name -> Maybe (FileBrowser Name) forall a. a -> Maybe a Just (FileBrowser Name -> Maybe (FileBrowser Name)) -> IO (FileBrowser Name) -> IO (Maybe (FileBrowser Name)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (FileInfo -> Bool) -> Name -> Maybe FilePath -> IO (FileBrowser Name) forall n. (FileInfo -> Bool) -> n -> Maybe FilePath -> IO (FileBrowser n) FB.newFileBrowser FileInfo -> Bool FB.selectNonDirectories (TeamId -> Name AttachmentFileBrowser TeamId tId) Maybe FilePath filePath (TeamState -> Identity TeamState) -> ChatState -> Identity ChatState Lens' ChatState TeamState csCurrentTeam((TeamState -> Identity TeamState) -> ChatState -> Identity ChatState) -> ((Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name))) -> TeamState -> Identity TeamState) -> (Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name))) -> ChatState -> Identity ChatState forall b c a. (b -> c) -> (a -> b) -> a -> c .(ChatEditState -> Identity ChatEditState) -> TeamState -> Identity TeamState Lens' TeamState ChatEditState tsEditState((ChatEditState -> Identity ChatEditState) -> TeamState -> Identity TeamState) -> ((Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name))) -> ChatEditState -> Identity ChatEditState) -> (Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name))) -> TeamState -> Identity TeamState forall b c a. (b -> c) -> (a -> b) -> a -> c .(Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name))) -> ChatEditState -> Identity ChatEditState Lens' ChatEditState (Maybe (FileBrowser Name)) cedFileBrowser ((Maybe (FileBrowser Name) -> Identity (Maybe (FileBrowser Name))) -> ChatState -> Identity ChatState) -> Maybe (FileBrowser Name) -> MH () forall s (m :: * -> *) a b. MonadState s m => ASetter s s a b -> b -> m () .= Maybe (FileBrowser Name) browser Mode -> MH () setMode Mode ManageAttachmentsBrowseFiles