more OsPath conversion
This commit is contained in:
parent
a5eaf3d4d2
commit
19dea33f57
1 changed files with 15 additions and 13 deletions
|
@ -161,7 +161,7 @@ tryLock lockfile = do
|
||||||
removeWhenExistsWith removeFile tmp
|
removeWhenExistsWith removeFile tmp
|
||||||
return Nothing
|
return Nothing
|
||||||
let tooklock st = return $ Just $ LockHandle abslockfile st sidelock
|
let tooklock st = return $ Just $ LockHandle abslockfile st sidelock
|
||||||
linkToLock sidelock tmp' (fromOsPath abslockfile) >>= \case
|
linkToLock sidelock tmp abslockfile >>= \case
|
||||||
Just lckst -> do
|
Just lckst -> do
|
||||||
removeWhenExistsWith removeFile tmp
|
removeWhenExistsWith removeFile tmp
|
||||||
tooklock lckst
|
tooklock lckst
|
||||||
|
@ -190,36 +190,38 @@ tryLock lockfile = do
|
||||||
--
|
--
|
||||||
-- However, not all filesystems support hard links. So, first probe
|
-- However, not all filesystems support hard links. So, first probe
|
||||||
-- to see if they are supported. If not, use open with O_EXCL.
|
-- to see if they are supported. If not, use open with O_EXCL.
|
||||||
linkToLock :: SideLockHandle -> RawFilePath -> RawFilePath -> IO (Maybe FileStatus)
|
linkToLock :: SideLockHandle -> OsPath -> OsPath -> IO (Maybe FileStatus)
|
||||||
linkToLock Nothing _ _ = return Nothing
|
linkToLock Nothing _ _ = return Nothing
|
||||||
linkToLock (Just _) src dest = do
|
linkToLock (Just _) src dest = do
|
||||||
let probe = src <> ".lnk"
|
let probe = src <> literalOsPath ".lnk"
|
||||||
v <- tryIO $ createLink src probe
|
v <- tryIO $ createLink src' (fromOsPath probe)
|
||||||
removeWhenExistsWith removeLink probe
|
removeWhenExistsWith removeFile probe
|
||||||
case v of
|
case v of
|
||||||
Right _ -> do
|
Right _ -> do
|
||||||
_ <- tryIO $ createLink src dest
|
_ <- tryIO $ createLink src' dest'
|
||||||
ifM (catchBoolIO checklinked)
|
ifM (catchBoolIO checklinked)
|
||||||
( ifM (catchBoolIO $ not <$> checkInsaneLustre (toOsPath dest))
|
( ifM (catchBoolIO $ not <$> checkInsaneLustre dest)
|
||||||
( catchMaybeIO $ getFileStatus dest
|
( catchMaybeIO $ getFileStatus dest'
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
Left _ -> catchMaybeIO $ do
|
Left _ -> catchMaybeIO $ do
|
||||||
let setup = do
|
let setup = do
|
||||||
fd <- openFdWithMode dest WriteOnly
|
fd <- openFdWithMode dest' WriteOnly
|
||||||
(Just $ combineModes readModes)
|
(Just $ combineModes readModes)
|
||||||
(defaultFileFlags {exclusive = True})
|
(defaultFileFlags {exclusive = True})
|
||||||
fdToHandle fd
|
fdToHandle fd
|
||||||
let cleanup = hClose
|
let cleanup = hClose
|
||||||
let go h = readFile (fromRawFilePath src) >>= hPutStr h
|
let go h = readFile (fromOsPath src) >>= hPutStr h
|
||||||
bracket setup cleanup go
|
bracket setup cleanup go
|
||||||
getFileStatus dest
|
getFileStatus dest'
|
||||||
where
|
where
|
||||||
|
src' = fromOsPath src
|
||||||
|
dest' = fromOsPath dest
|
||||||
checklinked = do
|
checklinked = do
|
||||||
x <- getSymbolicLinkStatus src
|
x <- getSymbolicLinkStatus src'
|
||||||
y <- getSymbolicLinkStatus dest
|
y <- getSymbolicLinkStatus dest'
|
||||||
return $ and
|
return $ and
|
||||||
[ deviceID x == deviceID y
|
[ deviceID x == deviceID y
|
||||||
, fileID x == fileID y
|
, fileID x == fileID y
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue