summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-01-06 19:00:01 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-01-06 19:00:01 -0400
commit6be8289158fd30d972ac22766452e7c9dc809e6f (patch)
treeba4929c7c8f27d2b43051f637394115cda39258b /Utility
parent6ea1214fa5d19241851a977ab82437563e2afc81 (diff)
parent971ed2a464a1a1e4d5e650e32390d232cd354d9d (diff)
Merge branch 'master' into relativepaths
Conflicts: Locations.hs debian/changelog
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Daemon.hs4
-rw-r--r--Utility/FreeDesktop.hs3
-rw-r--r--Utility/LinuxMkLibs.hs7
-rw-r--r--Utility/Path.hs16
4 files changed, 14 insertions, 16 deletions
diff --git a/Utility/Daemon.hs b/Utility/Daemon.hs
index d1f539e98..961b098dc 100644
--- a/Utility/Daemon.hs
+++ b/Utility/Daemon.hs
@@ -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 (parentDir pidfile)
+ createDirectoryIfMissing True (takeDirectory 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 (parentDir pidfile))
+ (filter iswinlockfile <$> dirContents (takeDirectory pidfile))
iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f
#endif
diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs
index c1f042ce8..208a392e9 100644
--- a/Utility/FreeDesktop.hs
+++ b/Utility/FreeDesktop.hs
@@ -27,7 +27,6 @@ module Utility.FreeDesktop (
) where
import Utility.Exception
-import Utility.Path
import Utility.UserInfo
import Utility.Process
import Utility.PartialPrelude
@@ -79,7 +78,7 @@ buildDesktopMenuFile d = unlines ("[Desktop Entry]" : map keyvalue d) ++ "\n"
writeDesktopMenuFile :: DesktopEntry -> String -> IO ()
writeDesktopMenuFile d file = do
- createDirectoryIfMissing True (parentDir file)
+ createDirectoryIfMissing True (takeDirectory file)
writeFile file $ buildDesktopMenuFile d
{- Path to use for a desktop menu file, in either the systemDataDir or
diff --git a/Utility/LinuxMkLibs.hs b/Utility/LinuxMkLibs.hs
index 1dc4e1ea3..6074ba261 100644
--- a/Utility/LinuxMkLibs.hs
+++ b/Utility/LinuxMkLibs.hs
@@ -10,6 +10,7 @@ module Utility.LinuxMkLibs where
import Control.Applicative
import Data.Maybe
import System.Directory
+import System.FilePath
import Data.List.Utils
import System.Posix.Files
import Data.Char
@@ -28,14 +29,14 @@ installLib installfile top lib = ifM (doesFileExist lib)
( do
installfile top lib
checksymlink lib
- return $ Just $ parentDir lib
+ return $ Just $ takeDirectory lib
, return Nothing
)
where
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
l <- readSymbolicLink (inTop top f)
- let absl = absPathFrom (parentDir f) l
- let target = relPathDirToFile (parentDir f) absl
+ let absl = absPathFrom (takeDirectory f) l
+ let target = relPathDirToFile (takeDirectory f) absl
installfile top absl
nukeFile (top ++ f)
createSymbolicLink target (inTop top f)
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 7427bfe27..cc6c35485 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -77,14 +77,12 @@ absNormPathUnix dir path = todos <$> MissingH.absNormPath (fromdos dir) (fromdos
todos = replace "/" "\\"
#endif
-{- 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 "" -}
-parentDir :: FilePath -> FilePath
+{- Just the parent directory of a path, or Nothing if the path has no
+ - parent (ie for "/") -}
+parentDir :: FilePath -> Maybe FilePath
parentDir dir
- | null dirs = ""
- | otherwise = joinDrive drive (join s $ init dirs)
+ | null dirs = Nothing
+ | otherwise = Just $ joinDrive drive (join s $ init dirs)
where
-- on Unix, the drive will be "/" when the dir is absolute, otherwise ""
(drive, path) = splitDrive dir
@@ -94,8 +92,8 @@ parentDir dir
prop_parentDir_basics :: FilePath -> Bool
prop_parentDir_basics dir
| null dir = True
- | dir == "/" = parentDir dir == ""
- | otherwise = p /= dir
+ | dir == "/" = parentDir dir == Nothing
+ | otherwise = p /= Just dir
where
p = parentDir dir