more RawFilePath conversion

Most of Git/ builds now.

Notable win is toTopFilePath no longer double converts

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
This commit is contained in:
Joey Hess 2020-10-28 15:40:50 -04:00
parent d6e94a6b2e
commit 08cbaee1f8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
15 changed files with 105 additions and 76 deletions

View file

@ -18,7 +18,9 @@ import Utility.Directory
import Utility.Process
import Utility.Monad
import Utility.Path
import Utility.Path.AbsRel
import Utility.Split
import Utility.FileSystemEncoding
import Data.Maybe
import System.FilePath
@ -35,18 +37,20 @@ installLib installfile top lib = ifM (doesFileExist lib)
( do
installfile top lib
checksymlink lib
return $ Just $ parentDir lib
return $ Just $ fromRawFilePath $ parentDir $ toRawFilePath lib
, return Nothing
)
where
checksymlink f = whenM (isSymbolicLink <$> getSymbolicLinkStatus (inTop top f)) $ do
l <- readSymbolicLink (inTop top f)
let absl = absPathFrom (parentDir f) l
target <- relPathDirToFile (takeDirectory f) absl
installfile top absl
let absl = absPathFrom
(parentDir (toRawFilePath f))
(toRawFilePath l)
target <- relPathDirToFile (toRawFilePath (takeDirectory f)) absl
installfile top (fromRawFilePath absl)
nukeFile (top ++ f)
createSymbolicLink target (inTop top f)
checksymlink absl
createSymbolicLink (fromRawFilePath target) (inTop top f)
checksymlink (fromRawFilePath absl)
-- Note that f is not relative, so cannot use </>
inTop :: FilePath -> FilePath -> FilePath

View file

@ -23,7 +23,7 @@ import Utility.Exception
import Utility.Applicative
import Utility.Directory
import Utility.Monad
import Utility.Path
import Utility.Path.AbsRel
import Utility.FileMode
import Utility.LockFile.LockStatus
import Utility.ThreadScheduler
@ -108,7 +108,7 @@ dropSideLock (Just (f, h)) = do
-- locks. /tmp is used as a fallback.
sideLockFile :: LockFile -> IO LockFile
sideLockFile lockfile = do
f <- absPath lockfile
f <- fromRawFilePath <$> absPath (toRawFilePath lockfile)
let base = intercalate "_" (splitDirectories (makeRelative "/" f))
let shortbase = reverse $ take 32 $ reverse base
let md5sum = if base == shortbase
@ -131,7 +131,7 @@ sideLockFile lockfile = do
-- "PIDLOCK_lockfile" environment variable, does not block either.
tryLock :: LockFile -> IO (Maybe LockHandle)
tryLock lockfile = do
abslockfile <- absPath lockfile
abslockfile <- fromRawFilePath <$> absPath (toRawFilePath lockfile)
lockenv <- pidLockEnv abslockfile
getEnv lockenv >>= \case
Nothing -> trySideLock lockfile (go abslockfile)
@ -299,7 +299,7 @@ checkSaneLock _ ParentLocked = return True
-- not see unsetLockEnv.
pidLockEnv :: FilePath -> IO String
pidLockEnv lockfile = do
abslockfile <- absPath lockfile
abslockfile <- fromRawFilePath <$> absPath (toRawFilePath lockfile)
return $ "PIDLOCK_" ++ filter legalInEnvVar abslockfile
pidLockEnvValue :: String