From d6e77595ba45762b3c2dfdcd47a2d6b5b70154ae Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 9 Mar 2012 19:08:10 -0400 Subject: factor out Utility.FileSystemEncoding --- Common.hs | 1 + Utility/FileSystemEncoding.hs | 23 +++++++++++++++++++++-- Utility/Misc.hs | 8 -------- Utility/StatFS.hsc | 5 ++--- Utility/Touch.hsc | 5 ++--- 5 files changed, 26 insertions(+), 16 deletions(-) diff --git a/Common.hs b/Common.hs index cc6cf9252..347502460 100644 --- a/Common.hs +++ b/Common.hs @@ -26,5 +26,6 @@ import Utility.SafeCommand as X import Utility.Path as X import Utility.Directory as X import Utility.Monad as X +import Utility.FileSystemEncoding as X import Utility.PartialPrelude as X diff --git a/Utility/FileSystemEncoding.hs b/Utility/FileSystemEncoding.hs index 6970a10de..048323ee3 100644 --- a/Utility/FileSystemEncoding.hs +++ b/Utility/FileSystemEncoding.hs @@ -1,4 +1,4 @@ -{- File system encoding handling. +{- GHC File system encoding handling. - - Copyright 2012 Joey Hess - @@ -7,8 +7,17 @@ module Utility.FileSystemEncoding where -import GHC.IO.Encoding (getFileSystemEncoding) +import System.IO +import Foreign.C import GHC.Foreign as GHC +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 etc. This special encoding + - allows "arbitrary undecodable bytes to be round-tripped through it". -} +fileEncoding :: Handle -> IO () +fileEncoding h = hSetEncoding h =<< getFileSystemEncoding {- Marshal a Haskell FilePath into a NUL terminated C string using temporary - storage. The FilePath is encoded using the filesystem encoding, @@ -16,3 +25,13 @@ import GHC.Foreign as GHC - was obtained. -} withFilePath :: FilePath -> (CString -> IO a) -> IO a withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f + +{- Encodes a FilePath into a String of encoded bytes, applying the + - filesystem encoding. + - + - This does not do any IO, beyond allocating a C buffer. GHC does not + - seem to provide a pure way to do this conversion. -} +encodeFilePath :: FilePath -> IO String +encodeFilePath fp = do + enc <- getFileSystemEncoding + GHC.withCString enc fp $ GHC.peekCString enc diff --git a/Utility/Misc.hs b/Utility/Misc.hs index 9c284c826..3ac5ca5c0 100644 --- a/Utility/Misc.hs +++ b/Utility/Misc.hs @@ -9,14 +9,6 @@ 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 51a6bda1e..58d0b3e02 100644 --- a/Utility/StatFS.hsc +++ b/Utility/StatFS.hsc @@ -47,15 +47,14 @@ module Utility.StatFS ( FileSystemStats(..), getFileSystemStats ) where +import Utility.FileSystemEncoding + import Foreign import Foreign.C.Types 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__) # include # include diff --git a/Utility/Touch.hsc b/Utility/Touch.hsc index 24ccd17a6..b84054cbc 100644 --- a/Utility/Touch.hsc +++ b/Utility/Touch.hsc @@ -13,15 +13,14 @@ module Utility.Touch ( touch ) where +import Utility.FileSystemEncoding + 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 {- Changes the access and modification times of an existing file. -- cgit v1.2.3