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:
parent
d6e94a6b2e
commit
08cbaee1f8
15 changed files with 105 additions and 76 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue