LIB: fix throwSameFile in case fp2 doesn't exist yet

This commit is contained in:
Julian Ospald 2016-04-03 18:16:38 +02:00
parent 2609338f6e
commit bfcc2f39e5
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28

View File

@ -107,7 +107,12 @@ throwSameFile :: Path Abs -- ^ will be canonicalized
-> IO () -> IO ()
throwSameFile fp1 fp2 = do throwSameFile fp1 fp2 = do
fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1 fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1
fp2' <- fmap P.fromAbs $ P.canonicalizePath fp2 -- TODO: clean this up... if canonicalizing fp2 fails we try to
-- canonicalize `dirname fp2`
fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
(\_ -> fmap P.fromAbs
$ (P.</> P.basename fp2)
<$> (P.canonicalizePath $ P.dirname fp2))
when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2') when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')