LIB: make interaction with FileOperation more safe

We now don't safe an AnchoredFile anymore, but a Path and
construct the AnchoredFile just before the operation is carried out.

This means the copy and move buffers cannot contain stale references
to files that don't exist anymore.

src/HSFM/FileSystem/Errors.hs

@@ -66,6 +66,7 @@ data FmIOException = FileDoesNotExist String
                    | InvalidFileName
                    | Can'tOpenDirectory String
                    | CopyFailed String
+                   | MoveFailed String
   deriving (Show, Typeable)
 
 

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)
+data FileOperation = FCopy    Copy
-                     | FMove    (Move a)
+                   | FMove    Move
-                     | FDelete  [AnchoredFile a]
+                   | FDelete  [Path Abs]
-                     | FOpen    (AnchoredFile a)
+                   | FOpen    (Path Abs)
-                     | FExecute (AnchoredFile a) [ByteString]
+                   | FExecute (Path Abs) [ByteString]
-                     | None
+                   | 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]
+data Copy = CP1 [Path Abs]
-            | CP2 [AnchoredFile a]
+          | CP2 [Path Abs]
-                  (AnchoredFile a)
+                (Path Abs)
-            | CC  [AnchoredFile a]
+          | CC  [Path Abs]
-                  (AnchoredFile a)
+                (Path Abs)
-                  CopyMode
+                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]
+data Move = MP1 [Path Abs]
-            | MC  [AnchoredFile a]
+          | MC  [Path Abs]
-                  (AnchoredFile a)
+                (Path Abs)
-                  CopyMode
+                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.
+-- be returned. Returns `Nothing` on success.
-runFileOp :: FileOperation a -> IO (Maybe (FileOperation a))
+--
-runFileOp (FCopy (CC froms to cm)) = mapM_ (\x -> easyCopy cm x to) froms
+-- Since file operations can be delayed, this is `Path Abs` based, not
-                                       >> return Nothing
+-- `AnchoredFile` based. This makes sure we don't have stale
-runFileOp (FCopy fo)               = return              $ Just $ FCopy fo
+-- file information.
-runFileOp (FMove (MC froms to cm)) = mapM_ (\x -> easyMove cm x to) froms
+runFileOp :: FileOperation -> IO (Maybe FileOperation)
-                                       >> return Nothing
+runFileOp fo' =
-runFileOp (FMove fo)               = return              $ Just $ FMove fo
+  case fo' of
-runFileOp (FDelete fp)             = mapM_ easyDelete fp >> return Nothing
+    (FCopy (CC froms to cm)) -> do
-runFileOp (FOpen fp)               = openFile fp         >> return Nothing
+      froms' <- mapM toAfile froms
-runFileOp (FExecute fp args)       = executeFile fp args >> return Nothing
+      to'    <- toAfile to
-runFileOp _                        = return Nothing
+      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)
 
 
 

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"
 
 

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
 }