path-io 1.0.1 → 1.1.0

raw patch · 4 files changed

+76/−32 lines, 4 filesdep ~path-io

Dependency ranges changed: path-io

Files

• CHANGELOG.md +8/−0
• Path/IO.hs +34/−24
• path-io.cabal +2/−2
• tests/Main.hs +32/−6

@@ -1,3 +1,11 @@+## Path IO 1.1.0++* Fixed bug in `copyDirRecur` when it was unable to full copy read-only+  directories.++* Added `copyDirRecur'` function that works just like `copyDirRecur`, but+  does not preserve permissions.+ ## Path IO 1.0.1  * Fixed bug in `copyDirRecur` for non-existing destination paths when

@@ -27,6 +27,7 @@   , listDir   , listDirRecur   , copyDirRecur+  , copyDirRecur'     -- ** Current working directory   , getCurrentDir   , setCurrentDir@@ -329,35 +330,44 @@   => Path b0 Dir       -- ^ Source   -> Path b1 Dir       -- ^ Destination   -> m ()-copyDirRecur src dest = do-  bsrc  <- makeAbsolute src-  bdest <- makeAbsolute dest-  (dirs, files) <- listDirRecur bsrc-  ensureDir bdest-  ignoringIOErrors (copyPermissions bsrc bdest)-  mapM (swapParent bsrc bdest) dirs  >>= zipWithM_ copyDir  dirs-  mapM (swapParent bsrc bdest) files >>= zipWithM_ copyFile files+copyDirRecur = copyDirRecurGen True --- | A helper for 'copyDirRecur', copies directory preserving permissions--- when possible. It /does not/ copies directory contents.+-- | The same as 'copyDirRecur', but it does not preserve directory+-- permissions. This may be useful, for example, if directory you want to+-- copy is “read-only”, but you want your copy to editable. -copyDir :: (MonadIO m, MonadCatch m)-  => Path Abs Dir      -- ^ Source-  -> Path Abs Dir      -- ^ Destination+copyDirRecur' :: (MonadIO m, MonadCatch m)+  => Path b0 Dir       -- ^ Source+  -> Path b1 Dir       -- ^ Destination   -> m ()-copyDir src dest = do-  ensureDir dest-  ignoringIOErrors (copyPermissions src dest)+copyDirRecur' = copyDirRecurGen False --- | A helper for 'copyDirRecur' that replaces given path prefix with--- another one.+-- | Generic version of 'copyDirRecur'. The first argument controls whether+-- to preserve directory permissions or not. -swapParent :: MonadThrow m-  => Path Abs Dir      -- ^ Original parent-  -> Path Abs Dir      -- ^ New parent-  -> Path Abs t        -- ^ Path to transform-  -> m (Path Abs t)-swapParent old new path = (new </>) `liftM` stripDir old path+copyDirRecurGen :: (MonadIO m, MonadCatch m)+  => Bool              -- ^ Should we preserve directory permissions?+  -> Path b0 Dir       -- ^ Source+  -> Path b1 Dir       -- ^ Destination+  -> m ()+copyDirRecurGen p src dest = do+  bsrc  <- makeAbsolute src+  bdest <- makeAbsolute dest+  (dirs, files) <- listDirRecur bsrc+  let swapParent :: MonadThrow m+        => Path Abs Dir+        -> Path Abs Dir+        -> Path Abs t+        -> m (Path Abs t)+      swapParent old new path = (new </>) `liftM` stripDir old path+  tdirs  <- mapM (swapParent bsrc bdest) dirs+  tfiles <- mapM (swapParent bsrc bdest) files+  ensureDir bdest+  mapM_ ensureDir tdirs+  zipWithM_ copyFile files tfiles+  when p $ do+    ignoringIOErrors (copyPermissions bsrc bdest)+    zipWithM_ (\s d -> ignoringIOErrors $ copyPermissions s d) dirs tdirs  ---------------------------------------------------------------------------- -- Current working directory

@@ -31,7 +31,7 @@ -- POSSIBILITY OF SUCH DAMAGE.  name:                 path-io-version:              1.0.1+version:              1.1.0 cabal-version:        >= 1.10 license:              BSD3 license-file:         LICENSE.md@@ -79,7 +79,7 @@                     , exceptions   >= 0.8                     , hspec        >= 2.0                     , path         >= 0.5-                    , path-io      >= 1.0.1+                    , path-io      >= 1.1.0   default-language:   Haskell2010  source-repository head

@@ -53,6 +53,7 @@     describe "listDir"      listDirSpec     describe "listDirRecur" listDirRecurSpec     describe "copyDirRecur" copyDirRecurSpec+    describe "copyDirRecur'" copyDirRecur'Spec     describe "findFile"     findFileSpec   describe "getCurrentDir"  getCurrentDirSpec   describe "setCurrentDir"  setCurrentDirSpec@@ -69,12 +70,37 @@   getDirStructure listDirRecur dir `shouldReturn` populatedDirStructure  copyDirRecurSpec :: SpecWith (Path Abs Dir)-copyDirRecurSpec = it "copies directory" $ \src -> do-  let dest = parent src </> $(mkRelDir "copied-dir")-  copyDirRecur src dest-  old <- getDirStructure listDirRecur src-  new <- getDirStructure listDirRecur dest-  old `shouldBe` new+copyDirRecurSpec = do+  context "when source directory is editable" $+    it "copies directory" $ \src -> do+    let dest = parent src </> $(mkRelDir "copied-dir")+    copyDirRecur src dest+    old <- getDirStructure listDirRecur src+    new <- getDirStructure listDirRecur dest+    old `shouldBe` new+  context "when source directory is read-only" $+    it "copies directory just as well (preserving permissions)" $ \src -> do+    let dest = parent src </> $(mkRelDir "copied-dir")+    srcPermissions <- setOwnerWritable False <$> getPermissions src+    setPermissions src srcPermissions+    copyDirRecur src dest+    old <- getDirStructure listDirRecur src+    new <- getDirStructure listDirRecur dest+    old `shouldBe` new+    getPermissions dest `shouldReturn` srcPermissions++copyDirRecur'Spec :: SpecWith (Path Abs Dir)+copyDirRecur'Spec =+  context "when source directory is read-only" $+    it "copies directory but now it's editable" $ \src -> do+    let dest = parent src </> $(mkRelDir "copied-dir")+    srcPermissions <- setOwnerWritable False <$> getPermissions src+    setPermissions src srcPermissions+    copyDirRecur' src dest+    old <- getDirStructure listDirRecur src+    new <- getDirStructure listDirRecur dest+    old `shouldBe` new+    getPermissions dest `shouldReturn` srcPermissions { writable = True }  findFileSpec :: SpecWith (Path Abs Dir) findFileSpec = it "finds a file lazily" $ \dir -> do