LIB: implement file moving operations

This commit is contained in:
Julian Ospald 2015-12-23 16:08:39 +01:00
parent 6b89dd8564
commit 09821f8fc2
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020
2 changed files with 61 additions and 6 deletions

View File

@ -200,9 +200,16 @@ isSymL f@(_ :/ RegFile _ FileInfo { isSymbolicLink = True }) = (True, f)
isSymL f = (False, f)
pattern IsSymL b <- (isSymL -> (b, _))
symlOrRegFile :: AnchoredFile FileInfo FileInfo
-> (Bool, AnchoredFile FileInfo FileInfo)
symlOrRegFile f@(_ :/ RegFile {}) = (True, f)
symlOrRegFile f@(_ :/ Dir _ FileInfo { isSymbolicLink = True }) = (True, f)
symlOrRegFile f = (False, f)
pattern IsSymL b <- (isSymL -> (b, _))
pattern SymlOrRegFile <- (symlOrRegFile -> (True, _))
----------------------------

View File

@ -110,11 +110,13 @@ data DirCopyMode = Strict -- ^ fail if the target directory already exists
-- be returned.
runFileOp :: FileOperation -> IO (Maybe FileOperation)
runFileOp (FCopy (CC from to cm)) = easyCopy cm from to >> return Nothing
runFileOp (FCopy fo) = return $ Just $ FCopy fo
runFileOp (FDelete fp) = easyDelete fp >> return Nothing
runFileOp (FOpen fp) = openFile fp >> return Nothing
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
runFileOp _ = return Nothing
runFileOp (FCopy fo) = return $ Just $ FCopy fo
runFileOp (FMove (MC from to)) = easyMove from to >> return Nothing
runFileOp (FMove fo) = return $ Just $ FMove fo
runFileOp (FDelete fp) = easyDelete fp >> return Nothing
runFileOp (FOpen fp) = openFile fp >> return Nothing
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
runFileOp _ = return Nothing
@ -235,6 +237,52 @@ easyCopy _ _ _ = return ()
-------------------
--[ File Moving ]--
-------------------
-- |Move a given file to the given target directory.
-- Includes symlinks, which are treated as files and the symlink is not
-- followed.
moveFile :: AnchoredFile FileInfo FileInfo -- ^ file to move
-> AnchoredFile FileInfo FileInfo -- ^ base target directory
-> IO ()
moveFile from@SymlOrRegFile to@(_ :/ Dir {}) = do
let from' = fullPath from
to' = fullPath to </> (name . file $ from)
throwSameFile from' to'
SD.renameFile from' to'
moveFile _ _ = return ()
-- |Move a given directory to the given target directory.
-- Excludes symlinks.
moveDir :: AnchoredFile FileInfo FileInfo -- ^ dir to move
-> AnchoredFile FileInfo FileInfo -- ^ base target directory
-> IO ()
moveDir (IsSymL True) _ = return ()
moveDir from@(_ :/ Dir n _) to@(_ :/ Dir {}) = do
let from' = fullPath from
to' = fullPath to </> n
throwSameFile from' to'
SD.renameDirectory from' to'
moveDir _ _ = return ()
-- |Moves a file, directory or symlink. In case of a symlink, it is
-- treated as a file and the symlink is not being followed.
easyMove :: AnchoredFile FileInfo FileInfo -- ^ source
-> AnchoredFile FileInfo FileInfo -- ^ base target directory
-> IO ()
easyMove from@(IsSymL True) to@(_ :/ Dir {}) = moveFile from to
easyMove from@(_ :/ RegFile _ _) to@(_ :/ Dir {}) = moveFile from to
easyMove from@(_ :/ Dir _ _) to@(_ :/ Dir {}) = moveDir from to
easyMove _ _ = return ()
---------------------
--[ File Deletion ]--
---------------------