diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/Misc.hs | 8 | ||||
| -rw-r--r-- | Utility/StatFS.hsc | 9 | ||||
| -rw-r--r-- | Utility/Touch.hsc | 9 |
3 files changed, 21 insertions, 5 deletions
diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 3ac5ca5c0..9c284c826 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -9,6 +9,14 @@ module Utility.Misc where import System.IO import Control.Monad +import GHC.IO.Encoding + +{- Sets a Handle to use the filesystem encoding. This causes data + - written or read from it to be encoded/decoded the same + - as ghc 7.4 does to filenames et. This special encoding + - allows "arbitrary undecodable bytes to be round-tripped through it". -} +fileEncoding :: Handle -> IO () +fileEncoding h = hSetEncoding h =<< getFileSystemEncoding {- A version of hgetContents that is not lazy. Ensures file is - all read before it gets closed. -} diff --git a/Utility/StatFS.hsc b/Utility/StatFS.hsc index 937571dfa..51a6bda1e 100644 --- a/Utility/StatFS.hsc +++ b/Utility/StatFS.hsc @@ -50,8 +50,11 @@ module Utility.StatFS ( FileSystemStats(..), getFileSystemStats ) where import Foreign import Foreign.C.Types import Foreign.C.String -import Data.ByteString (useAsCString) -import Data.ByteString.Char8 (pack) +import GHC.IO.Encoding (getFileSystemEncoding) +import GHC.Foreign as GHC + +withFilePath :: FilePath -> (CString -> IO a) -> IO a +withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f #if defined (__FreeBSD__) || defined (__FreeBSD_kernel__) || defined (__APPLE__) # include <sys/param.h> @@ -105,7 +108,7 @@ getFileSystemStats path = return Nothing #else allocaBytes (#size struct statfs) $ \vfs -> - useAsCString (pack path) $ \cpath -> do + withFilePath path $ \cpath -> do res <- c_statfs cpath vfs if res == -1 then return Nothing else do diff --git a/Utility/Touch.hsc b/Utility/Touch.hsc index fd3320cd1..24ccd17a6 100644 --- a/Utility/Touch.hsc +++ b/Utility/Touch.hsc @@ -16,6 +16,11 @@ module Utility.Touch ( import Foreign import Foreign.C import Control.Monad (when) +import GHC.IO.Encoding (getFileSystemEncoding) +import GHC.Foreign as GHC + +withFilePath :: FilePath -> (CString -> IO a) -> IO a +withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f newtype TimeSpec = TimeSpec CTime @@ -64,7 +69,7 @@ foreign import ccall "utimensat" touchBoth file atime mtime follow = allocaArray 2 $ \ptr -> - withCString file $ \f -> do + withFilePath file $ \f -> do pokeArray ptr [atime, mtime] r <- c_utimensat at_fdcwd f ptr flags when (r /= 0) $ throwErrno "touchBoth" @@ -101,7 +106,7 @@ foreign import ccall "lutimes" touchBoth file atime mtime follow = allocaArray 2 $ \ptr -> - withCString file $ \f -> do + withFilePath file $ \f -> do pokeArray ptr [atime, mtime] r <- syscall f ptr if (r /= 0) |