LIB/GTK: remove obsolete fullPath/fullPathS and refactor for prettiness

src/HSFM/FileSystem/FileOperations.hs

@@ -223,13 +223,11 @@ copyDir       (Rename fn)
            _
   = copyDir Strict from to fn
 -- this branch must never get `Rename` as CopyMode
-copyDir cm from@Dir{}
+copyDir cm from@Dir{ path = fromp }
-             to@Dir{}
+             to@Dir{ path = top }
              fn
   = do
-    let fromp    = fullPath from
+    let destdirp = top P.</> fn
-        top      = fullPath to
-        destdirp = top P.</> fn
     -- for performance, sanity checks are only done for the top dir
     throwDestinationInSource fromp destdirp
     throwSameFile fromp destdirp
@@ -238,25 +236,26 @@ copyDir cm from@Dir{}
     go cm from to fn
   where
     go :: CopyMode -> File a -> File a -> Path Fn -> IO ()
-    go cm' from'@Dir{}
+    go cm' Dir{ path = fromp' }
-             to'@Dir{}
+           Dir{ path = top' }
-             fn' = do
+           fn' = do
-      fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fullPathS from')
+      fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus
-      createDestdir (fullPath to' P.</> fn') fmode'
+                                   (P.fromAbs fromp')
+      createDestdir (top' P.</> fn') fmode'
       destdir <- readFile (\_ -> return undefined)
-                   (fullPath to' P.</> fn')
+                   (top' P.</> fn')
       contents <- readDirectoryContents
-                    (\_ -> return undefined) (fullPath from')
+                    (\_ -> return undefined) fromp'
 
       for_ contents $ \f ->
         case f of
-          SymLink{}  -> recreateSymlink cm' f destdir
+          SymLink{ path = fp' }  -> recreateSymlink cm' f destdir
-                          =<< (P.basename . path $ f)
+                                      =<< (P.basename fp')
-          Dir{}      -> go cm' f destdir
+          Dir{ path = fp' }      -> go cm' f destdir
-                          =<< (P.basename . path $ f)
+                                      =<< (P.basename fp')
-          RegFile{}  -> unsafeCopyFile Replace f destdir
+          RegFile{ path = fp' }  -> unsafeCopyFile Replace f destdir
-                          =<< (P.basename . path $ f)
+                                      =<< (P.basename fp')
-          _                  -> return ()
+          _                      -> return ()
       where
         createDestdir destdir fmode' =
           let destdir' = P.toFilePath destdir
@@ -287,11 +286,11 @@ recreateSymlink :: CopyMode
                 -> IO ()
 recreateSymlink (Rename pn) symf@SymLink{} symdest@Dir{} _
   = recreateSymlink Strict symf symdest pn
-recreateSymlink cm symf@SymLink{} symdest@Dir{} fn
+recreateSymlink cm SymLink{ path = sfp } Dir{ path = sdp } fn
   = do
-    throwCantOpenDirectory $ fullPath symdest
+    throwCantOpenDirectory sdp
-    sympoint <- readSymbolicLink (fullPathS symf)
+    sympoint <- readSymbolicLink (P.fromAbs sfp)
-    let symname = fullPath symdest P.</> fn
+    let symname = sdp P.</> fn
     case cm of
       Merge   -> delOld symname
       Replace -> delOld symname
@@ -314,13 +313,13 @@ copyFile :: CopyMode
          -> IO ()
 copyFile (Rename pn) from@RegFile{} to@Dir{} _
   = copyFile Strict from to pn
-copyFile cm from@RegFile{} to@Dir{} fn
+copyFile cm from@RegFile{ path = fromp }
+             tod@Dir{ path = todp } fn
   = do
-    let to'   = fullPath to P.</> fn
+    throwCantOpenDirectory todp
-    throwCantOpenDirectory $ fullPath to
+    throwCantOpenDirectory . P.dirname $ fromp
-    throwCantOpenDirectory . P.dirname . fullPath $ from
+    throwSameFile fromp (todp P.</> fn)
-    throwSameFile (fullPath from) to'
+    unsafeCopyFile cm from tod fn
-    unsafeCopyFile cm from to fn
 copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -335,19 +334,21 @@ unsafeCopyFile :: CopyMode
                -> IO ()
 unsafeCopyFile (Rename pn) from@RegFile{} to@Dir{} _
   = copyFile Strict from to pn
-unsafeCopyFile cm from@RegFile{} to@Dir{} fn
+unsafeCopyFile cm RegFile{ path = fromp }
+                  Dir{ path = todp } fn
   = do
-    let to'   = fullPath to P.</> fn
+    let to = todp P.</> fn
     case cm of
-      Strict -> throwFileDoesExist to'
+      Strict -> throwFileDoesExist to
       _      -> return ()
 
     -- from sendfile(2) manpage:
     --   Applications  may  wish  to  fall back to read(2)/write(2) in the case
     --   where sendfile() fails with EINVAL or ENOSYS.
-    catchErrno [eINVAL, eNOSYS]
+    P.withAbsPath to $ \to' -> P.withAbsPath fromp $ \from' ->
-               (sendFileCopy (fullPathS from) (P.fromAbs to'))
+      catchErrno [eINVAL, eNOSYS]
-               (void $ fallbackCopy (fullPathS from) (P.fromAbs to'))
+                 (sendFileCopy from' to')
+                 (void $ fallbackCopy from' to')
   where
     -- this is low-level stuff utilizing sendfile(2) for speed
     sendFileCopy source dest =
@@ -417,45 +418,43 @@ easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
 
 -- |Deletes a symlink, which can either point to a file or directory.
 deleteSymlink :: File a -> IO ()
-deleteSymlink f@SymLink{}
+deleteSymlink SymLink{ path = fp }
-  = removeLink (P.toFilePath . fullPath $ f)
+  = P.withAbsPath fp removeLink
 deleteSymlink _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given regular file, never symlinks.
 deleteFile :: File a -> IO ()
-deleteFile f@RegFile{}
+deleteFile RegFile{ path = fp }
-  = removeLink (P.toFilePath . fullPath $ f)
+  = P.withAbsPath fp removeLink
 deleteFile _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given directory, never symlinks.
 deleteDir :: File a -> IO ()
-deleteDir f@Dir{}
+deleteDir Dir{ path = fp }
-  = removeDirectory (P.toFilePath . fullPath $ f)
+  = P.withAbsPath fp removeDirectory
 deleteDir _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given directory recursively.
 deleteDirRecursive :: File a -> IO ()
-deleteDirRecursive f'@Dir{} = do
+deleteDirRecursive f'@Dir{ path = fp' } = do
-  let fp = fullPath f'
+  throwCantOpenDirectory fp'
-  throwCantOpenDirectory fp
   go f'
   where
     go :: File a -> IO ()
-    go f@Dir{} = do
+    go Dir{ path = fp } = do
-      let fp = fullPath f
       files <- readDirectoryContents
                  (\_ -> return undefined) fp
       for_ files $ \file ->
         case file of
           SymLink{} -> deleteSymlink file
           Dir{}     -> go file
-          RegFile{} -> removeLink (P.toFilePath . fullPath $ file)
+          RegFile{ path = rfp }
-          _                 -> throw $ FileDoesExist
+                    -> P.withAbsPath rfp removeLink
-                                       (P.toFilePath . fullPath
+          _         -> throw $ FileDoesExist
-                                                     $ file)
+                               (P.toFilePath . path $ file)
       removeDirectory . P.toFilePath $ fp
     go _ = throw $ InvalidOperation "wrong input type"
 deleteDirRecursive _ = throw $ InvalidOperation "wrong input type"
@@ -485,17 +484,22 @@ easyDelete _ = throw $ InvalidOperation "wrong input type"
 openFile :: File a
          -> IO ProcessID
 openFile f =
-  SPP.forkProcess $ SPP.executeFile "xdg-open" True [fullPathS f] Nothing
+  P.withAbsPath (path f) $ \fp ->
+    SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
 
 
 -- |Executes a program with the given arguments.
 executeFile :: File a  -- ^ program
             -> [ByteString]    -- ^ arguments
             -> IO ProcessID
-executeFile prog@RegFile{} args
+executeFile RegFile{ path = fp } args
-  = SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
+  = P.withAbsPath fp $ \fpb ->
-executeFile prog@SymLink{ sdest = RegFile{} } args
+      SPP.forkProcess
-  = SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
+      $ SPP.executeFile fpb True args Nothing
+executeFile SymLink{ path = fp, sdest = RegFile{} } args
+  = P.withAbsPath fp $ \fpb ->
+      SPP.forkProcess
+      $ SPP.executeFile fpb True args Nothing
 executeFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -509,7 +513,7 @@ executeFile _ _ = throw $ InvalidOperation "wrong input type"
 -- |Create an empty regular file at the given directory with the given filename.
 createFile :: File FileInfo -> Path Fn -> IO ()
 createFile (DirOrSym td) fn = do
-  let fullp = fullPath td P.</> fn
+  let fullp = path td P.</> fn
   throwFileDoesExist fullp
   fd <- SPI.createFile (P.fromAbs fullp) newFilePerms
   SPI.closeFd fd
@@ -519,7 +523,7 @@ createFile _ _ = throw $ InvalidOperation "wrong input type"
 -- |Create an empty directory at the given directory with the given filename.
 createDir :: File FileInfo -> Path Fn -> IO ()
 createDir (DirOrSym td) fn = do
-  let fullp = fullPath td P.</> fn
+  let fullp = path td P.</> fn
   throwDirDoesExist fullp
   createDirectory (P.fromAbs fullp) newFilePerms
 createDir _ _ = throw $ InvalidOperation "wrong input type"
@@ -535,7 +539,7 @@ createDir _ _ = throw $ InvalidOperation "wrong input type"
 -- |Rename a given file with the provided filename.
 renameFile :: File a -> Path Fn -> IO ()
 renameFile af fn = do
-  let fromf = fullPath af
+  let fromf = path af
       tof   = (P.dirname . path $ af) P.</> fn
   throwFileDoesExist tof
   throwSameFile fromf tof
@@ -551,10 +555,10 @@ moveFile :: CopyMode
 moveFile (Rename pn) from to@Dir{} _ =
   moveFile Strict from to pn
 moveFile cm from to@Dir{} fn = do
-  let from'  = fullPath from
+  let from'  = path from
-      froms' = fullPathS from
+      froms' = P.fromAbs from'
-      to'    = fullPath to P.</> fn
+      to'    = path to P.</> fn
-      tos'   = P.fromAbs (fullPath to P.</> fn)
+      tos'   = P.fromAbs to'
   case cm of
     Strict   -> throwFileDoesExist to'
     Merge    -> delOld to'

src/HSFM/FileSystem/FileType.hs

@@ -346,7 +346,7 @@ getContents :: (Path Abs -> IO a)
             -> File FileInfo
             -> IO [File a]
 getContents ff (DirOrSym af)
-  = readDirectoryContents ff (fullPath af)
+  = readDirectoryContents ff (path af)
 getContents _ _ = return []
 
 
@@ -464,12 +464,13 @@ isSocketC _        = False
 -- |Gets all filenames of the given directory. This excludes "." and "..".
 getDirsFiles :: Path Abs        -- ^ dir to read
              -> IO [Path Abs]
-getDirsFiles fp =
+getDirsFiles p =
-  rethrowErrnoAs [eACCES] (Can'tOpenDirectory . P.fromAbs $ fp)
+  P.withAbsPath p $ \fp ->
-  $ return
+    rethrowErrnoAs [eACCES] (Can'tOpenDirectory fp)
-      . catMaybes
+    $ return
-      .   fmap (\x -> (P.</>) fp <$> (parseMaybe . snd $ x))
+        . catMaybes
-      =<< getDirectoryContents (P.toFilePath fp)
+        .   fmap (\x -> (P.</>) p <$> (parseMaybe . snd $ x))
+        =<< getDirectoryContents fp
   where
     parseMaybe :: ByteString -> Maybe (Path Fn)
     parseMaybe = P.parseFn
@@ -543,6 +544,10 @@ fromFreeVar :: (Default d) => (a -> d) -> File a -> d
 fromFreeVar f df = maybeD f $ getFreeVar df
 
 
+getFPasStr :: File a -> String
+getFPasStr = P.fpToString . P.fromAbs . path
+
+
 -- |Gets the free variable. Returns Nothing if the constructor is of `Failed`.
 getFreeVar :: File a -> Maybe a
 getFreeVar (Dir _  d)         = Just d
@@ -555,16 +560,6 @@ getFreeVar (Socket _  d)      = Just d
 getFreeVar _                  = Nothing
 
 
--- |Get the full path of the file.
-fullPath :: File a -> Path Abs
-fullPath f = path f
-
-
--- |Get the full path of the file, converted to a `FilePath`.
-fullPathS :: File a -> ByteString
-fullPathS = P.fromAbs . fullPath
-
-
 -- |Pack the modification time into a string.
 packModTime :: File FileInfo
             -> String

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -239,7 +239,7 @@ open :: [Item] -> MyGUI -> MyView -> IO ()
 open [item] mygui myview = withErrorDialog $
   case item of
     DirOrSym r -> do
-      nv <- readFile getFileInfo $ fullPath r
+      nv <- readFile getFileInfo $ path r
       refreshView' mygui myview nv
     r ->
       void $ openFile r
@@ -263,7 +263,7 @@ execute _ _ _ = withErrorDialog
 -- |Supposed to be used with 'withRows'. Deletes a file or directory.
 del :: [Item] -> MyGUI -> MyView -> IO ()
 del [item] _ _ = withErrorDialog $ do
-  let cmsg  = "Really delete \"" ++ P.fpToString (fullPathS item) ++ "\"?"
+  let cmsg  = "Really delete \"" ++ getFPasStr item ++ "\"?"
   withConfirmationDialog cmsg
     $ easyDelete item
 -- this throws on the first error that occurs
@@ -279,9 +279,9 @@ del _ _ _ = withErrorDialog
 -- |Initializes a file move operation.
 moveInit :: [Item] -> MyGUI -> MyView -> IO ()
 moveInit items@(_:_) mygui myview = do
-  writeTVarIO (operationBuffer myview) (FMove . MP1 . map fullPath $ items)
+  writeTVarIO (operationBuffer myview) (FMove . MP1 . map path $ items)
   let sbmsg = case items of
-              (item:[]) -> "Move buffer: " ++ P.fpToString (fullPathS item)
+              (item:[]) -> "Move buffer: " ++ getFPasStr item
               _         -> "Move buffer: " ++ (show . length $ items)
                                            ++ " items"
   popStatusbar mygui
@@ -293,9 +293,9 @@ 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 . map fullPath $ items)
+  writeTVarIO (operationBuffer myview) (FCopy . CP1 . map path $ items)
   let sbmsg = case items of
-              (item:[]) -> "Copy buffer: " ++ P.fpToString (fullPathS item)
+              (item:[]) -> "Copy buffer: " ++ getFPasStr item
               _         -> "Copy buffer: " ++ (show . length $ items)
                                            ++ " items"
   popStatusbar mygui
@@ -309,7 +309,7 @@ copyInit _ _ _ = withErrorDialog
 operationFinal :: MyGUI -> MyView -> IO ()
 operationFinal _ myview = withErrorDialog $ do
   op <- readTVarIO (operationBuffer myview)
-  cdir <- fullPath <$> getCurrentDir myview
+  cdir <- path <$> getCurrentDir myview
   case op of
     FMove (MP1 s) -> do
       let cmsg = "Really move " ++ imsg s
@@ -355,7 +355,7 @@ renameF [item] _ _ = withErrorDialog $ do
   mfn  <- textInputDialog "Enter new file name"
   let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
   for_ pmfn $ \fn -> do
-    let cmsg = "Really rename \"" ++ P.fpToString (fullPathS item)
+    let cmsg = "Really rename \"" ++ getFPasStr item
                ++ "\"" ++ " to \""
                ++ P.fpToString (P.fromAbs $ (P.dirname . path $ item)
                                              P.</> fn) ++ "\"?"

src/HSFM/GUI/Gtk/MyView.hs

@@ -228,7 +228,7 @@ refreshView mygui myview mfp =
         ecd <- try (getCurrentDir myview) :: IO (Either SomeException
                                                      Item)
         case ecd of
-          Right dir -> return (Just $ fullPath dir)
+          Right dir -> return (Just $ path dir)
           Left _    -> return (P.parseAbs "/")