From 5f183bef3fadb39b213bb20c01ca0d4386823557 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Wed, 23 Dec 2015 22:50:04 +0100 Subject: [PATCH] LIB/GTK: use new data structure with explicit SymLink constructor This still needs a lot of work to function consistently, but it's better than the old approach. --- src/Data/DirTree.hs | 289 +++++++++++++++++++-------------------- src/GUI/Gtk/Callbacks.hs | 2 +- src/GUI/Gtk/Data.hs | 2 +- src/GUI/Gtk/Utils.hs | 7 +- src/IO/File.hs | 100 +++++++------- 5 files changed, 198 insertions(+), 202 deletions(-) diff --git a/src/Data/DirTree.hs b/src/Data/DirTree.hs index 7174f7f..f9c2d2c 100644 --- a/src/Data/DirTree.hs +++ b/src/Data/DirTree.hs @@ -83,6 +83,7 @@ import System.FilePath combine , normalise , equalFilePath + , isAbsolute , joinPath , splitDirectories , takeFileName @@ -141,8 +142,8 @@ type FileName = String -- |Represents a file. The `anchor` field is the path -- to that file without the filename. -data AnchoredFile a b = - (:/) { anchor :: FilePath, file :: File a b } +data AnchoredFile a = + (:/) { anchor :: FilePath, file :: File a } deriving (Eq, Ord, Show) @@ -151,18 +152,40 @@ data AnchoredFile a b = -- Handles, Strings representing a file's contents or anything else you can -- think of. We catch any IO errors in the Failed constructor. an Exception -- can be converted to a String with 'show'. -data File a b = +data File a = Failed { name :: FileName , err :: IOException } | Dir { name :: FileName - , dir :: a + , fvar :: a } | RegFile { name :: FileName - , regFile :: b + , fvar :: a + } + | SymLink { + name :: FileName + , fvar :: a + , sdest :: AnchoredFile a -- ^ symlink madness, + -- we need to know where it points to + } + | BlockDev { + name :: FileName + , fvar :: a + } + | CharDev { + name :: FileName + , fvar :: a + } + | NamedPipe { + name :: FileName + , fvar :: a + } + | Socket { + name :: FileName + , fvar :: a } deriving (Show, Eq) @@ -182,34 +205,31 @@ data FileInfo = FileInfo { , accessTimeHiRes :: POSIXTime , modificationTimeHiRes :: POSIXTime , statusChangeTimeHiRes :: POSIXTime - , isBlockDevice :: Bool - , isCharacterDevice :: Bool - , isNamedPipe :: Bool - , isRegularFile :: Bool - , isDirectory :: Bool - , isSymbolicLink :: Bool - , isSocket :: Bool - , permissions :: Permissions } deriving (Show, Eq, Ord) -isSymL :: AnchoredFile FileInfo FileInfo - -> (Bool, AnchoredFile FileInfo FileInfo) -isSymL f@(_ :/ Dir _ FileInfo { isSymbolicLink = True }) = (True, f) -isSymL f@(_ :/ RegFile _ FileInfo { isSymbolicLink = True }) = (True, f) -isSymL f = (False, f) +type UserIO a = FilePath -> IO a + +type Builder a = UserIO a -> FilePath -> IO [File a] -symlOrRegFile :: AnchoredFile FileInfo FileInfo - -> (Bool, AnchoredFile FileInfo FileInfo) +symlOrRegFile :: AnchoredFile FileInfo + -> (Bool, AnchoredFile FileInfo) symlOrRegFile f@(_ :/ RegFile {}) = (True, f) -symlOrRegFile f@(_ :/ Dir _ FileInfo { isSymbolicLink = True }) = (True, f) +symlOrRegFile f@(_ :/ SymLink {}) = (True, f) symlOrRegFile f = (False, f) -pattern IsSymL b <- (isSymL -> (b, _)) +sdir :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo) +sdir f@(_ :/ SymLink { sdest = (_ :/ Dir {} )}) = (True, f) +sdir f@(_ :/ Dir {}) = (True, f) +sdir f = (False, f) + + pattern SymlOrRegFile <- (symlOrRegFile -> (True, _)) +pattern SDir f <- (sdir -> (True, f)) + ---------------------------- @@ -217,28 +237,10 @@ pattern SymlOrRegFile <- (symlOrRegFile -> (True, _)) ---------------------------- -instance BF.Bifunctor File where - bimap = BT.bimapDefault - - -instance BFL.Bifoldable File where - bifoldMap = BT.bifoldMapDefault - - -instance BT.Bitraversable File where - bitraverse f1 f2 (Dir n b) = - Dir n <$> f1 b - bitraverse _ f2 (RegFile n a) = - RegFile n <$> f2 a - bitraverse _ _ (Failed n e) = - pure (Failed n e) - - - -- | First compare constructors: Failed < Dir < File... -- Then compare `name`... -- Then compare free variable parameter of `File` constructors -instance (Ord a, Ord b, Eq a, Eq b) => Ord (File a b) where +instance (Ord a, Eq a) => Ord (File a) where compare (RegFile n a) (RegFile n' a') = case compare n n' of EQ -> compare a a' @@ -261,96 +263,75 @@ instance (Ord a, Ord b, Eq a, Eq b) => Ord (File a b) where -- |Read a file into an `AnchoredFile`, filling the free variables via --- `getFileInfo`. This also works on directories, but doesn't look at --- their contents. +-- the given function. readFileWith :: (FilePath -> IO a) - -> (FilePath -> IO b) -> FilePath - -> IO (AnchoredFile a b) -readFileWith fd ff fp = do - let fn = topDir fp - bd = baseDir fp - file <- handleDT (topDir fp) $ do - isFile <- doesFileExist fp - if isFile - then RegFile fn <$> ff fp - else Dir fn <$> fd fp - return (bd :/ file) + -> IO (AnchoredFile a) +readFileWith ff p = do + let fn = topDir p + bd = baseDir p + handleDT' bd fn $ do + fs <- PF.getSymbolicLinkStatus p + fv <- ff p + file <- constructFile fs fv bd fn + return (bd :/ file) + where + constructFile fs fv bd' n + | PF.isSymbolicLink fs = do + -- symlink madness, we need to make sure we save the correct + -- AnchoredFile + let fp = bd' n + resolvedSyml <- handleDT' bd' n $ do + sfp <- (\x -> if isAbsolute x then x else bd' x) + <$> PF.readSymbolicLink fp + _ <- PF.getFileStatus sfp -- important to break infinite symbolic + -- link cycle + readFileWith ff sfp + return $ SymLink n fv resolvedSyml + | PF.isDirectory fs = return $ Dir n fv + | PF.isRegularFile fs = return $ RegFile n fv + | PF.isBlockDevice fs = return $ BlockDev n fv + | PF.isCharacterDevice fs = return $ CharDev n fv + | PF.isNamedPipe fs = return $ NamedPipe n fv + | PF.isSocket fs = return $ Socket n fv + | otherwise = return $ Failed n (userError + "Unknown filetype!") -readFile :: FilePath -> IO (AnchoredFile FileInfo FileInfo) -readFile fp = readFileWith getFileInfo getFileInfo =<< canonicalizePath' fp +readFile :: FilePath -> IO (AnchoredFile FileInfo) +readFile fp = readFileWith getFileInfo =<< canonicalizePath' fp -- |Build a list of AnchoredFile, given the path to a directory, filling -- the free variables via `getFileInfo`. This includes the "." and ".." -- directories. -readDirectory :: FilePath -> IO [AnchoredFile FileInfo FileInfo] -readDirectory fp = readDirectoryWith getAllDirsFiles getFileInfo getFileInfo +readDirectory :: FilePath -> IO [AnchoredFile FileInfo] +readDirectory fp = readDirectoryWith getAllDirsFiles getFileInfo =<< canonicalizePath' fp -- |Build a list of AnchoredFile, given the path to a directory, filling -- the free variables via `getFileInfo`. This excludes the "." and ".." -- directories. -readDirectory' :: FilePath -> IO [AnchoredFile FileInfo FileInfo] -readDirectory' fp = readDirectoryWith getDirsFiles getFileInfo getFileInfo - =<< canonicalizePath' fp +readDirectory' :: FilePath -> IO [AnchoredFile FileInfo] +readDirectory' fp = readDirectoryWith getDirsFiles getFileInfo + =<< canonicalizePath' fp -- | same as readDirectory but allows us to, for example, use -- ByteString.readFile to return a tree of ByteStrings. readDirectoryWith :: (FilePath -> IO [FilePath]) -> (FilePath -> IO a) - -> (FilePath -> IO b) -> FilePath - -> IO [AnchoredFile a b] -readDirectoryWith getfiles fd ff p = buildWith' (buildAtOnce' getfiles) fd ff - =<< canonicalizePath' p + -> IO [AnchoredFile a] +readDirectoryWith getfiles ff p = do + contents <- getfiles =<< canonicalizePath' p + cs <- mapM (\x -> readFileWith ff $ p x) contents + return $ removeNonexistent cs - ----------------------------- - --[ LOWER LEVEL FUNCTIONS ]-- - ----------------------------- - - - - - -- -- -- helpers: -- -- -- - - -type UserIO a = FilePath -> IO a -type Builder a b = UserIO a -> UserIO b -> FilePath -> IO [File a b] - --- remove non-existent file errors, which are artifacts of the "non-atomic" --- nature of traversing a system firectory tree: -buildWith' :: Builder a b - -> UserIO a - -> UserIO b - -> FilePath - -> IO [AnchoredFile a b] -buildWith' bf' fd ff p = - do - cfp <- canonicalizePath' p - tree <- bf' fd ff cfp - return $ fmap (cfp :/) (removeNonexistent tree) - - - --- IO function passed to our builder and finally executed here: -buildAtOnce' :: (FilePath -> IO [FilePath]) -> Builder a b -buildAtOnce' getfiles fd ff fp = do - contents <- getfiles fp - for contents $ \n -> handleDT n $ do - let subf = fp n - do isFile <- doesFileExist subf - if isFile - then RegFile n <$> ff subf - else Dir n <$> fd subf - - ----------------- --[ UTILITIES ]-- @@ -362,22 +343,22 @@ buildAtOnce' getfiles fd ff fp = do -- | True if any Failed constructors in the tree -anyFailed :: [File a b] -> Bool +anyFailed :: [File a] -> Bool anyFailed = not . successful -- | True if there are no Failed constructors in the tree -successful :: [File a b] -> Bool +successful :: [File a] -> Bool successful = null . failures -- | returns true if argument is a `Failed` constructor: -failed :: File a b -> Bool +failed :: File a -> Bool failed (Failed _ _) = True failed _ = False -- | returns a list of 'Failed' constructors only: -failures :: [File a b] -> [File a b] +failures :: [File a] -> [File a] failures = filter failed @@ -387,21 +368,21 @@ failures = filter failed -- | Tests equality of two trees, ignoring their free variable portion. Can be -- used to check if any files have been added or deleted, for instance. -equalShape :: File a b -> File c d -> Bool +equalShape :: File a -> File b -> Bool equalShape d d' = comparingShape d d' == EQ -- TODO: we should use equalFilePath here, but how to sort properly? -- with System.Directory.canonicalizePath, before compare? -- | a compare function that ignores the free "file" type variable: -comparingShape :: File a b -> File c d -> Ordering +comparingShape :: File a -> File b -> Ordering comparingShape (Dir n _) (Dir n' _) = compare n n' -- else simply compare the flat constructors, non-recursively: comparingShape t t' = comparingConstr t t' -- HELPER: a non-recursive comparison -comparingConstr :: File a b -> File a1 b1 -> Ordering +comparingConstr :: File a -> File b -> Ordering comparingConstr (Failed _ _) (Dir _ _) = LT comparingConstr (Failed _ _) (RegFile _ _) = LT comparingConstr (RegFile _ _) (Failed _ _) = GT @@ -425,11 +406,11 @@ comparingConstr t t' = compare (name t) (name t') ---- CONSTRUCTOR IDENTIFIERS ---- -isFileC :: File a b -> Bool +isFileC :: File a -> Bool isFileC (RegFile _ _) = True isFileC _ = False -isDirC :: File a b -> Bool +isDirC :: File a -> Bool isDirC (Dir _ _) = True isDirC _ = False @@ -481,20 +462,20 @@ canonicalizePath' fp = do -- |Go up one directory in the filesystem hierarchy. -goUp :: AnchoredFile FileInfo FileInfo -> IO (AnchoredFile FileInfo FileInfo) +goUp :: AnchoredFile FileInfo -> IO (AnchoredFile FileInfo) goUp af@("" :/ _) = return af goUp (bp :/ _) = Data.DirTree.readFile bp -goUp' :: FilePath -> IO (AnchoredFile FileInfo FileInfo) +goUp' :: FilePath -> IO (AnchoredFile FileInfo) goUp' fp = do cfp <- canonicalizePath' fp Data.DirTree.readFile $ baseDir cfp -getContents :: AnchoredFile FileInfo FileInfo - -> IO [AnchoredFile FileInfo FileInfo] -getContents (bp :/ Dir n _) = readDirectory (bp n) +getContents :: AnchoredFile FileInfo + -> IO [AnchoredFile FileInfo] +getContents (SDir af) = readDirectory (fullPath af) getContents _ = return [] @@ -539,7 +520,6 @@ getDirsFiles fp = do getFileInfo :: FilePath -> IO FileInfo getFileInfo fp = do fs <- PF.getSymbolicLinkStatus fp - perms <- getPermissions fp return $ FileInfo (PF.deviceID fs) (PF.fileID fs) @@ -555,18 +535,10 @@ getFileInfo fp = do (PF.accessTimeHiRes fs) (PF.modificationTimeHiRes fs) (PF.statusChangeTimeHiRes fs) - (PF.isBlockDevice fs) - (PF.isCharacterDevice fs) - (PF.isNamedPipe fs) - (PF.isRegularFile fs) - (PF.isDirectory fs) - (PF.isSymbolicLink fs) - (PF.isSocket fs) - perms -- |Gets the free variable. Returns Nothing if the constructor is of `Failed`. -getFreeVar :: File a a -> Maybe a +getFreeVar :: File a -> Maybe a getFreeVar (RegFile _ f) = Just f getFreeVar (Dir _ d) = Just d getFreeVar _ = Nothing @@ -577,20 +549,27 @@ getFreeVar _ = Nothing -- handles an IO exception by returning a Failed constructor filled with that -- exception: -handleDT :: FileName -> IO (File a b) -> IO (File a b) +handleDT :: FileName -> IO (File a) -> IO (File a) handleDT n = handle (return . Failed n) +-- handles an IO exception by returning a Failed constructor filled with that +-- exception: +handleDT' :: FilePath -> FileName -> IO (AnchoredFile a) -> IO (AnchoredFile a) +handleDT' bp n = handle (\e -> return $ bp :/ Failed n e) + + -- DoesNotExist errors not present at the topmost level could happen if a -- named file or directory is deleted after being listed by -- getDirectoryContents but before we can get it into memory. -- So we filter those errors out because the user should not see errors -- raised by the internal implementation of this module: -- This leaves the error if it exists in the top (user-supplied) level: -removeNonexistent :: [File a b] -> [File a b] +removeNonexistent :: [AnchoredFile a] -> [AnchoredFile a] removeNonexistent = filter isOkConstructor - where isOkConstructor c = not (failed c) || isOkError c - isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err + where + isOkConstructor (_ :/ c) = not (failed c) || isOkError c + isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err @@ -598,11 +577,11 @@ removeNonexistent = filter isOkConstructor ---- OTHER: ---- -fullPath :: AnchoredFile a b -> FilePath +fullPath :: AnchoredFile a -> FilePath fullPath (bp :/ f) = bp name f -fromFreeVar :: (Default d) => (a -> d) -> File a a -> d +fromFreeVar :: (Default d) => (a -> d) -> File a -> d fromFreeVar f df = maybeD f $ getFreeVar df @@ -610,20 +589,38 @@ maybeD :: (Default b) => (a -> b) -> Maybe a -> b maybeD = maybe def --- |Pack the modification time -packModTime :: File FileInfo FileInfo +-- |Pack the modification time into a string. +packModTime :: File FileInfo -> String packModTime = fromFreeVar $ show . posixSecondsToUTCTime . realToFrac . modificationTime -packPermissions :: File FileInfo FileInfo + +-- |Pack the permissions into a string, similar to what "ls -l" does. +packPermissions :: File FileInfo -> String -packPermissions dt = fromFreeVar (pStr . permissions) dt +packPermissions dt = fromFreeVar (pStr . fileMode) dt where - pStr perm = str perm readable "r" - ++ str perm writable "w" - ++ str perm (if isDirC dt then searchable else executable) - "x" - str perm f ch - | f perm = ch - | otherwise = "-" + pStr ffm = typeModeStr ++ ownerModeStr ++ groupModeStr ++ otherModeStr + where + typeModeStr + | hasFM PF.regularFileMode = "-" + | hasFM PF.directoryMode = "d" + | hasFM PF.symbolicLinkMode = "l" + | hasFM PF.socketMode = "s" + | hasFM PF.blockSpecialMode = "b" + | hasFM PF.characterSpecialMode = "c" + | hasFM PF.namedPipeMode = "p" + ownerModeStr = hasFmStr PF.ownerReadMode "r" + ++ hasFmStr PF.ownerWriteMode "w" + ++ hasFmStr PF.ownerExecuteMode "x" + groupModeStr = hasFmStr PF.groupReadMode "r" + ++ hasFmStr PF.groupWriteMode "w" + ++ hasFmStr PF.groupExecuteMode "x" + otherModeStr = hasFmStr PF.otherReadMode "r" + ++ hasFmStr PF.otherWriteMode "w" + ++ hasFmStr PF.otherExecuteMode "x" + hasFmStr fm str + | hasFM fm = str + | otherwise = "-" + hasFM fm = ffm `PF.intersectFileModes` fm == fm diff --git a/src/GUI/Gtk/Callbacks.hs b/src/GUI/Gtk/Callbacks.hs index a7b185d..df74063 100644 --- a/src/GUI/Gtk/Callbacks.hs +++ b/src/GUI/Gtk/Callbacks.hs @@ -111,7 +111,7 @@ urlGoTo mygui myview = do open :: Row -> MyGUI -> MyView -> IO () open row mygui myview = withErrorDialog $ case row of - r@(_ :/ Dir _ _) -> do + SDir r -> do nv <- Data.DirTree.readFile $ fullPath r refreshTreeView' mygui myview nv r -> diff --git a/src/GUI/Gtk/Data.hs b/src/GUI/Gtk/Data.hs index 7e2b7f2..558371d 100644 --- a/src/GUI/Gtk/Data.hs +++ b/src/GUI/Gtk/Data.hs @@ -56,7 +56,7 @@ data FMSettings = MkFMSettings { } -type Row = AnchoredFile FileInfo FileInfo +type Row = AnchoredFile FileInfo -- |This describes the contents of the treeView and is separated from MyGUI, diff --git a/src/GUI/Gtk/Utils.hs b/src/GUI/Gtk/Utils.hs index de8848c..9242ceb 100644 --- a/src/GUI/Gtk/Utils.hs +++ b/src/GUI/Gtk/Utils.hs @@ -85,7 +85,7 @@ withRow mygui myview io = do -- |Create the 'ListStore' of files/directories from the current directory. -- This is the function which maps the Data.DirTree data structures -- into the GTK+ data structures. -fileListStore :: AnchoredFile FileInfo FileInfo -- ^ current dir +fileListStore :: AnchoredFile FileInfo -- ^ current dir -> MyView -> IO (ListStore Row) fileListStore dt myview = do @@ -100,7 +100,7 @@ fileListStore dt myview = do -- -- * 'rawModel' reads getFirstRow :: MyView - -> IO (AnchoredFile FileInfo FileInfo) + -> IO (AnchoredFile FileInfo) getFirstRow myview = do rawModel' <- readTVarIO $ rawModel myview iter <- fromJust <$> treeModelGetIterFirst rawModel' @@ -141,7 +141,7 @@ refreshTreeView mygui myview mfp = do -- * 'rawModel' writes refreshTreeView' :: MyGUI -> MyView - -> AnchoredFile FileInfo FileInfo + -> AnchoredFile FileInfo -> IO () refreshTreeView' mygui myview dt = do newRawModel <- fileListStore dt myview @@ -215,6 +215,7 @@ constructTreeView mygui myview = do dirtreePix (Dir {}) = folderPix mygui dirtreePix (RegFile {}) = filePix mygui dirtreePix (Failed {}) = errorPix mygui + dirtreePix _ = errorPix mygui -- |Push a message to the status bar. diff --git a/src/IO/File.hs b/src/IO/File.hs index 5f372a7..ecbc053 100644 --- a/src/IO/File.hs +++ b/src/IO/File.hs @@ -77,27 +77,27 @@ import qualified System.Posix.Files as PF -- or delay operations. data FileOperation = FCopy Copy | FMove Move - | FDelete (AnchoredFile FileInfo FileInfo) - | FOpen (AnchoredFile FileInfo FileInfo) - | FExecute (AnchoredFile FileInfo FileInfo) [String] + | FDelete (AnchoredFile FileInfo) + | FOpen (AnchoredFile FileInfo) + | FExecute (AnchoredFile FileInfo) [String] | None -- |Data type describing partial or complete file copy operation. -- CC stands for a complete operation and can be used for `runFileOp`. -data Copy = CP1 (AnchoredFile FileInfo FileInfo) - | CP2 (AnchoredFile FileInfo FileInfo) - (AnchoredFile FileInfo FileInfo) - | CC (AnchoredFile FileInfo FileInfo) - (AnchoredFile FileInfo FileInfo) +data Copy = CP1 (AnchoredFile FileInfo) + | CP2 (AnchoredFile FileInfo) + (AnchoredFile FileInfo) + | CC (AnchoredFile FileInfo) + (AnchoredFile FileInfo) DirCopyMode -- |Data type describing partial or complete file move operation. -- MC stands for a complete operation and can be used for `runFileOp`. -data Move = MP1 (AnchoredFile FileInfo FileInfo) - | MC (AnchoredFile FileInfo FileInfo) - (AnchoredFile FileInfo FileInfo) +data Move = MP1 (AnchoredFile FileInfo) + | MC (AnchoredFile FileInfo) + (AnchoredFile FileInfo) -- |Directory copy modes. @@ -129,11 +129,10 @@ runFileOp _ = return Nothing -- |Copies a directory to the given destination with the specified -- `DirCopyMode`. Excludes symlinks. copyDir :: DirCopyMode - -> AnchoredFile FileInfo FileInfo -- ^ source dir - -> AnchoredFile FileInfo FileInfo -- ^ destination dir + -> AnchoredFile FileInfo -- ^ source dir + -> AnchoredFile FileInfo -- ^ destination dir -> IO () -copyDir cm (IsSymL True) _ - = return () +copyDir cm (_ :/ SymLink {}) _ = return () copyDir cm from@(_ :/ Dir fromn _) to@(_ :/ Dir {}) = do @@ -150,7 +149,7 @@ copyDir cm from@(_ :/ Dir fromn _) for_ contents $ \f -> case f of - (IsSymL True) -> recreateSymlink f destdir + (_ :/ SymLink {}) -> recreateSymlink f destdir (_ :/ Dir {}) -> copyDir cm f destdir (_ :/ RegFile {}) -> copyFileToDir f destdir _ -> return () @@ -179,11 +178,11 @@ copyDir _ _ _ = return () -- |Recreate a symlink. -recreateSymlink :: AnchoredFile FileInfo FileInfo -- ^ the old symlink file - -> AnchoredFile FileInfo FileInfo -- ^ destination dir of the +recreateSymlink :: AnchoredFile FileInfo -- ^ the old symlink file + -> AnchoredFile FileInfo -- ^ destination dir of the -- new symlink file -> IO () -recreateSymlink symf@(IsSymL True) +recreateSymlink symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) = do symname <- readSymbolicLink (fullPath symf) @@ -193,10 +192,10 @@ recreateSymlink _ _ = return () -- |Copies the given file to the given file destination. -- Excludes symlinks. -copyFile :: AnchoredFile FileInfo FileInfo -- ^ source file - -> AnchoredFile FileInfo FileInfo -- ^ destination file +copyFile :: AnchoredFile FileInfo -- ^ source file + -> AnchoredFile FileInfo -- ^ destination file -> IO () -copyFile (IsSymL True) _ = return () +copyFile (_ :/ SymLink {}) _ = return () copyFile from@(_ :/ RegFile {}) to@(_ :/ RegFile {}) = do let from' = fullPath from to' = fullPath to @@ -207,10 +206,10 @@ copyFile _ _ = return () -- |Copies the given file to the given dir with the same filename. -- Excludes symlinks. -copyFileToDir :: AnchoredFile FileInfo FileInfo - -> AnchoredFile FileInfo FileInfo +copyFileToDir :: AnchoredFile FileInfo + -> AnchoredFile FileInfo -> IO () -copyFileToDir (IsSymL True) _ = return () +copyFileToDir (_ :/ SymLink {}) _ = return () copyFileToDir from@(_ :/ RegFile fn _) to@(_ :/ Dir {}) = do @@ -223,10 +222,10 @@ copyFileToDir _ _ = return () -- |Copies a file, directory or symlink. In case of a symlink, it is just -- recreated, even if it points to a directory. easyCopy :: DirCopyMode - -> AnchoredFile FileInfo FileInfo - -> AnchoredFile FileInfo FileInfo + -> AnchoredFile FileInfo + -> AnchoredFile FileInfo -> IO () -easyCopy _ from@(IsSymL True) to@(_ :/ Dir {}) = recreateSymlink from to +easyCopy _ from@(_ :/ SymLink {}) to@(_ :/ Dir {}) = recreateSymlink from to easyCopy _ from@(_ :/ RegFile fn _) to@(_ :/ Dir {}) = copyFileToDir from to @@ -249,8 +248,8 @@ easyCopy _ _ _ = return () -- |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 +moveFile :: AnchoredFile FileInfo -- ^ file to move + -> AnchoredFile FileInfo -- ^ base target directory -> IO () moveFile from@SymlOrRegFile to@(_ :/ Dir {}) = do let from' = fullPath from @@ -262,10 +261,10 @@ 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 +moveDir :: AnchoredFile FileInfo -- ^ dir to move + -> AnchoredFile FileInfo -- ^ base target directory -> IO () -moveDir (IsSymL True) _ = return () +moveDir (_ :/ SymLink {}) _ = return () moveDir from@(_ :/ Dir n _) to@(_ :/ Dir {}) = do let from' = fullPath from to' = fullPath to n @@ -276,10 +275,10 @@ 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 +easyMove :: AnchoredFile FileInfo -- ^ source + -> AnchoredFile FileInfo -- ^ base target directory -> IO () -easyMove from@(IsSymL True) to@(_ :/ Dir {}) = moveFile from to +easyMove from@(_ :/ SymLink {}) to@(_ :/ Dir {}) = moveFile from to easyMove from@(_ :/ RegFile _ _) to@(_ :/ Dir {}) = moveFile from to easyMove from@(_ :/ Dir _ _) to@(_ :/ Dir {}) = moveDir from to easyMove _ _ = return () @@ -292,16 +291,16 @@ easyMove _ _ = return () -- |Deletes a symlink, which can either point to a file or directory. -deleteSymlink :: AnchoredFile FileInfo FileInfo -> IO () -deleteSymlink f@(IsSymL True) +deleteSymlink :: AnchoredFile FileInfo -> IO () +deleteSymlink f@(_ :/ SymLink {}) = removeFile (fullPath f) deleteSymlink _ = return () -- |Deletes the given file, never symlinks. -deleteFile :: AnchoredFile FileInfo FileInfo -> IO () -deleteFile (IsSymL True) = return () +deleteFile :: AnchoredFile FileInfo -> IO () +deleteFile (_ :/ SymLink {}) = return () deleteFile f@(_ :/ RegFile {}) = removeFile (fullPath f) deleteFile _ @@ -309,16 +308,16 @@ deleteFile _ -- |Deletes the given directory, never symlinks. -deleteDir :: AnchoredFile FileInfo FileInfo -> IO () -deleteDir (IsSymL True) = return () +deleteDir :: AnchoredFile FileInfo -> IO () +deleteDir (_ :/ SymLink {}) = return () deleteDir f@(_ :/ Dir {}) = removeDirectory (fullPath f) deleteDir _ = return () -- |Deletes the given directory recursively, never symlinks. -deleteDirRecursive :: AnchoredFile FileInfo FileInfo -> IO () -deleteDirRecursive (IsSymL True) = return () +deleteDirRecursive :: AnchoredFile FileInfo -> IO () +deleteDirRecursive (_ :/ SymLink {}) = return () deleteDirRecursive f@(_ :/ Dir {}) = removeDirectoryRecursive (fullPath f) deleteDirRecursive _ = return () @@ -327,8 +326,8 @@ deleteDirRecursive _ = return () -- |Deletes a file, directory or symlink, whatever it may be. -- In case of directory, performs recursive deletion. In case of -- a symlink, the symlink file is deleted. -easyDelete :: AnchoredFile FileInfo FileInfo -> IO () -easyDelete f@(IsSymL True) = deleteSymlink f +easyDelete :: AnchoredFile FileInfo -> IO () +easyDelete f@(_ :/ SymLink {}) = deleteSymlink f easyDelete f@(_ :/ RegFile {}) = deleteFile f easyDelete f@(_ :/ Dir {}) @@ -345,16 +344,15 @@ easyDelete _ -- |Opens a file appropriately by invoking xdg-open. -openFile :: AnchoredFile a b +openFile :: AnchoredFile a -> IO ProcessHandle openFile f = spawnProcess "xdg-open" [fullPath f] -- |Executes a program with the given arguments. -executeFile :: AnchoredFile FileInfo FileInfo -- ^ program +executeFile :: AnchoredFile FileInfo -- ^ program -> [String] -- ^ arguments -> IO (Maybe ProcessHandle) -executeFile prog@(_ :/ RegFile _ FileInfo { permissions = perms }) args - | executable perms = Just <$> spawnProcess (fullPath prog) args - | otherwise = return Nothing +executeFile prog@(_ :/ RegFile {}) args + = Just <$> spawnProcess (fullPath prog) args executeFile _ _ = return Nothing