[commit: packages/directory] master: Implement `withCurrentDirectory` (497c555)

git at git.haskell.org git at git.haskell.org
Fri Dec 18 09:51:58 UTC 2015


Repository : ssh://git@git.haskell.org/directory

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/497c55508fc2d7ebf5dedb726d0692837ccff0ce/directory

>---------------------------------------------------------------

commit 497c55508fc2d7ebf5dedb726d0692837ccff0ce
Author: Mateusz Kowalczyk <fuuzetsu at fuuzetsu.co.uk>
Date:   Thu Jun 11 22:29:46 2015 +0100

    Implement `withCurrentDirectory`
    
    This function allows us to perform an IO action in a different directory
    without the hassle of manually switching and restoring the directory.


>---------------------------------------------------------------

497c55508fc2d7ebf5dedb726d0692837ccff0ce
 System/Directory.hs           | 15 +++++++++++++++
 changelog.md                  |  2 ++
 tests/Main.hs                 |  2 ++
 tests/WithCurrentDirectory.hs | 26 ++++++++++++++++++++++++++
 4 files changed, 45 insertions(+)

diff --git a/System/Directory.hs b/System/Directory.hs
index 3fe8406..84895f5 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -28,6 +28,7 @@ module System.Directory
     , getDirectoryContents
     , getCurrentDirectory
     , setCurrentDirectory
+    , withCurrentDirectory
 
     -- * Pre-defined directories
     , getHomeDirectory
@@ -1098,6 +1099,20 @@ setCurrentDirectory path =
   Posix.changeWorkingDirectory path
 #endif
 
+-- | Run a given 'IO' action inside the specified directory while
+-- preserving the directory we were in at the start.
+--
+-- This function can fail with the same exceptions that
+-- 'getCurrentDirectory' and 'setCurrentDirectory' can.
+--
+-- @since 1.2.3.0
+withCurrentDirectory :: FilePath -- ^ The path of the directory to execute in
+                     -> IO a -- ^ The action to execute
+                     -> IO a
+withCurrentDirectory dir action =
+  bracket getCurrentDirectory setCurrentDirectory $ \_ ->
+    setCurrentDirectory dir >> action
+
 {- |The operation 'doesDirectoryExist' returns 'True' if the argument file
 exists and is either a directory or a symbolic link to a directory,
 and 'False' otherwise.
diff --git a/changelog.md b/changelog.md
index 1d886f9..fd8079e 100644
--- a/changelog.md
+++ b/changelog.md
@@ -21,6 +21,8 @@ Changelog for the [`directory`][1] package
 
   * Deprecate use of `HsDirectory.h` and `HsDirectoryConfig.h`
 
+  * Implement `withCurrentDirectory`
+
 ## 1.2.2.1 (Apr 2015)
 
   * Fix dependency problem on NixOS when building with tests
diff --git a/tests/Main.hs b/tests/Main.hs
index 5ce8480..b5340ff 100644
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -16,6 +16,7 @@ import qualified GetPermissions001
 import qualified RemoveDirectoryRecursive001
 import qualified RenameFile001
 import qualified T8482
+import qualified WithCurrentDirectory
 
 main :: IO ()
 main = T.testMain $ \ _t -> do
@@ -35,3 +36,4 @@ main = T.testMain $ \ _t -> do
   T.isolatedRun _t "RemoveDirectoryRecursive001" RemoveDirectoryRecursive001.main
   T.isolatedRun _t "RenameFile001" RenameFile001.main
   T.isolatedRun _t "T8482" T8482.main
+  T.isolatedRun _t "WithCurrentDirectory" WithCurrentDirectory.main
diff --git a/tests/WithCurrentDirectory.hs b/tests/WithCurrentDirectory.hs
new file mode 100644
index 0000000..520c363
--- /dev/null
+++ b/tests/WithCurrentDirectory.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE CPP #-}
+module WithCurrentDirectory where
+#include "util.inl"
+import Data.Monoid ((<>))
+import Data.List (sort)
+import System.Directory
+import System.FilePath ((</>))
+
+main :: TestEnv -> IO ()
+main _t = do
+  createDirectory dir
+  -- Make sure we're starting empty
+  T(expectEq) () specials . sort =<< getDirectoryContents dir
+  cwd <- getCurrentDirectory
+  withCurrentDirectory dir (writeFile testfile contents)
+  -- Are we still in original directory?
+  T(expectEq) () cwd =<< getCurrentDirectory
+  -- Did the test file get created?
+  T(expectEq) () (specials <> [testfile]) . sort =<< getDirectoryContents dir
+  -- Does the file contain what we expected to write?
+  T(expectEq) () contents =<< readFile (dir </> testfile)
+  where
+    testfile = "testfile"
+    contents = "some data\n"
+    dir = "dir"
+    specials = [".", ".."]



More information about the ghc-commits mailing list