LIB/GTK: remove the rest of the directory package

hsfm.cabal

@@ -28,10 +28,10 @@ library
                        MyPrelude
 
   build-depends:       base >= 4.7,
+                       bytestring,
                        data-default,
                        bifunctors >= 5,
                        containers,
-                       directory >= 1.1.0.0 && < 1.2.3.0,
                        filepath >= 1.3.0.0,
                        hinotify,
                        mtl >= 2.2,
@@ -63,13 +63,13 @@ executable hsfm-gtk
 
   build-depends:       hsfm,
                        base >= 4.7,
+                       bytestring,
                        Cabal >= 1.22.0.0,
                        containers,
                        data-default,
                        gtk3 >= 0.14.1,
                        glib >= 0.13,
                        bifunctors >= 5,
-                       directory >= 1.1.0.0 && < 1.2.3.0,
                        filepath >= 1.3.0.0,
                        hinotify,
                        mtl >= 2.2,

src/Data/DirTree.hs

@@ -86,10 +86,6 @@ import Safe
     atDef
   , initDef
   )
-import System.Directory
-  (
-    canonicalizePath
-  )
 import System.FilePath
   (
     combine
@@ -605,18 +601,6 @@ normalize fp =
     ff x y        = x ++ [y]
 
 
--- |Like `canonicalizePath` from System.Directory, but preserves the last
--- component if it's a symlink.
-canonicalizePath' :: FilePath -> IO FilePath
-canonicalizePath' fp = do
-  -- TODO: throw fileDoesNotExist error earlier
-  isSymlink <- PF.isSymbolicLink <$> PF.getSymbolicLinkStatus fp
-  if isSymlink
-    then do
-         cbase <- canonicalizePath (baseDir fp)
-         return $ cbase </> topDir fp
-    else canonicalizePath fp
-
 
 ---- IO HELPERS: ----
 

src/GUI/Gtk.hs

@@ -88,11 +88,6 @@ import Safe
   (
     headDef
   )
-import System.Directory
-  (
-    doesFileExist
-  , doesDirectoryExist
-  )
 import System.Environment
   (
     getArgs

src/GUI/Gtk/Callbacks.hs

@@ -57,11 +57,6 @@ import GUI.Gtk.Utils
 import IO.Error
 import IO.File
 import IO.Utils
-import System.Directory
-  (
-    doesFileExist
-  , doesDirectoryExist
-  )
 import System.FilePath
   (
     isAbsolute

src/IO/Error.hs

@@ -45,11 +45,6 @@ import Foreign.C.Error
   , Errno
   )
 import IO.Utils
-import System.Directory
-  (
-    doesDirectoryExist
-  , doesFileExist
-  )
 import System.FilePath
   (
     equalFilePath
@@ -151,3 +146,26 @@ catchErrno en a1 a2 =
     if errno == en
       then a2
       else ioError e
+
+
+handleIOError :: (IOError -> IO a) -> IO a -> IO a
+handleIOError a1 a2 = catchIOError a2 a1
+
+
+-- |Checks if the given file exists and is not a directory. This follows
+-- symlinks, but will return True if the symlink is broken.
+doesFileExist :: FilePath -> IO Bool
+doesFileExist fp =
+  handleIOError (\_ -> return False) $ do
+    fs <- catchIOError (PF.getFileStatus fp) $ \_ ->
+      PF.getSymbolicLinkStatus fp
+    return $ not . PF.isDirectory $ fs
+
+
+-- |Checks if the given file exists and is a directory. This follows
+-- symlinks, but will return False if the symlink is broken.
+doesDirectoryExist :: FilePath -> IO Bool
+doesDirectoryExist fp =
+  handleIOError (\_ -> return False) $ do
+    fs <- PF.getFileStatus fp
+    return $ PF.isDirectory fs

src/IO/File.hs

@@ -48,11 +48,6 @@ import Foreign.C.Error
   )
 import IO.Error
 import IO.Utils
-import System.Directory
-  (
-    doesDirectoryExist
-  , removeDirectoryRecursive
-  )
 import System.FilePath
   (
     (</>)
@@ -65,7 +60,9 @@ import System.Posix.Directory
 import System.Posix.Files
   (
     createSymbolicLink
+  , fileMode
   , readSymbolicLink
+  , getSymbolicLinkStatus
   , groupExecuteMode
   , groupReadMode
   , groupWriteMode
@@ -94,7 +91,7 @@ import System.Process
   , ProcessHandle
   )
 
-import qualified System.Directory as SD
+import qualified Data.ByteString  as BS
 
 
 
@@ -191,7 +188,8 @@ copyDir cm from@(_ :/ Dir fromn _)
           throwDirDoesExist destdir
           createDirectory destdir newDirPerms
         Replace -> do
-          whenM (doesDirectoryExist destdir) (removeDirectoryRecursive destdir)
+          whenM (doesDirectoryExist destdir)
+                (deleteDirRecursive =<< Data.DirTree.readFile destdir)
           createDirectory destdir newDirPerms
     recreateSymlink' f destdir = do
       let destfilep = fullPath destdir </> (name . file $ f)
@@ -219,6 +217,19 @@ recreateSymlink symf@(_ :/ SymLink {})
 recreateSymlink _ _ = throw $ InvalidOperation "wrong input type"
 
 
+-- |TODO: handle EAGAIN exception for non-blocking IO
+-- |Low-level function to copy a given file to the given path. The fileMode
+-- is preserved.
+copyFile' :: FilePath -> FilePath -> IO ()
+copyFile' from to = do
+  fromFstatus <- getSymbolicLinkStatus from
+  fromContent <- BS.readFile from
+  fd          <- System.Posix.IO.createFile to
+                   (System.Posix.Files.fileMode fromFstatus)
+  closeFd fd
+  BS.writeFile to fromContent
+
+
 -- |Copies the given file to the given file destination.
 -- Excludes symlinks.
 copyFile :: AnchoredFile FileInfo  -- ^ source file
@@ -229,7 +240,7 @@ copyFile from@(_ :/ RegFile {}) to@(_ :/ RegFile {}) = do
   let from' = fullPath from
       to'   = fullPath to
   throwSameFile from' to'
-  SD.copyFile from' to'
+  copyFile' from' to'
 copyFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -244,7 +255,7 @@ copyFileToDir from@(_ :/ RegFile fn _)
   do
     let from' = fullPath from
         to'   = fullPath to </> fn
-    SD.copyFile from' to'
+    copyFile' from' to'
 copyFileToDir _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -298,11 +309,17 @@ deleteDir f@(_ :/ Dir {})
 deleteDir _ = throw $ InvalidOperation "wrong input type"
 
 
--- |Deletes the given directory recursively, never symlinks.
+-- |Deletes the given directory recursively.
 deleteDirRecursive :: AnchoredFile FileInfo -> IO ()
-deleteDirRecursive   (_ :/ SymLink {}) = return ()
-deleteDirRecursive f@(_ :/ Dir {})
-  = removeDirectoryRecursive (fullPath f)
+deleteDirRecursive f@(_ :/ Dir {}) = do
+  let fp = fullPath f
+  files <- readDirectory' fp
+  for_ files $ \file ->
+    case file of
+      (_ :/ SymLink {}) -> deleteSymlink file
+      (_ :/ Dir {})     -> deleteDirRecursive file
+      (_ :/ f)          -> removeLink (fullPath file)
+  removeDirectory fp
 deleteDirRecursive _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -422,4 +439,3 @@ newDirPerms
     `unionFileModes` groupReadMode
     `unionFileModes` otherExecuteMode
     `unionFileModes` otherReadMode
-