diff --git a/src/HSFM/FileSystem/Errors.hs b/src/HSFM/FileSystem/Errors.hs index 429bbf2..ad5cb3d 100644 --- a/src/HSFM/FileSystem/Errors.hs +++ b/src/HSFM/FileSystem/Errors.hs @@ -66,6 +66,7 @@ data FmIOException = FileDoesNotExist String | InvalidFileName | Can'tOpenDirectory String | CopyFailed String + | MoveFailed String deriving (Show, Typeable) diff --git a/src/HSFM/FileSystem/FileOperations.hs b/src/HSFM/FileSystem/FileOperations.hs index d83b6ba..c5ba2d0 100644 --- a/src/HSFM/FileSystem/FileOperations.hs +++ b/src/HSFM/FileSystem/FileOperations.hs @@ -70,12 +70,14 @@ import Foreign.Ptr import HPath ( Path + , Abs , Fn ) import qualified HPath as P import HSFM.FileSystem.Errors import HSFM.FileSystem.FileType import HSFM.Utils.IO +import Prelude hiding (readFile) import Network.Sendfile ( sendfileFd @@ -126,30 +128,30 @@ import System.Posix.Types -- |Data type describing an actual file operation that can be -- carried out via `doFile`. Useful to build up a list of operations -- or delay operations. -data FileOperation a = FCopy (Copy a) - | FMove (Move a) - | FDelete [AnchoredFile a] - | FOpen (AnchoredFile a) - | FExecute (AnchoredFile a) [ByteString] - | None +data FileOperation = FCopy Copy + | FMove Move + | FDelete [Path Abs] + | FOpen (Path Abs) + | FExecute (Path Abs) [ByteString] + | None -- |Data type describing partial or complete file copy operation. -- CC stands for a complete operation and can be used for `runFileOp`. -data Copy a = CP1 [AnchoredFile a] - | CP2 [AnchoredFile a] - (AnchoredFile a) - | CC [AnchoredFile a] - (AnchoredFile a) - CopyMode +data Copy = CP1 [Path Abs] + | CP2 [Path Abs] + (Path Abs) + | CC [Path Abs] + (Path Abs) + CopyMode -- |Data type describing partial or complete file move operation. -- MC stands for a complete operation and can be used for `runFileOp`. -data Move a = MP1 [AnchoredFile a] - | MC [AnchoredFile a] - (AnchoredFile a) - CopyMode +data Move = MP1 [Path Abs] + | MC [Path Abs] + (Path Abs) + CopyMode -- |Copy modes. @@ -162,18 +164,40 @@ data CopyMode = Strict -- ^ fail if the target already exists -- |Run a given FileOperation. If the FileOperation is partial, it will --- be returned. -runFileOp :: FileOperation a -> IO (Maybe (FileOperation a)) -runFileOp (FCopy (CC froms to cm)) = mapM_ (\x -> easyCopy cm x to) froms - >> return Nothing -runFileOp (FCopy fo) = return $ Just $ FCopy fo -runFileOp (FMove (MC froms to cm)) = mapM_ (\x -> easyMove cm x to) froms - >> return Nothing -runFileOp (FMove fo) = return $ Just $ FMove fo -runFileOp (FDelete fp) = mapM_ easyDelete fp >> return Nothing -runFileOp (FOpen fp) = openFile fp >> return Nothing -runFileOp (FExecute fp args) = executeFile fp args >> return Nothing -runFileOp _ = return Nothing +-- be returned. Returns `Nothing` on success. +-- +-- Since file operations can be delayed, this is `Path Abs` based, not +-- `AnchoredFile` based. This makes sure we don't have stale +-- file information. +runFileOp :: FileOperation -> IO (Maybe FileOperation) +runFileOp fo' = + case fo' of + (FCopy (CC froms to cm)) -> do + froms' <- mapM toAfile froms + to' <- toAfile to + when (anyFailed $ file <$> froms') + (throw . CopyFailed $ "File in copy buffer does not exist anymore!") + mapM_ (\x -> easyCopy cm x to') froms' + >> return Nothing + (FCopy fo) -> return $ Just $ FCopy fo + (FMove (MC froms to cm)) -> do + froms' <- mapM toAfile froms + to' <- toAfile to + when (anyFailed $ file <$> froms') + (throw . MoveFailed $ "File in move buffer does not exist anymore!") + mapM_ (\x -> easyMove cm x to') froms' + >> return Nothing + (FMove fo) -> return $ Just $ FMove fo + (FDelete fps) -> do + fps' <- mapM toAfile fps + mapM_ easyDelete fps' >> return Nothing + (FOpen fp) -> + toAfile fp >>= openFile >> return Nothing + (FExecute fp args) -> + toAfile fp >>= flip executeFile args >> return Nothing + _ -> return Nothing + where + toAfile = readFile (\_ -> return undefined) diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index f3fd61c..405325f 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -277,7 +277,7 @@ del _ _ _ = withErrorDialog -- |Initializes a file move operation. moveInit :: [Item] -> MyGUI -> MyView -> IO () moveInit items@(_:_) mygui myview = do - writeTVarIO (operationBuffer myview) (FMove . MP1 $ items) + writeTVarIO (operationBuffer myview) (FMove . MP1 . map fullPath $ items) let sbmsg = case items of (item:[]) -> "Move buffer: " ++ P.fpToString (fullPathS item) _ -> "Move buffer: " ++ (show . length $ items) @@ -291,7 +291,7 @@ moveInit _ _ _ = withErrorDialog -- |Supposed to be used with 'withRows'. Initializes a file copy operation. copyInit :: [Item] -> MyGUI -> MyView -> IO () copyInit items@(_:_) mygui myview = do - writeTVarIO (operationBuffer myview) (FCopy . CP1 $ items) + writeTVarIO (operationBuffer myview) (FCopy . CP1 . map fullPath $ items) let sbmsg = case items of (item:[]) -> "Copy buffer: " ++ P.fpToString (fullPathS item) _ -> "Copy buffer: " ++ (show . length $ items) @@ -307,18 +307,18 @@ copyInit _ _ _ = withErrorDialog operationFinal :: MyGUI -> MyView -> IO () operationFinal _ myview = withErrorDialog $ do op <- readTVarIO (operationBuffer myview) - cdir <- getCurrentDir myview + cdir <- fullPath <$> getCurrentDir myview case op of FMove (MP1 s) -> do let cmsg = "Really move " ++ imsg s - ++ " to \"" ++ P.fpToString (fullPathS cdir) + ++ " to \"" ++ P.fpToString (P.fromAbs cdir) ++ "\"?" withConfirmationDialog cmsg . withCopyModeDialog $ \cm -> void $ runFileOp (FMove . MC s cdir $ cm) return () FCopy (CP1 s) -> do let cmsg = "Really copy " ++ imsg s - ++ " to \"" ++ P.fpToString (fullPathS cdir) + ++ " to \"" ++ P.fpToString (P.fromAbs cdir) ++ "\"?" withConfirmationDialog cmsg . withCopyModeDialog $ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm) @@ -326,7 +326,7 @@ operationFinal _ myview = withErrorDialog $ do _ -> return () where imsg s = case s of - (item:[]) -> "\"" ++ P.fpToString (fullPathS item) ++ "\"" + (item:[]) -> "\"" ++ P.fpToString (P.fromAbs item) ++ "\"" items -> (show . length $ items) ++ " items" diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs index 2480f19..a75244c 100644 --- a/src/HSFM/GUI/Gtk/Data.hs +++ b/src/HSFM/GUI/Gtk/Data.hs @@ -101,7 +101,7 @@ data MyView = MkMyView { , rawModel :: TVar (ListStore Item) , sortedModel :: TVar (TypedTreeModelSort Item) , filteredModel :: TVar (TypedTreeModelFilter Item) - , operationBuffer :: TVar (FileOperation FileInfo) + , operationBuffer :: TVar FileOperation , inotify :: MVar INotify }