hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'issue-695'

Browse Source
This commit is contained in:
Julian Ospald 2023-01-03 22:46:52 +08:00
commit ea06c155a7
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 12 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
lib/GHCup/Prelude/File/Posix.hs
View File

@ -48,6 +48,7 @@ import Streamly.Internal.Data.Unfold.Type
import qualified Streamly.Internal.Data.Unfold as U import qualified Streamly.Internal.Data.Unfold as U
import Streamly.Internal.Control.Concurrent ( withRunInIO ) import Streamly.Internal.Control.Concurrent ( withRunInIO )
import Streamly.Internal.Data.IOFinalizer ( newIOFinalizer, runIOFinalizer ) import Streamly.Internal.Data.IOFinalizer ( newIOFinalizer, runIOFinalizer )
import GHC.IO.Exception (IOException(ioe_type), IOErrorType (..))
-- | On unix, we can use symlinks, so we just get the -- | On unix, we can use symlinks, so we just get the
@ -116,8 +117,18 @@ copyFile from to fail' = do
let dflags = [ FD.oNofollow let dflags = [ FD.oNofollow
, if fail' then FD.oExcl else FD.oTrunc , if fail' then FD.oExcl else FD.oTrunc
] ]
let openFdHandle' = openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode
bracket bracket
(openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode) (handleIO (\e -> if
-- if we copy from regular file to symlink, we need
-- to delete the symlink
| ioe_type e == InvalidArgument
, not fail' -> do
removeLink to
openFdHandle'
| otherwise -> throwIO e
)
openFdHandle')
(hClose . snd) (hClose . snd)
$ \(_, tH) -> do $ \(_, tH) -> do
hSetBinaryMode fH True hSetBinaryMode fH True