{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.Attachments
  ( showAttachmentList
  , showAttachmentFileBrowser
  , attachFileByPath
  , tryAddAttachment
  , tryReadAttachment
  )
where

import           Prelude ()
import           Matterhorn.Prelude

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 ( (.=), (%=), Lens' )
import           System.Directory ( doesDirectoryExist, doesFileExist, getDirectoryContents )

import           Matterhorn.Types

validateAttachmentPath :: FilePath -> IO (Maybe FilePath)
validateAttachmentPath :: FilePath -> IO (Maybe FilePath)
validateAttachmentPath FilePath
path = forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just FilePath
path) 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Bool
True -> do
            Either SomeException [FilePath]
result :: Either E.SomeException [FilePath]
                   <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Either a b -> Bool
isRight Either SomeException [FilePath]
result

defaultAttachmentsPath :: Config -> IO (Maybe FilePath)
defaultAttachmentsPath :: Config -> IO (Maybe FilePath)
defaultAttachmentsPath = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) FilePath -> IO (Maybe FilePath)
validateAttachmentPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Maybe FilePath
configDefaultAttachmentPath

showAttachmentList :: Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentList :: forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentList Lens' ChatState (MessageInterface Name i)
which = do
    List Name AttachmentData
lst <- 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) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentList)
    case forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall n (t :: * -> *) e. GenericList n t e -> t e
L.listElements List Name AttachmentData
lst) of
        Int
0 -> forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentFileBrowser Lens' ChatState (MessageInterface Name i)
which
        Int
_ -> Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
ManageAttachments

showAttachmentFileBrowser :: Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentFileBrowser :: forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
showAttachmentFileBrowser Lens' ChatState (MessageInterface Name i)
which = do
    ChannelId
cId <- 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) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) ChannelId
esChannelId)
    Config
config <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfiguration)
    Maybe FilePath
filePath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Config -> IO (Maybe FilePath)
defaultAttachmentsPath Config
config
    Maybe (FileBrowser Name)
browser <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n.
(FileInfo -> Bool) -> n -> Maybe FilePath -> IO (FileBrowser n)
FB.newFileBrowser FileInfo -> Bool
FB.selectNonDirectories (ChannelId -> Name
AttachmentFileBrowser ChannelId
cId) Maybe FilePath
filePath
    Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (Maybe (FileBrowser n))
esFileBrowser forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (FileBrowser Name)
browser
    Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
BrowseFiles

attachFileByPath :: Lens' ChatState (MessageInterface Name i) -> Text -> MH ()
attachFileByPath :: forall i.
Lens' ChatState (MessageInterface Name i) -> Text -> MH ()
attachFileByPath Lens' ChatState (MessageInterface Name i)
which Text
txtPath = do
    let strPath :: FilePath
strPath = Text -> FilePath
unpack Text
txtPath
    FileInfo
fileInfo <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO FileInfo
FB.getFileInfo FilePath
strPath FilePath
strPath
    case FileInfo -> Either IOException FileStatus
FB.fileInfoFileStatus FileInfo
fileInfo of
        Left IOException
e -> do
            MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ SomeException -> MHError
AttachmentException (forall e. Exception e => e -> SomeException
toException IOException
e)
        Right FileStatus
_ -> forall i.
Lens' ChatState (MessageInterface Name i) -> [FileInfo] -> MH ()
tryAddAttachment Lens' ChatState (MessageInterface Name i)
which [FileInfo
fileInfo]

checkPathIsFile :: FB.FileInfo -> MH Bool
checkPathIsFile :: FileInfo -> MH Bool
checkPathIsFile = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesFileExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileInfo -> FilePath
FB.fileInfoFilePath

tryAddAttachment :: Lens' ChatState (MessageInterface Name i) -> [FB.FileInfo] -> MH ()
tryAddAttachment :: forall i.
Lens' ChatState (MessageInterface Name i) -> [FileInfo] -> MH ()
tryAddAttachment Lens' ChatState (MessageInterface Name i)
which [FileInfo]
entries = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FileInfo]
entries forall a b. (a -> b) -> a -> b
$ \FileInfo
entry -> do
        Bool
isFile <- FileInfo -> MH Bool
checkPathIsFile FileInfo
entry
        if Bool -> Bool
not Bool
isFile
        then MHError -> MH ()
mhError (Text -> MHError
BadAttachmentPath
            Text
"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.
            Vector AttachmentData
es <- 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) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
L.listElementsL)
            let matches :: AttachmentData -> Bool
matches = (forall a. Eq a => a -> a -> Bool
== FileInfo -> FilePath
FB.fileInfoFilePath FileInfo
entry) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              FileInfo -> FilePath
FB.fileInfoFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                              AttachmentData -> FileInfo
attachmentDataFileInfo
            case forall a. (a -> Bool) -> Vector a -> Maybe a
Vector.find AttachmentData -> Bool
matches Vector AttachmentData
es of
                Just AttachmentData
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Maybe AttachmentData
Nothing -> do
                    FileInfo -> MH (Either SomeException AttachmentData)
tryReadAttachment FileInfo
entry forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                        Right AttachmentData
a -> do
                            Maybe Int
oldIdx <- 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) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
L.listSelectedL)
                            let newIdx :: Maybe Int
newIdx = if forall a. Vector a -> Bool
Vector.null Vector AttachmentData
es
                                         then forall a. a -> Maybe a
Just Int
0
                                         else Maybe Int
oldIdx
                            Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (EditState n)
miEditorforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (EditState n) (List n AttachmentData)
esAttachmentList forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
L.listReplace (forall a. Vector a -> a -> Vector a
Vector.snoc Vector AttachmentData
es AttachmentData
a) Maybe Int
newIdx
                        Left SomeException
e -> MHError -> MH ()
mhError forall a b. (a -> b) -> a -> b
$ SomeException -> MHError
AttachmentException SomeException
e

    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 [FileInfo]
entries) forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
Compose

tryReadAttachment :: FB.FileInfo -> MH (Either E.SomeException AttachmentData)
tryReadAttachment :: FileInfo -> MH (Either SomeException AttachmentData)
tryReadAttachment FileInfo
fi = do
    let path :: FilePath
path = FileInfo -> FilePath
FB.fileInfoFilePath FileInfo
fi
    Either SomeException ByteString
readResult <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
path
    case Either SomeException ByteString
readResult of
        Right ByteString
bytes -> do
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$
                AttachmentData { attachmentDataFileInfo :: FileInfo
attachmentDataFileInfo = FileInfo
fi
                               , attachmentDataBytes :: ByteString
attachmentDataBytes = ByteString
bytes
                               }
        Left SomeException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SomeException
e