Fix cptree to handle symlinks correctly
#344
Conversation
Fixes #343 If `cptree` encounters a symlink, just copy the symlink instead of copying the file it points to or descending into any directory it points to.
src/Turtle/Prelude.hs
Outdated
| @@ -1098,17 +1098,39 @@ symlink a b = liftIO $ createSymbolicLink (fp2fp a) (fp2fp b) | |||
| -- | Copy a directory tree | |||
| cptree :: MonadIO io => FilePath -> FilePath -> io () | |||
| cptree oldTree newTree = sh (do | |||
| oldPath <- lstree oldTree | |||
| let isNotSymbolicLink path = do | |||
There was a problem hiding this comment.
How about
let isNotSymbolicLink = fmap (not . PosixCompat.isSymbolicLink) . lstat
| -- The `system-filepath` library treats a path like "/tmp" as a file and not | ||
| -- a directory and fails to strip it as a prefix from `/tmp/foo`. Adding | ||
| -- `(</> "")` to the end of the path makes clear that the path is a | ||
| -- directory | ||
| Just suffix <- return (Filesystem.stripPrefix (oldTree </> "") oldPath) | ||
|
|
There was a problem hiding this comment.
Why not
let Just suffix = Filesystem.stripPrefix (oldTree </> "") oldPath
There was a problem hiding this comment.
@mberndt123: They are not equivalent. The reason why is that Haskell interprets an irrefutable pattern match in a let binding differently than when binding a value in a do block.
An irrefutable pattern match in a let binding:
let Just x = foo... is the same as:
let x = case foo of
Just y -> y
Nothing -> error "…: Irrefutable pattern failed for pattern Just x"... whereas an irrefutable pattern match in the bind of a do block:
Just x <- return foo... is the same as:
r <- return foo
x <- case r of
Just y -> return y
Nothing -> fail "Pattern match failure in do expression at …"These differ because fail might not be the same as error (in fact, it's very common for fail to not be error). For example, for any list-like Monad (including Shell), fail _ = empty so an irrefutable pattern match when binding a value in a do block actually gracefully degrades to returning a total (albeit empty) result, whereas an irrefutable pattern match in a let binding gives a partial result (i.e. error) which is not intended to be recoverable.
So that's why that codde does the whole dance of wrapping the value in return before attempting an irrefutable pattern match. Another way it could have been written is to explicitly desugar it, like this:
x <- case Filesystem.stripPrefix (oldTree </> "") oldPath of
Nothing -> empty
Just x -> return x... as suggested by @mberndt123
Fixes #343
If
cptreeencounters a symlink, just copy the symlink instead of copyingthe file it points to or descending into any directory it points to.