LIB/GTK: refactor File base type

We have now ditched AnchoredFile and just use File with Path Abs
in the path field.

This is useful since we now:
* don't allow "." or ".." as filenames anymore
* normalise paths in our path parsers and reject paths with ".."

This also allows us to know that filepaths are always valid. In addition
the 'basename' function from hpath may throw an exception if run
on the root dir "/". This exception is basically uncatched currently,
which is fine, because it's not a selectable directory.

3rdparty/hpath

@@ -1 +1 @@
-Subproject commit c570505297f22fda08248dae66072c9bff9ce607
+Subproject commit 577ecf67508839c485df10335583a625fcf88bc4

src/HSFM/FileSystem/Errors.hs

@@ -144,7 +144,7 @@ throwSameFile fp1 fp2 = do
   --       canonicalize `dirname fp2`
   fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
                        (\_ -> fmap P.fromAbs
-                              $ (P.</> P.basename fp2)
+                       $ (\x -> maybe x (\y -> x P.</> y) $ P.basename fp2)
                                 <$> (P.canonicalizePath $ P.dirname fp2))
   when (P.equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
 
@@ -159,7 +159,8 @@ throwDestinationInSource :: Path Abs -- ^ source dir
                          -> IO ()
 throwDestinationInSource source dest = do
   source' <- P.canonicalizePath source
-  dest'   <- (P.</> P.basename dest) <$> (P.canonicalizePath $ P.dirname dest)
+  dest'   <- (\x -> maybe x (\y -> x P.</> y) $ P.basename dest)
+             <$> (P.canonicalizePath $ P.dirname dest)
   dids <- forM (P.getAllParents dest') $ \p -> do
           fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
           return (PF.deviceID fs, PF.fileID fs)

src/HSFM/FileSystem/FileOperations.hs

@@ -171,7 +171,7 @@ data CopyMode = Strict  -- ^ fail if the target already exists
 -- be returned. Returns `Nothing` on success.
 --
 -- Since file operations can be delayed, this is `Path Abs` based, not
--- `AnchoredFile` based. This makes sure we don't have stale
+-- `File` based. This makes sure we don't have stale
 -- file information.
 runFileOp :: FileOperation -> IO (Maybe FileOperation)
 runFileOp fo' =
@@ -179,7 +179,7 @@ runFileOp fo' =
     (FCopy (CC froms to cm)) -> do
       froms' <- mapM toAfile froms
       to'    <- toAfile to
-      when (anyFailed $ file <$> froms')
+      when (anyFailed froms')
            (throw . CopyFailed $ "File in copy buffer does not exist anymore!")
       mapM_ (\x -> easyCopy cm x to') froms'
         >> return Nothing
@@ -187,7 +187,7 @@ runFileOp fo' =
     (FMove (MC froms to cm)) -> do
       froms' <- mapM toAfile froms
       to'   <- toAfile to
-      when (anyFailed $ file <$> froms')
+      when (anyFailed froms')
            (throw . MoveFailed $ "File in move buffer does not exist anymore!")
       mapM_ (\x -> easyMove cm x to') froms'
         >> return Nothing
@@ -213,21 +213,18 @@ runFileOp fo' =
 -- |Copies a directory to the given destination with the specified
 -- `DirCopyMode`. Excludes symlinks.
 copyDir :: CopyMode
-        -> AnchoredFile a  -- ^ source dir
+        -> File a  -- ^ source dir
-        -> AnchoredFile a  -- ^ destination dir
+        -> File a  -- ^ destination dir
         -> Path Fn -- ^ destination dir name
         -> IO ()
-copyDir _ AFileInvFN _ _ = throw InvalidFileName
-copyDir _ _ AFileInvFN _ = throw InvalidFileName
-copyDir _ _ _ InvFN      = throw InvalidFileName
 copyDir       (Rename fn)
-         from@(_ :/ Dir {})
+         from@Dir{}
-           to@(_ :/ Dir {})
+           to@Dir{}
            _
   = copyDir Strict from to fn
 -- this branch must never get `Rename` as CopyMode
-copyDir cm from@(_ :/ Dir {})
+copyDir cm from@Dir{}
-             to@(_ :/ Dir {})
+             to@Dir{}
              fn
   = do
     let fromp    = fullPath from
@@ -240,23 +237,25 @@ copyDir cm from@(_ :/ Dir {})
     throwCantOpenDirectory top
     go cm from to fn
   where
-    go :: CopyMode -> AnchoredFile a -> AnchoredFile a -> Path Fn -> IO ()
+    go :: CopyMode -> File a -> File a -> Path Fn -> IO ()
-    go cm' from'@(_ :/ Dir {})
+    go cm' from'@Dir{}
-             to'@(_ :/ Dir {})
+             to'@Dir{}
              fn' = do
       fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fullPathS from')
       createDestdir (fullPath to' P.</> fn') fmode'
-      destdir <- readFileUnsafe (\_ -> return undefined)
+      destdir <- readFile (\_ -> return undefined)
                    (fullPath to' P.</> fn')
-      contents <- readDirectoryContentsUnsafe
+      contents <- readDirectoryContents
-                    getDirsFiles (\_ -> return undefined) (fullPath from')
+                    (\_ -> return undefined) (fullPath from')
 
       for_ contents $ \f ->
         case f of
-          (_ :/ SymLink {})  -> recreateSymlink cm' f destdir (name . file $ f)
+          SymLink{}  -> recreateSymlink cm' f destdir
-          (_ :/ Dir {})      -> go cm' f destdir (name . file $ f)
+                          =<< (P.basename . path $ f)
-          (_ :/ RegFile {})  -> unsafeCopyFile Replace f destdir
+          Dir{}      -> go cm' f destdir
-                                               (name . file $ f)
+                          =<< (P.basename . path $ f)
+          RegFile{}  -> unsafeCopyFile Replace f destdir
+                          =<< (P.basename . path $ f)
           _                  -> return ()
       where
         createDestdir destdir fmode' =
@@ -271,7 +270,7 @@ copyDir cm from@(_ :/ Dir {})
             Replace -> do
               whenM (doesDirectoryExist destdir)
                     (deleteDirRecursive =<<
-                       readFileUnsafe
+                       readFile
                          (\_ -> return undefined) destdir)
               createDirectory destdir' fmode'
             _ -> throw $ InvalidOperation "Internal error, wrong CopyMode!"
@@ -281,17 +280,14 @@ copyDir _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 -- |Recreate a symlink.
 recreateSymlink :: CopyMode
-                -> AnchoredFile a  -- ^ the old symlink file
+                -> File a  -- ^ the old symlink file
-                -> AnchoredFile a  -- ^ destination dir of the
+                -> File a  -- ^ destination dir of the
                            --   new symlink file
                 -> Path Fn -- ^ destination file name
                 -> IO ()
-recreateSymlink _ AFileInvFN _ _ = throw InvalidFileName
+recreateSymlink (Rename pn) symf@SymLink{} symdest@Dir{} _
-recreateSymlink _ _ AFileInvFN _ = throw InvalidFileName
-recreateSymlink _ _ _ InvFN      = throw InvalidFileName
-recreateSymlink (Rename pn) symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) _
   = recreateSymlink Strict symf symdest pn
-recreateSymlink cm symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) fn
+recreateSymlink cm symf@SymLink{} symdest@Dir{} fn
   = do
     throwCantOpenDirectory $ fullPath symdest
     sympoint <- readSymbolicLink (fullPathS symf)
@@ -303,8 +299,8 @@ recreateSymlink cm symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) fn
     createSymbolicLink sympoint (P.fromAbs symname)
   where
     delOld symname = do
-      f <- readFileUnsafe (\_ -> return undefined) symname
+      f <- readFile (\_ -> return undefined) symname
-      unless (failed . file $ f)
+      unless (failed f)
              (easyDelete f)
 recreateSymlink _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
@@ -312,16 +308,13 @@ recreateSymlink _ _ _ _ = throw $ InvalidOperation "wrong input type"
 -- |Copies the given regular file to the given dir with the given filename.
 -- Excludes symlinks.
 copyFile :: CopyMode
-         -> AnchoredFile a  -- ^ source file
+         -> File a  -- ^ source file
-         -> AnchoredFile a  -- ^ destination dir
+         -> File a  -- ^ destination dir
          -> Path Fn -- ^ destination file name
          -> IO ()
-copyFile _ AFileInvFN _ _ = throw InvalidFileName
+copyFile (Rename pn) from@RegFile{} to@Dir{} _
-copyFile _ _ AFileInvFN _ = throw InvalidFileName
-copyFile _ _ _ InvFN      = throw InvalidFileName
-copyFile (Rename pn) from@(_ :/ RegFile {}) to@(_ :/ Dir {}) _
   = copyFile Strict from to pn
-copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
+copyFile cm from@RegFile{} to@Dir{} fn
   = do
     let to'   = fullPath to P.</> fn
     throwCantOpenDirectory $ fullPath to
@@ -336,16 +329,13 @@ copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 -- It's also used for cases where we don't need/want sanity checks
 -- and need the extra bit of performance.
 unsafeCopyFile :: CopyMode
-               -> AnchoredFile a  -- ^ source file
+               -> File a  -- ^ source file
-               -> AnchoredFile a  -- ^ destination dir
+               -> File a  -- ^ destination dir
                -> Path Fn -- ^ destination file name
                -> IO ()
-unsafeCopyFile _ AFileInvFN _ _ = throw InvalidFileName
+unsafeCopyFile (Rename pn) from@RegFile{} to@Dir{} _
-unsafeCopyFile _ _ AFileInvFN _ = throw InvalidFileName
-unsafeCopyFile _ _ _ InvFN      = throw InvalidFileName
-unsafeCopyFile (Rename pn) from@(_ :/ RegFile {}) to@(_ :/ Dir {}) _
   = copyFile Strict from to pn
-unsafeCopyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
+unsafeCopyFile cm from@RegFile{} to@Dir{} fn
   = do
     let to'   = fullPath to P.</> fn
     case cm of
@@ -402,18 +392,18 @@ unsafeCopyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 -- |Copies a regular file, directory or symlink. In case of a symlink,
 -- it is just recreated, even if it points to a directory.
 easyCopy :: CopyMode
-         -> AnchoredFile a
+         -> File a
-         -> AnchoredFile a
+         -> File a
          -> IO ()
-easyCopy cm from@(_ :/ SymLink{})
+easyCopy cm from@SymLink{}
-              to@(_ :/ Dir{})
+              to@Dir{}
-  = recreateSymlink cm from to (name . file $ from)
+  = recreateSymlink cm from to =<< (P.basename . path $ from)
-easyCopy cm from@(_ :/ RegFile{})
+easyCopy cm from@RegFile{}
-              to@(_ :/ Dir{})
+              to@Dir{}
-  = copyFile cm from to (name . file $ from)
+  = copyFile cm from to =<< (P.basename . path $ from)
-easyCopy cm from@(_ :/ Dir{})
+easyCopy cm from@Dir{}
-              to@(_ :/ Dir{})
+              to@Dir{}
-  = copyDir cm from to (name . file $ from)
+  = copyDir cm from to =<< (P.basename . path $ from)
 easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -426,47 +416,43 @@ easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes a symlink, which can either point to a file or directory.
-deleteSymlink :: AnchoredFile a -> IO ()
+deleteSymlink :: File a -> IO ()
-deleteSymlink AFileInvFN = throw InvalidFileName
+deleteSymlink f@SymLink{}
-deleteSymlink f@(_ :/ SymLink {})
   = removeLink (P.toFilePath . fullPath $ f)
 deleteSymlink _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given regular file, never symlinks.
-deleteFile :: AnchoredFile a -> IO ()
+deleteFile :: File a -> IO ()
-deleteFile AFileInvFN = throw InvalidFileName
+deleteFile f@RegFile{}
-deleteFile f@(_ :/ RegFile {})
   = removeLink (P.toFilePath . fullPath $ f)
 deleteFile _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given directory, never symlinks.
-deleteDir :: AnchoredFile a -> IO ()
+deleteDir :: File a -> IO ()
-deleteDir AFileInvFN = throw InvalidFileName
+deleteDir f@Dir{}
-deleteDir f@(_ :/ Dir {})
   = removeDirectory (P.toFilePath . fullPath $ f)
 deleteDir _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given directory recursively.
-deleteDirRecursive :: AnchoredFile a -> IO ()
+deleteDirRecursive :: File a -> IO ()
-deleteDirRecursive AFileInvFN = throw InvalidFileName
+deleteDirRecursive f'@Dir{} = do
-deleteDirRecursive f'@(_ :/ Dir {}) = do
   let fp = fullPath f'
   throwCantOpenDirectory fp
   go f'
   where
-    go :: AnchoredFile a -> IO ()
+    go :: File a -> IO ()
-    go f@(_ :/ Dir {}) = do
+    go f@Dir{} = do
       let fp = fullPath f
-      files <- readDirectoryContentsUnsafe getDirsFiles
+      files <- readDirectoryContents
                  (\_ -> return undefined) fp
       for_ files $ \file ->
         case file of
-          (_ :/ SymLink {}) -> deleteSymlink file
+          SymLink{} -> deleteSymlink file
-          (_ :/ Dir {})     -> go file
+          Dir{}     -> go file
-          (_ :/ RegFile {}) -> removeLink (P.toFilePath . fullPath $ file)
+          RegFile{} -> removeLink (P.toFilePath . fullPath $ file)
           _                 -> throw $ FileDoesExist
                                        (P.toFilePath . fullPath
                                                      $ file)
@@ -478,11 +464,11 @@ deleteDirRecursive _ = throw $ InvalidOperation "wrong input type"
 -- |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 a -> IO ()
+easyDelete :: File a -> IO ()
-easyDelete f@(_ :/ SymLink {}) = deleteSymlink f
+easyDelete f@SymLink{} = deleteSymlink f
-easyDelete f@(_ :/ RegFile {})
+easyDelete f@RegFile{}
   = deleteFile f
-easyDelete f@(_ :/ Dir {})
+easyDelete f@Dir{}
   = deleteDirRecursive f
 easyDelete _ = throw $ InvalidOperation "wrong input type"
 
@@ -496,21 +482,19 @@ easyDelete _ = throw $ InvalidOperation "wrong input type"
 
 -- |Opens a file appropriately by invoking xdg-open. The file type
 -- is not checked.
-openFile :: AnchoredFile a
+openFile :: File a
          -> IO ProcessID
-openFile AFileInvFN = throw InvalidFileName
 openFile f =
   SPP.forkProcess $ SPP.executeFile "xdg-open" True [fullPathS f] Nothing
 
 
 -- |Executes a program with the given arguments.
-executeFile :: AnchoredFile a  -- ^ program
+executeFile :: File a  -- ^ program
             -> [ByteString]    -- ^ arguments
             -> IO ProcessID
-executeFile AFileInvFN _ = throw InvalidFileName
+executeFile prog@RegFile{} args
-executeFile prog@(_ :/ RegFile {}) args
   = SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
-executeFile prog@(_ :/ SymLink { sdest = (_ :/ RegFile {}) }) args
+executeFile prog@SymLink{ sdest = RegFile{} } args
   = SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
 executeFile _ _ = throw $ InvalidOperation "wrong input type"
 
@@ -523,10 +507,8 @@ executeFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Create an empty regular file at the given directory with the given filename.
-createFile :: AnchoredFile FileInfo -> Path Fn -> IO ()
+createFile :: File FileInfo -> Path Fn -> IO ()
-createFile AFileInvFN _ = throw InvalidFileName
+createFile (DirOrSym td) fn = do
-createFile _ InvFN      = throw InvalidFileName
-createFile (ADirOrSym td) (ValFN fn) = do
   let fullp = fullPath td P.</> fn
   throwFileDoesExist fullp
   fd <- SPI.createFile (P.fromAbs fullp) newFilePerms
@@ -535,10 +517,8 @@ createFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Create an empty directory at the given directory with the given filename.
-createDir :: AnchoredFile FileInfo -> Path Fn -> IO ()
+createDir :: File FileInfo -> Path Fn -> IO ()
-createDir AFileInvFN _ = throw InvalidFileName
+createDir (DirOrSym td) fn = do
-createDir _ InvFN      = throw InvalidFileName
-createDir (ADirOrSym td) (ValFN fn) = do
   let fullp = fullPath td P.</> fn
   throwDirDoesExist fullp
   createDirectory (P.fromAbs fullp) newFilePerms
@@ -553,29 +533,24 @@ createDir _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Rename a given file with the provided filename.
-renameFile :: AnchoredFile a -> Path Fn -> IO ()
+renameFile :: File a -> Path Fn -> IO ()
-renameFile AFileInvFN _ = throw InvalidFileName
+renameFile af fn = do
-renameFile _ InvFN      = throw InvalidFileName
-renameFile af (ValFN fn) = do
   let fromf = fullPath af
-      tof   = anchor af P.</> fn
+      tof   = (P.dirname . path $ af) P.</> fn
   throwFileDoesExist tof
   throwSameFile fromf tof
   rename (P.fromAbs fromf) (P.fromAbs tof)
-renameFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Move a given file to the given target directory.
 moveFile :: CopyMode
-         -> AnchoredFile a -- ^ file to move
+         -> File a  -- ^ file to move
-         -> AnchoredFile a -- ^ base target directory
+         -> File a  -- ^ base target directory
          -> Path Fn -- ^ target file name
          -> IO ()
-moveFile _ AFileInvFN _ _ = throw InvalidFileName
+moveFile (Rename pn) from to@Dir{} _ =
-moveFile _ _ AFileInvFN _ = throw InvalidFileName
-moveFile (Rename pn) from to@(_ :/ Dir {}) _ =
   moveFile Strict from to pn
-moveFile cm from to@(_ :/ Dir {}) fn = do
+moveFile cm from to@Dir{} fn = do
   let from'  = fullPath from
       froms' = fullPathS from
       to'    = fullPath to P.</> fn
@@ -591,17 +566,17 @@ moveFile cm from to@(_ :/ Dir {}) fn = do
     easyDelete from
   where
     delOld fp = do
-      to' <- readFileUnsafe (\_ -> return undefined) fp
+      to' <- readFile (\_ -> return undefined) fp
-      unless (failed . file $ to') (easyDelete to')
+      unless (failed to') (easyDelete to')
 moveFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Like `moveFile` except it uses the filename of the source as target.
 easyMove :: CopyMode
-         -> AnchoredFile a -- ^ file to move
+         -> File a -- ^ file to move
-         -> AnchoredFile a -- ^ base target directory
+         -> File a -- ^ base target directory
          -> IO ()
-easyMove cm from to = moveFile cm from to (name . file $ from)
+easyMove cm from to = moveFile cm from to =<< (P.basename . path $ from)
 
 
 

src/HSFM/FileSystem/FileType.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 -- |This module provides data types for representing directories/files
@@ -49,8 +48,6 @@ import HPath
   (
     Abs
   , Path
-  , Fn
-  , pattern Path
   )
 import qualified HPath as P
 import HSFM.FileSystem.Errors
@@ -85,52 +82,45 @@ import System.Posix.Types
     ----------------------------
 
 
--- |Represents a file. The `anchor` field is the path
+-- |The String in the path field is always a full path.
--- to that file without the filename.
-data AnchoredFile a =
-  (:/) { anchor :: Path Abs, file :: File a }
-  deriving (Eq, Show)
-
-
--- |The String in the name field is always a file name, never a full path.
 -- The free type variable is used in the File/Dir constructor and can hold
 -- 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 =
     Failed {
-    name :: Path Fn
+    path :: Path Abs
   , err  :: IOError
   }
   | Dir {
-    name :: Path Fn
+    path :: Path Abs
   , fvar :: a
   }
   | RegFile {
-    name :: Path Fn
+    path :: Path Abs
   , fvar :: a
   }
   | SymLink {
-    name    :: Path Fn
+    path    :: Path Abs
   , fvar    :: a
-  , sdest   :: AnchoredFile a  -- ^ symlink madness,
+  , sdest   :: File a  -- ^ symlink madness,
                        --   we need to know where it points to
   , rawdest :: ByteString
   }
   | BlockDev {
-    name :: Path Fn
+    path :: Path Abs
   , fvar :: a
   }
   | CharDev {
-    name :: Path Fn
+    path :: Path Abs
   , fvar :: a
   }
   | NamedPipe {
-    name :: Path Fn
+    path :: Path Abs
   , fvar :: a
   }
   | Socket {
-    name :: Path Fn
+    path :: Path Abs
   , fvar :: a
   } deriving (Show, Eq)
 
@@ -161,24 +151,11 @@ data FileInfo = FileInfo {
     ------------------------------------
 
 
--- |Converts a viewpattern like function written for `File` to one
--- for `AnchoredFile`.
-convertViewP :: (File FileInfo -> (Bool, File FileInfo))
-             -> AnchoredFile FileInfo
-             -> (Bool, AnchoredFile FileInfo)
-convertViewP f (bp :/ constr) =
-  let (b, file) = f constr
-  in (b, bp :/ file)
-
 
 
 ---- Filetypes ----
 
 
-safileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
-safileLike f = convertViewP sfileLike f
-
-
 sfileLike :: File FileInfo -> (Bool, File FileInfo)
 sfileLike f@RegFile{}   = (True, f)
 sfileLike f@BlockDev{}  = (True, f)
@@ -188,10 +165,6 @@ sfileLike f@Socket{}    = (True, f)
 sfileLike f             = fileLikeSym f
 
 
-afileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
-afileLike f = convertViewP fileLike f
-
-
 fileLike :: File FileInfo -> (Bool, File FileInfo)
 fileLike f@RegFile {}  = (True, f)
 fileLike f@BlockDev{}  = (True, f)
@@ -201,122 +174,78 @@ fileLike f@Socket{}    = (True, f)
 fileLike f             = (False, f)
 
 
-sadir :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
-sadir f = convertViewP sdir f
-
-
 sdir :: File FileInfo -> (Bool, File FileInfo)
-sdir f@SymLink{ sdest = (_ :/ s@SymLink{} )}
+sdir f@SymLink{ sdest = (s@SymLink{} )}
   -- we have to follow a chain of symlinks here, but
   -- return only the very first level
   -- TODO: this is probably obsolete now
   = case sdir s of
       (True, _) -> (True, f)
       _         -> (False, f)
-sdir f@SymLink{ sdest = (_ :/ Dir {} )}
+sdir f@SymLink{ sdest = Dir{} }
   = (True, f)
 sdir f@Dir{} = (True, f)
 sdir f       = (False, f)
 
 
 -- |Matches on any non-directory kind of files, excluding symlinks.
-pattern AFileLike f <- (afileLike -> (True, f))
--- |Like `AFileLike`, except on File.
 pattern FileLike  f <- (fileLike  -> (True, f))
 
 -- |Matches a list of directories or symlinks pointing to directories.
-pattern DirList fs <- (\fs -> (and . fmap (fst . sadir) $ fs, fs)
+pattern DirList fs <- (\fs -> (and . fmap (fst . sdir) $ fs, fs)
                                 -> (True, fs))
 
 -- |Matches a list of any non-directory kind of files or symlinks
 -- pointing to such.
 pattern FileLikeList fs <- (\fs -> (and
-                                     . fmap (fst . safileLike)
+                                     . fmap (fst . sfileLike)
                                      $ fs, fs) -> (True, fs))
 
 
----- Filenames ----
-
-invalidFileName :: Path Fn -> (Bool, Path Fn)
-invalidFileName p@(Path "")   = (True, p)
-invalidFileName p@(Path ".")  = (True, p)
-invalidFileName p@(Path "..") = (True, p)
-invalidFileName p             = (B.elem P.pathSeparator (P.fromRel p), p)
-
-
--- |Matches on invalid filesnames, such as ".", ".." and anything
--- that contains a path separator.
-pattern InvFN   <- (invalidFileName -> (True,_))
--- |Opposite of `InvFN`.
-pattern ValFN f <- (invalidFileName -> (False, f))
-
--- |Like `InvFN`, but for AnchoredFile.
-pattern AFileInvFN  <- (fst . invalidFileName . name . file -> True)
--- |Like `InvFN`, but for File.
-pattern FileInvFN   <- (fst . invalidFileName . name        -> True)
-
 
 ---- Symlinks ----
 
-abrokenSymlink :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
-abrokenSymlink f = convertViewP brokenSymlink f
-
 
 brokenSymlink :: File FileInfo -> (Bool, File FileInfo)
 brokenSymlink f = (isBrokenSymlink f, f)
 
 
-afileLikeSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
-afileLikeSym f = convertViewP fileLikeSym f
-
-
 fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
-fileLikeSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
+fileLikeSym f@SymLink{ sdest = s@SymLink{} }
   = case fileLikeSym s of
       (True, _) -> (True, f)
       _         -> (False, f)
-fileLikeSym f@SymLink{ sdest = (_ :/ RegFile {} )}   = (True, f)
+fileLikeSym f@SymLink{ sdest = RegFile{} }   = (True, f)
-fileLikeSym f@SymLink{ sdest = (_ :/ BlockDev {} )}  = (True, f)
+fileLikeSym f@SymLink{ sdest = BlockDev{} }  = (True, f)
-fileLikeSym f@SymLink{ sdest = (_ :/ CharDev {} )}   = (True, f)
+fileLikeSym f@SymLink{ sdest = CharDev{} }   = (True, f)
-fileLikeSym f@SymLink{ sdest = (_ :/ NamedPipe {} )} = (True, f)
+fileLikeSym f@SymLink{ sdest = NamedPipe{} } = (True, f)
-fileLikeSym f@SymLink{ sdest = (_ :/ Socket {} )}    = (True, f)
+fileLikeSym f@SymLink{ sdest = Socket{} }    = (True, f)
 fileLikeSym f                                = (False, f)
 
 
-adirSym :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
-adirSym f = convertViewP dirSym f
-
-
 dirSym :: File FileInfo -> (Bool, File FileInfo)
-dirSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
+dirSym f@SymLink{ sdest = s@SymLink{} }
   = case dirSym s of
       (True, _) -> (True, f)
       _         -> (False, f)
-dirSym f@SymLink{ sdest = (_ :/ Dir {} )} = (True, f)
+dirSym f@SymLink{ sdest = Dir{} } = (True, f)
 dirSym f = (False, f)
 
 
 -- |Matches on symlinks pointing to file-like files only.
-pattern AFileLikeSym f <- (afileLikeSym -> (True, f))
--- |Like `AFileLikeSym`, except on File.
 pattern FileLikeSym  f <- (fileLikeSym  -> (True, f))
 
 -- |Matches on broken symbolic links.
-pattern ABrokenSymlink f <- (abrokenSymlink -> (True, f))
--- |Like `ABrokenSymlink`, except on File.
 pattern BrokenSymlink  f <- (brokenSymlink  -> (True, f))
 
+
 -- |Matches on directories or symlinks pointing to directories.
 -- If the symlink is pointing to a symlink pointing to a directory, then
 -- it will return True, but also return the first element in the symlink-
 -- chain, not the last.
-pattern ADirOrSym f <- (sadir -> (True, f))
--- |Like `ADirOrSym`, except on File.
 pattern DirOrSym  f <- (sdir  -> (True, f))
 
 -- |Matches on symlinks pointing to directories only.
-pattern ADirSym  f <- (adirSym -> (True, f))
--- |Like `ADirSym`, except on File.
 pattern DirSym   f <- (dirSym  -> (True, f))
 
 -- |Matches on any non-directory kind of files or symlinks pointing to
@@ -324,8 +253,6 @@ pattern DirSym   f <- (dirSym  -> (True, f))
 -- If the symlink is pointing to a symlink pointing to such a file, then
 -- it will return True, but also return the first element in the symlink-
 -- chain, not the last.
-pattern AFileLikeOrSym f <- (safileLike -> (True, f))
--- |Like `AFileLikeOrSym`, except on File.
 pattern FileLikeOrSym  f <- (sfileLike  -> (True, f))
 
 
@@ -353,14 +280,6 @@ instance Ord (File FileInfo) where
     compare d d' = comparingConstr d d'
 
 
--- |First compare anchor, then compare File.
-instance Ord (AnchoredFile FileInfo) where
-  compare (bp1 :/ a) (bp2 :/ b) =
-    case compare bp1 bp2 of
-      EQ -> compare a b
-      el -> el
-
-
 
 
 
@@ -369,128 +288,70 @@ instance Ord (AnchoredFile FileInfo) where
     ----------------------------
 
 
+
 -- |Reads a file or directory Path into an `AnchoredFile`, filling the free
 -- variables via the given function.
--- The dirname of the given path will be canonicalized using `realpath`, so the
+readFile :: (Path Abs -> IO a)
--- anchor of `AnchoredFile` is always canonicalized.
---
--- Exceptions: when `canonicalizePath` fails, throws IOError
-readFile :: (Path Abs -> IO a)  -- ^ function that fills the free
-                                --   a variable
-         -> Path Abs            -- ^ Path to read
-         -> IO (AnchoredFile a)
-readFile ff p = do
-  cdp <- P.canonicalizePath (P.dirname p)
-  readFileUnsafe ff (cdp P.</> P.basename p)
-
-
--- |A variant of `readFile` which does not use `realpath` at all.
--- Suitable for cases where we know the paths are safe/correct
--- and need the extra bit of performance.
-readFileUnsafe :: (Path Abs -> IO a)
          -> Path Abs
-               -> IO (AnchoredFile a)
+         -> IO (File a)
-readFileUnsafe ff p = do
+readFile ff p =
-  let fn = P.basename p
+  handleDT p $ do
-      bd = P.dirname p
+    fs   <- PF.getSymbolicLinkStatus (P.toFilePath p)
-      p' = P.toFilePath p
-  handleDT bd fn $ do
-    fs   <- PF.getSymbolicLinkStatus p'
     fv   <- ff p
-    file <- constructFile fs fv bd fn
+    constructFile fs fv p
-    return (bd :/ file)
   where
-    constructFile fs fv bd' fn'
+    constructFile fs fv p'
       | PF.isSymbolicLink    fs = do
           -- symlink madness, we need to make sure we save the correct
           -- AnchoredFile
-          let fp = bd' P.</> fn'
+          x <- PF.readSymbolicLink (P.fromAbs p')
-          x <- PF.readSymbolicLink (P.fromAbs fp)
+          resolvedSyml <- handleDT p' $ do
-          resolvedSyml <- handleDT bd' fn' $ do
             -- watch out, we call </> from 'filepath' here, but it is safe
             -- TODO: could it happen that too many '..' lead
             -- to something like '/' after normalization?
-            let sfp = P.fromAbs bd' `P.combine` x
+            let sfp = (P.fromAbs . P.dirname $ p') `P.combine` x
             rsfp <- P.realPath sfp
             readFile ff =<< P.parseAbs rsfp
-          return $ SymLink fn' fv resolvedSyml x
+          return $ SymLink p' fv resolvedSyml x
-      | PF.isDirectory       fs = return $ Dir       fn' fv
+      | PF.isDirectory       fs = return $ Dir       p' fv
-      | PF.isRegularFile     fs = return $ RegFile   fn' fv
+      | PF.isRegularFile     fs = return $ RegFile   p' fv
-      | PF.isBlockDevice     fs = return $ BlockDev  fn' fv
+      | PF.isBlockDevice     fs = return $ BlockDev  p' fv
-      | PF.isCharacterDevice fs = return $ CharDev   fn' fv
+      | PF.isCharacterDevice fs = return $ CharDev   p' fv
-      | PF.isNamedPipe       fs = return $ NamedPipe fn' fv
+      | PF.isNamedPipe       fs = return $ NamedPipe p' fv
-      | PF.isSocket          fs = return $ Socket    fn' fv
+      | PF.isSocket          fs = return $ Socket    p' fv
-      | otherwise               = return $ Failed    fn' (userError
+      | otherwise               = return $ Failed    p' (userError
                                                          "Unknown filetype!")
 
--- |Reads a file via `readFile` and fills the free variable via `getFileInfo`.
-readFileWithFileInfo :: Path Abs -> IO (AnchoredFile FileInfo)
-readFileWithFileInfo = readFile getFileInfo
 
-
+-- |Get the contents of a given directory and return them as a list
--- |Same as readDirectoryContents but allows us to, for example, use
+-- of `AnchoredFile`.
--- ByteString.readFile to return a tree of ByteStrings.
+readDirectoryContents :: (Path Abs -> IO a)  -- ^ fills free a variable
-readDirectoryContents :: (Path Abs -> IO [Path Fn])
+                      -> Path Abs            -- ^ path to read
-                      -> (Path Abs -> IO a)
+                      -> IO [File a]
-                      -> Path Abs
+readDirectoryContents ff p = do
-                      -> IO [AnchoredFile a]
+  files <- getDirsFiles p
-readDirectoryContents getfiles ff p = do
+  fcs   <- mapM (readFile ff) files
-  files <- getfiles p
-  fcs <- mapM (\x -> readFile ff $ p P.</> x) files
   return $ removeNonexistent fcs
 
 
--- |A variant of `readDirectoryContents` which uses `readFileUnsafe`.
+-- |A variant of `readDirectoryContents` where the third argument
--- Suitable for cases where we know the paths are safe/correct
+-- is a `File`. If a non-directory is passed returns an empty list.
--- and need the extra bit of performance.
+getContents :: (Path Abs -> IO a)
-readDirectoryContentsUnsafe :: (Path Abs -> IO [Path Fn])
+            -> File FileInfo
-                            -> (Path Abs -> IO a)
+            -> IO [File a]
-                            -> Path Abs
+getContents ff (DirOrSym af)
-                            -> IO [AnchoredFile a]
+  = readDirectoryContents ff (fullPath af)
-readDirectoryContentsUnsafe getfiles ff p = do
+getContents _ _ = return []
-  files <- getfiles p
-  fcs <- mapM (\x -> readFileUnsafe ff $ p P.</> x) files
-  return $ removeNonexistent fcs
 
 
--- |Build a list of AnchoredFile, given the path to a directory, filling
--- the free variables via `getFileInfo`. This includes the "." and ".."
--- directories.
-readDirectoryContentsWithFileInfo :: Path Abs -> IO [AnchoredFile FileInfo]
-readDirectoryContentsWithFileInfo fp
-  = readDirectoryContents getAllDirsFiles getFileInfo fp
-
-
--- |Build a list of AnchoredFile, given the path to a directory, filling
--- the free variables via `getFileInfo`. This excludes the "." and ".."
--- directories.
-readDirectoryContentsWithFileInfo' :: Path Abs -> IO [AnchoredFile FileInfo]
-readDirectoryContentsWithFileInfo' fp
-  = readDirectoryContents getDirsFiles getFileInfo fp
-
-
--- |Get the contents of a directory, including "." and "..".
-getContents :: AnchoredFile FileInfo
-            -> IO [AnchoredFile FileInfo]
-getContents (ADirOrSym af) = readDirectoryContentsWithFileInfo (fullPath af)
-getContents _              = return []
-
-
--- |Get the contents of a directory, including "." and "..".
-getContents' :: AnchoredFile FileInfo
-             -> IO [AnchoredFile FileInfo]
-getContents' (ADirOrSym af) = readDirectoryContentsWithFileInfo' (fullPath af)
-getContents' _              = return []
-
 
 -- |Go up one directory in the filesystem hierarchy.
-goUp :: AnchoredFile FileInfo -> IO (AnchoredFile FileInfo)
+goUp :: File FileInfo -> IO (File FileInfo)
-goUp af@(Path "" :/ _) = return af
+goUp file = readFile getFileInfo (P.dirname . path $ file)
-goUp    (bp      :/ _) = readFile getFileInfo bp
 
 
 -- |Go up one directory in the filesystem hierarchy.
-goUp' :: Path Abs -> IO (AnchoredFile FileInfo)
+goUp' :: Path Abs -> IO (File FileInfo)
 goUp' fp = readFile getFileInfo $ P.dirname fp
 
 
@@ -539,7 +400,7 @@ comparingConstr (DirOrSym _)      (Failed _ _)      = GT
 comparingConstr (DirOrSym _)      (FileLikeOrSym _) = LT
  -- else compare on the names of constructors that are the same, without
  -- looking at the contents of Dir constructors:
-comparingConstr t t'  = compare (name t) (name t')
+comparingConstr t t'  = compare (path t) (path t')
 
 
 
@@ -594,48 +455,28 @@ isSocketC _        = False
 ---- IO HELPERS: ----
 
 
--- |Gets all filenames of the given directory.
+-- |Gets all filenames of the given directory. This excludes "." and "..".
--- The first argument is a filter function that allows to exclude
+getDirsFiles :: Path Abs        -- ^ dir to read
--- filenames from the result.
+             -> IO [Path Abs]
-getDirsFiles' :: (Path Fn -> [Path Fn] -> [Path Fn]) -- ^ filter function
+getDirsFiles fp =
-              -> Path Abs                            -- ^ dir to read
-              -> IO [Path Fn]
-getDirsFiles' filterf fp =
   rethrowErrnoAs [eACCES] (Can'tOpenDirectory . P.fromAbs $ fp)
   $ bracket (PFD.openDirStream . P.toFilePath $ fp)
           PFD.closeDirStream
           $ \dirstream ->
-            let mdirs :: [Path Fn] -> IO [Path Fn]
+            let mdirs :: [Path Abs] -> IO [Path Abs]
                 mdirs dirs = do
                   -- make sure we close the directory stream in case of errors
                   -- TODO: more explicit error handling?
                   --       both the parsing and readin the stream can fail!
                   dir <- PFD.readDirStream dirstream
-                  case dir of
+                  if B.null dir
-                    "" -> return dirs
+                    then return dirs
-                    _  -> do
+                    else mdirs $ maybe dirs
-                            pdir <- P.parseFn dir
+                                       (\x -> fp P.</> x : dirs)
-                            mdirs $ pdir `filterf` dirs
+                                       (P.parseFn dir)
             in mdirs []
 
 
--- |Get all files of a given directory and return them as a List.
--- This includes "." and "..".
-getAllDirsFiles :: Path Abs -> IO [Path Fn]
-getAllDirsFiles = getDirsFiles' (:)
-
-
--- |Get all files of a given directory and return them as a List.
--- This excludes "." and "..".
-getDirsFiles :: Path Abs -> IO [Path Fn]
-getDirsFiles = getDirsFiles' insert
-  where
-    insert dir dirs = case dir of
-      (Path ".")  -> dirs
-      (Path "..") -> dirs
-      _           -> dir : dirs
-
-
 -- |Gets all file information.
 getFileInfo :: Path Abs -> IO FileInfo
 getFileInfo fp = do
@@ -664,11 +505,10 @@ getFileInfo fp = do
 -- Handles an IO exception by returning a Failed constructor filled with that
 -- exception. Does not handle FmIOExceptions.
 handleDT :: Path Abs
-         -> Path Fn
+         -> IO (File a)
-         -> IO (AnchoredFile a)
+         -> IO (File a)
-         -> IO (AnchoredFile a)
+handleDT p
-handleDT bp n
+  = handleIOError $ \e -> return $ Failed p e
-  = handleIOError $ \e -> return $ bp :/ Failed n e
 
 
 -- DoesNotExist errors not present at the topmost level could happen if a
@@ -677,10 +517,10 @@ handleDT bp n
 --    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 :: [AnchoredFile a] -> [AnchoredFile a]
+removeNonexistent :: [File a] -> [File a]
 removeNonexistent = filter isOkConstructor
   where
-    isOkConstructor (_ :/ c) = not (failed c) || isOkError c
+    isOkConstructor c = not (failed c) || isOkError c
     isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err
 
 
@@ -692,7 +532,7 @@ removeNonexistent = filter isOkConstructor
 --
 -- When called on a non-symlink, returns False.
 isBrokenSymlink :: File FileInfo -> Bool
-isBrokenSymlink (SymLink _ _ (_ :/ Failed {}) _) = True
+isBrokenSymlink (SymLink _ _ Failed{} _) = True
 isBrokenSymlink _ = False
 
 
@@ -718,12 +558,12 @@ getFreeVar _                  = Nothing
 
 
 -- |Get the full path of the file.
-fullPath :: AnchoredFile a -> Path Abs
+fullPath :: File a -> Path Abs
-fullPath (bp :/ f) = bp P.</> name f
+fullPath f = path f
 
 
 -- |Get the full path of the file, converted to a `FilePath`.
-fullPathS :: AnchoredFile a -> ByteString
+fullPathS :: File a -> ByteString
 fullPathS = P.fromAbs . fullPath
 
 

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -58,6 +58,7 @@ import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
 import HSFM.GUI.Gtk.Utils
 import HSFM.Utils.IO
+import Prelude hiding(readFile)
 import System.Glib.UTFString
   (
     glibToString
@@ -237,8 +238,8 @@ urlGoTo mygui myview = withErrorDialog $ do
 open :: [Item] -> MyGUI -> MyView -> IO ()
 open [item] mygui myview = withErrorDialog $
   case item of
-    ADirOrSym r -> do
+    DirOrSym r -> do
-      nv <- HSFM.FileSystem.FileType.readFileWithFileInfo $ fullPath r
+      nv <- readFile getFileInfo $ fullPath r
       refreshView' mygui myview nv
     r ->
       void $ openFile r
@@ -356,7 +357,8 @@ renameF [item] _ _ = withErrorDialog $ do
   for_ pmfn $ \fn -> do
     let cmsg = "Really rename \"" ++ P.fpToString (fullPathS item)
                ++ "\"" ++ " to \""
-               ++ P.fpToString (P.fromAbs (anchor item P.</> fn)) ++ "\"?"
+               ++ P.fpToString (P.fromAbs $ (P.dirname . path $ item)
+                                             P.</> fn) ++ "\"?"
     withConfirmationDialog cmsg $
       HSFM.FileSystem.FileOperations.renameFile item fn
 renameF _ _ _ = withErrorDialog

src/HSFM/GUI/Gtk/Data.hs

@@ -91,13 +91,14 @@ data FMSettings = MkFMSettings {
 data FMView = FMTreeView TreeView
             | FMIconView IconView
 
-type Item = AnchoredFile FileInfo
+type Item = File FileInfo
 
 
 -- |This describes the contents of the current vie and is separated from MyGUI,
 -- because we might want to have multiple views.
 data MyView = MkMyView {
     view            :: TVar FMView
+  , cwd             :: MVar Item
   , rawModel        :: TVar (ListStore Item)
   , sortedModel     :: TVar (TypedTreeModelSort Item)
   , filteredModel   :: TVar (TypedTreeModelFilter Item)

src/HSFM/GUI/Gtk/MyView.hs

@@ -46,6 +46,7 @@ import Data.Foldable
 import Data.Maybe
   (
     catMaybes
+  , fromJust
   )
 import Graphics.UI.Gtk
 import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
@@ -62,6 +63,7 @@ import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Icons
 import HSFM.GUI.Gtk.Utils
 import HSFM.Utils.IO
+import Prelude hiding(readFile)
 import System.INotify
   (
     addWatch
@@ -79,7 +81,9 @@ import System.IO.Error
 
 -- |Constructs the initial MyView object with a few dummy models.
 -- It also initializes the callbacks.
-createMyView :: MyGUI -> IO FMView -> IO MyView
+createMyView :: MyGUI
+             -> IO FMView
+             -> IO MyView
 createMyView mygui iofmv = do
   operationBuffer <- newTVarIO None
 
@@ -91,7 +95,7 @@ createMyView mygui iofmv = do
                              =<< readTVarIO rawModel
   sortedModel <- newTVarIO =<< treeModelSortNewWithModel
                            =<< readTVarIO filteredModel
-
+  cwd <- newEmptyMVar
   view' <- iofmv
   view  <- newTVarIO view'
 
@@ -194,6 +198,7 @@ createTreeView = do
 
 
 -- |Re-reads the current directory or the given one and updates the View.
+-- This is more or less a wrapper around `refreshView'`
 --
 -- If the third argument is Nothing, it tries to re-read the current directory.
 -- If that fails, it reads "/" instead.
@@ -208,12 +213,12 @@ refreshView mygui myview mfp =
   case mfp of
     Just fp  -> do
       -- readFileWithFileInfo can just outright fail...
-      ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo fp)
+      ecdir <- tryIOError (readFile getFileInfo fp)
       case ecdir of
         Right cdir ->
           -- ...or return an `AnchordFile` with a Failed constructor,
           -- both of which need to be handled here
-          if (failed . file $ cdir)
+          if (failed cdir)
             then refreshView mygui myview =<< getAlternativeDir
             else refreshView' mygui myview cdir
         Left _ -> refreshView mygui myview =<< getAlternativeDir
@@ -221,7 +226,7 @@ refreshView mygui myview mfp =
     where
       getAlternativeDir = do
         ecd <- try (getCurrentDir myview) :: IO (Either SomeException
-                                                     (AnchoredFile FileInfo))
+                                                     Item)
         case ecd of
           Right dir -> return (Just $ fullPath dir)
           Left _    -> return (P.parseAbs "/")
@@ -233,14 +238,17 @@ refreshView mygui myview mfp =
 -- calls `refreshView` with the 3rd argument being Nothing.
 refreshView' :: MyGUI
              -> MyView
-             -> AnchoredFile FileInfo
+             -> Item
              -> IO ()
-refreshView' mygui myview dt@(ADirOrSym _) = do
+refreshView' mygui myview dt@(DirOrSym _) = do
   newRawModel  <- fileListStore dt myview
   writeTVarIO (rawModel myview) newRawModel
 
   view' <- readTVarIO $ view myview
 
+  _ <- tryTakeMVar (cwd myview)
+  putMVar (cwd myview) dt
+
   -- get selected items
   tps <- getSelectedTreePaths mygui myview
   trs <- catMaybes <$> mapM (treeRowReferenceNew newRawModel) tps
@@ -255,7 +263,7 @@ refreshView' mygui myview dt@(ADirOrSym _) = do
       ntps <- mapM treeRowReferenceGetPath trs
       mapM_ (treeSelectionSelectPath tvs) ntps
     _ -> return ()
-refreshView' mygui myview (_ :/ Failed{}) = refreshView mygui myview Nothing
+refreshView' mygui myview Failed{} = refreshView mygui myview Nothing
 refreshView' _ _ _ = return ()
 
 
@@ -288,7 +296,7 @@ constructView mygui myview = do
 
   view' <- readTVarIO $ view myview
 
-  cdirp <- anchor <$> getFirstItem myview
+  cdirp <- path <$> getCurrentDir myview
 
   -- update urlBar
   entrySetText (urlBar mygui) (P.fromAbs cdirp)
@@ -300,7 +308,7 @@ constructView mygui myview = do
   writeTVarIO (filteredModel myview) filteredModel'
   treeModelFilterSetVisibleFunc filteredModel' $ \iter -> do
      hidden <- showHidden <$> readTVarIO (settings mygui)
-     item    <- (name . file) <$> treeModelGetRow rawModel' iter
+     item   <- treeModelGetRow rawModel' iter >>= (P.basename . path)
      if hidden
        then return True
        else return $ not . P.hiddenFile $ item
@@ -318,13 +326,13 @@ constructView mygui myview = do
 
   -- set values
   treeModelSetColumn rawModel' (makeColumnIdPixbuf 0)
-                     (dirtreePix . file)
+                     dirtreePix
   treeModelSetColumn rawModel' (makeColumnIdString 1)
-                     (P.fromRel . name . file)
+                     (P.toFilePath . fromJust . P.basename . path)
   treeModelSetColumn rawModel' (makeColumnIdString 2)
-                     (packModTime . file)
+                     packModTime
   treeModelSetColumn rawModel' (makeColumnIdString 3)
-                     (packPermissions . file)
+                     packPermissions
 
   -- update model of view
   case view' of

src/HSFM/GUI/Gtk/Utils.hs

@@ -21,6 +21,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.Utils where
 
 
+import Control.Concurrent.MVar
+  (
+    readMVar
+  )
 import Control.Concurrent.STM
   (
     readTVarIO
@@ -37,6 +41,7 @@ import Data.Traversable
 import Graphics.UI.Gtk
 import HSFM.FileSystem.FileType
 import HSFM.GUI.Gtk.Data
+import Prelude hiding(getContents)
 
 
 
@@ -100,29 +105,28 @@ withItems 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  -- ^ current dir
+fileListStore :: Item  -- ^ current dir
               -> MyView
               -> IO (ListStore Item)
 fileListStore dt _ = do
-  cs <- HSFM.FileSystem.FileType.getContents dt
+  cs <- getContents getFileInfo dt
   listStoreNew cs
 
 
--- |Currently unsafe. This is used to obtain any item (possibly the '.' item)
+-- |Currently unsafe. This is used to obtain any item, which will
--- and extract the "current working directory" from it.
+-- fail if there is none.
 getFirstItem :: MyView
-            -> IO (AnchoredFile FileInfo)
+             -> IO Item
 getFirstItem myview = do
   rawModel' <- readTVarIO $ rawModel myview
   iter      <- fromJust <$> treeModelGetIterFirst rawModel'
   treeModelGetRow rawModel' iter
 
 
--- |Currently unsafe. Gets the current directory via `getFirstItem` and
+-- |Reads the current directory from MyView.
--- `goUp`.
 getCurrentDir :: MyView
-              -> IO (AnchoredFile FileInfo)
+              -> IO Item
-getCurrentDir myview = getFirstItem myview >>= goUp
+getCurrentDir myview = readMVar (cwd myview)