mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

really fix foreign C functions filename encodings

Browse source 
GHC should probably export withFilePath.
This commit is contained in:
Joey Hess 2012-02-04 14:30:28 -04:00
parent dc682e53a2
commit 56470ce3e5
2 changed files with 13 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
Utility/StatFS.hsc
View file

@ -50,6 +50,11 @@ module Utility.StatFS ( FileSystemStats(..), getFileSystemStats ) where
import Foreign import Foreign
import Foreign.C.Types import Foreign.C.Types
import Foreign.C.String import Foreign.C.String
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__) #if defined (__FreeBSD__) || defined (__FreeBSD_kernel__) || defined (__APPLE__)
# include <sys/param.h> # include <sys/param.h>
@ -103,7 +108,7 @@ getFileSystemStats path =
return Nothing return Nothing
#else #else
allocaBytes (#size struct statfs) $ \vfs -> allocaBytes (#size struct statfs) $ \vfs ->
withCAString path $ \cpath -> do withFilePath path $ \cpath -> do
res <- c_statfs cpath vfs res <- c_statfs cpath vfs
if res == -1 then return Nothing if res == -1 then return Nothing
else do else do

9
Utility/Touch.hsc
View file

@ -16,6 +16,11 @@ module Utility.Touch (
import Foreign import Foreign
import Foreign.C import Foreign.C
import Control.Monad (when) 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 newtype TimeSpec = TimeSpec CTime
@ -64,7 +69,7 @@ foreign import ccall "utimensat"
touchBoth file atime mtime follow = touchBoth file atime mtime follow =
allocaArray 2 $ \ptr -> allocaArray 2 $ \ptr ->
withCAString file $ \f -> do withFilePath file $ \f -> do
pokeArray ptr [atime, mtime] pokeArray ptr [atime, mtime]
r <- c_utimensat at_fdcwd f ptr flags r <- c_utimensat at_fdcwd f ptr flags
when (r /= 0) $ throwErrno "touchBoth" when (r /= 0) $ throwErrno "touchBoth"
@ -101,7 +106,7 @@ foreign import ccall "lutimes"
touchBoth file atime mtime follow = touchBoth file atime mtime follow =
allocaArray 2 $ \ptr -> allocaArray 2 $ \ptr ->
withCAString file $ \f -> do withFilePath file $ \f -> do
pokeArray ptr [atime, mtime] pokeArray ptr [atime, mtime]
r <- syscall f ptr r <- syscall f ptr
if (r /= 0) if (r /= 0)