revert parentDir change
Reverts 965e106f24
Unfortunately, this caused breakage on Windows, and possibly elsewhere,
because parentDir and takeDirectory do not behave the same when there is a
trailing directory separator.
This commit is contained in:
parent
2fff78512d
commit
3bab5dfb1d
47 changed files with 99 additions and 96 deletions
|
@ -83,7 +83,7 @@ foreground pidfile a = do
|
|||
- Fails if the pid file is already locked by another process. -}
|
||||
lockPidFile :: FilePath -> IO ()
|
||||
lockPidFile pidfile = do
|
||||
createDirectoryIfMissing True (takeDirectory pidfile)
|
||||
createDirectoryIfMissing True (parentDir pidfile)
|
||||
#ifndef mingw32_HOST_OS
|
||||
fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags
|
||||
locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)
|
||||
|
@ -176,6 +176,6 @@ winLockFile pid pidfile = do
|
|||
prefix = pidfile ++ "."
|
||||
suffix = ".lck"
|
||||
cleanstale = mapM_ (void . tryIO . removeFile) =<<
|
||||
(filter iswinlockfile <$> dirContents (takeDirectory pidfile))
|
||||
(filter iswinlockfile <$> dirContents (parentDir pidfile))
|
||||
iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f
|
||||
#endif
|
||||
|
|
|
@ -27,6 +27,7 @@ module Utility.FreeDesktop (
|
|||
) where
|
||||
|
||||
import Utility.Exception
|
||||
import Utility.Path
|
||||
import Utility.UserInfo
|
||||
import Utility.Process
|
||||
import Utility.PartialPrelude
|
||||
|
@ -78,7 +79,7 @@ buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
|
|||
|
||||
writeDesktopMenuFile :: DesktopEntry -> String -> IO ()
|
||||
writeDesktopMenuFile d file = do
|
||||
createDirectoryIfMissing True (takeDirectory file)
|
||||
createDirectoryIfMissing True (parentDir file)
|
||||
writeFile file $ buildDesktopMenuFile d
|
||||
|
||||
{- Path to use for a desktop menu file, in either the systemDataDir or
|
||||
|
|
|
@ -29,13 +29,13 @@ installLib installfile top lib = ifM (doesFileExist lib)
|
|||
( do
|
||||
installfile top lib
|
||||
checksymlink lib
|
||||
return $ Just $ takeDirectory lib
|
||||
return $ Just $ parentDir lib
|
||||
, return Nothing
|
||||
)
|
||||
where
|
||||
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
|
||||
l <- readSymbolicLink (inTop top f)
|
||||
let absl = absPathFrom (takeDirectory f) l
|
||||
let absl = absPathFrom (parentDir f) l
|
||||
target <- relPathDirToFile (takeDirectory f) absl
|
||||
installfile top absl
|
||||
nukeFile (top ++ f)
|
||||
|
|
|
@ -77,12 +77,18 @@ absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos
|
|||
todos = replace "/" "\\"
|
||||
#endif
|
||||
|
||||
{- Just the parent directory of a path, or Nothing if the path has no
|
||||
- parent (ie for "/") -}
|
||||
parentDir :: FilePath -> Maybe FilePath
|
||||
{- Returns the parent directory of a path.
|
||||
-
|
||||
- To allow this to be easily used in loops, which terminate upon reaching the
|
||||
- top, the parent of / is ""
|
||||
-
|
||||
- An additional subtle difference between this and takeDirectory
|
||||
- is that takeDirectory "foo/bar/" is "foo/bar", while parentDir is "foo"
|
||||
-}
|
||||
parentDir :: FilePath -> FilePath
|
||||
parentDir dir
|
||||
| null dirs = Nothing
|
||||
| otherwise = Just $ joinDrive drive (join s $ init dirs)
|
||||
| null dirs = ""
|
||||
| otherwise = joinDrive drive (join s $ init dirs)
|
||||
where
|
||||
-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
|
||||
(drive, path) = splitDrive dir
|
||||
|
@ -92,8 +98,8 @@ parentDir dir
|
|||
prop_parentDir_basics :: FilePath -> Bool
|
||||
prop_parentDir_basics dir
|
||||
| null dir = True
|
||||
| dir == "/" = parentDir dir == Nothing
|
||||
| otherwise = p /= Just dir
|
||||
| dir == "/" = parentDir dir == ""
|
||||
| otherwise = p /= dir
|
||||
where
|
||||
p = parentDir dir
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue