{-# OPTIONS_HADDOCK ignore-exports #-} module IO.File where import Control.Exception ( throw ) import Control.Monad ( unless , void , when ) import Data.DirTree import Data.DirTree.Zipper import IO.Error import System.Directory ( canonicalizePath , doesDirectoryExist , doesFileExist , executable , getPermissions , removeDirectory , removeFile ) import System.FilePath ( equalFilePath , isAbsolute , takeFileName , takeDirectory , () ) import System.Process ( spawnProcess , ProcessHandle ) import qualified System.Directory as SD -- TODO: modify the DTZipper directly after file operations!? -- TODO: file operations should be threaded and not block the UI -- |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 b = FCopy (DTZipper a b) (DTZipper a b) | FMove FilePath FilePath | FDelete (DTZipper a b) | FOpen (DTZipper a b) | FExecute (DTZipper a b) [String] | None runFileOp :: FileOperation a b -> IO () runFileOp (FCopy from to) = copyFileToDir from to runFileOp (FDelete fp) = easyDelete fp runFileOp (FOpen fp) = void $ openFile fp runFileOp (FExecute fp args) = void $ executeFile fp args runFileOp _ = return () -- |Copies the given file. -- -- This will throw an exception if any of the filepaths are not absolute -- and an exception if the source file does not exist. -- -- If the destination file already exists, it will be replaced. copyFile :: DTZipper a b -- ^ source file -> FilePath -- ^ destination file -> IO () copyFile from@(File name _, _) to = do let fp = getFullPath from fileSanityThrow fp throwNotAbsolute to throwDirDoesExist to toC <- canonicalizePath (takeDirectory to) let to' = toC takeFileName to throwSameFile fp to' SD.copyFile fp to' -- |Copies the given file to the given dir with the same filename. -- -- This is just a convenience wrapper around `copyFile`. copyFileToDir :: DTZipper a b -- ^ source file -> DTZipper a b -- ^ destination -> IO () copyFileToDir from@(File name _, _) to@(Dir {}, _) = do let dp = getFullPath to dirSanityThrow dp copyFile from (dp name) copyFileToDir from (Dir {}, _) = throw $ NotAFile (getFullPath from) copyFileToDir _ to = throw $ NotADir (getFullPath to) -- |Copies the given file, regardless of whether the destination is -- a file or a directory. This is a wrapper around `copyFile` and -- `copyFileToDir`. easyCopyFile :: DTZipper a b -> Either FilePath (DTZipper a b) -> IO () easyCopyFile from (Left to) = copyFile from to easyCopyFile from (Right to) = copyFileToDir from to -- |Deletes the given file. -- -- This will throw an exception if the filepath is not absolute -- or the file does not exist. -- -- It also throws exceptions from `removeFile`. deleteFile :: DTZipper a b -> IO () deleteFile dtz@(File {}, _) = do let fp = getFullPath dtz fileSanityThrow fp removeFile fp deleteFile dtz = throw $ NotAFile (getFullPath dtz) -- |Deletes the given directory. -- -- This will throw an exception if the filepath is not absolute -- or the directory does not exist. -- -- It also throws exceptions from `removeDirectory`. deleteDir :: DTZipper a b -> IO () deleteDir dtz@(Dir {}, _) = do let fp = getFullPath dtz dirSanityThrow fp removeDirectory fp deleteDir dtz = throw $ NotADir (getFullPath dtz) -- |Deletes a file or directory, whatever it may be. easyDelete :: DTZipper a b -> IO () easyDelete dtz@(File {}, _) = deleteFile dtz easyDelete dtz@(Dir {}, _) = deleteDir dtz -- |Opens a file appropriately by invoking xdg-open. -- -- This will throw an exception if the filepath is not absolute -- or the file does not exist. openFile :: DTZipper a b -> IO ProcessHandle openFile dtz@(File {}, _) = do let fp = getFullPath dtz fileSanityThrow fp spawnProcess "xdg-open" [fp] openFile dtz = throw $ NotAFile (getFullPath dtz) -- |Executes a program with the given arguments. -- -- This will throw an exception if the filepath is not absolute -- or the file does not exist. It will also throw an exception -- if the file is not executable. executeFile :: DTZipper a b -- ^ program -> [String] -- ^ arguments -> IO ProcessHandle executeFile dtz@(File {}, _) args = do let fp = getFullPath dtz fileSanityThrow fp p <- getPermissions fp unless (executable p) (throw $ FileNotExecutable fp) spawnProcess fp args executeFile dtz _ = throw $ NotAFile (getFullPath dtz)