From 47a2b72bed3770d3dfb26c4142479c436a11ce55 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 15 Dec 2015 21:08:22 -0400 Subject: Merged Utility changes from git-annex. --- src/Utility/FileMode.hs | 29 +++++++++++++++++++++++------ 1 file changed, 23 insertions(+), 6 deletions(-) (limited to 'src/Utility/FileMode.hs') diff --git a/src/Utility/FileMode.hs b/src/Utility/FileMode.hs index fdf1b56b..efef5fa2 100644 --- a/src/Utility/FileMode.hs +++ b/src/Utility/FileMode.hs @@ -7,7 +7,10 @@ {-# LANGUAGE CPP #-} -module Utility.FileMode where +module Utility.FileMode ( + module Utility.FileMode, + FileMode, +) where import System.IO import Control.Monad @@ -17,17 +20,31 @@ import Utility.PosixFiles import System.Posix.Files #endif import Foreign (complement) +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.Catch import Utility.Exception {- Applies a conversion function to a file's mode. -} modifyFileMode :: FilePath -> (FileMode -> FileMode) -> IO () -modifyFileMode f convert = do +modifyFileMode f convert = void $ modifyFileMode' f convert + +modifyFileMode' :: FilePath -> (FileMode -> FileMode) -> IO FileMode +modifyFileMode' f convert = do s <- getFileStatus f let old = fileMode s let new = convert old when (new /= old) $ setFileMode f new + return old + +{- Runs an action after changing a file's mode, then restores the old mode. -} +withModifiedFileMode :: FilePath -> (FileMode -> FileMode) -> IO a -> IO a +withModifiedFileMode file convert a = bracket setup cleanup go + where + setup = modifyFileMode' file convert + cleanup oldmode = modifyFileMode file (const oldmode) + go _ = a {- Adds the specified FileModes to the input mode, leaving the rest - unchanged. -} @@ -92,7 +109,7 @@ isExecutable mode = combineModes executeModes `intersectFileModes` mode /= 0 {- Runs an action without that pesky umask influencing it, unless the - passed FileMode is the standard one. -} -noUmask :: FileMode -> IO a -> IO a +noUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a #ifndef mingw32_HOST_OS noUmask mode a | mode == stdFileMode = a @@ -101,12 +118,12 @@ noUmask mode a noUmask _ a = a #endif -withUmask :: FileMode -> IO a -> IO a +withUmask :: (MonadIO m, MonadMask m) => FileMode -> m a -> m a #ifndef mingw32_HOST_OS withUmask umask a = bracket setup cleanup go where - setup = setFileCreationMask umask - cleanup = setFileCreationMask + setup = liftIO $ setFileCreationMask umask + cleanup = liftIO . setFileCreationMask go _ = a #else withUmask _ a = a -- cgit v1.2.3