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