{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FileSystemEncoding (
useFileSystemEncoding,
fileEncoding,
withFilePath,
decodeBS,
encodeBS,
decodeW8,
encodeW8,
encodeW8NUL,
decodeW8NUL,
truncateFilePath,
s2w8,
w82s,
c2w8,
w82c,
) where
import qualified GHC.Foreign as GHC
import qualified GHC.IO.Encoding as Encoding
import Foreign.C
import System.IO
import System.IO.Unsafe
import Data.Word
import Data.List
import qualified Data.ByteString.Lazy as L
#ifdef mingw32_HOST_OS
import qualified Data.ByteString.Lazy.UTF8 as L8
#endif
import Utility.Exception
import Utility.Split
useFileSystemEncoding :: IO ()
useFileSystemEncoding = do
#ifndef mingw32_HOST_OS
e <- Encoding.getFileSystemEncoding
#else
let e = Encoding.utf8
#endif
hSetEncoding stdin e
hSetEncoding stdout e
hSetEncoding stderr e
Encoding.setLocaleEncoding e
fileEncoding :: Handle -> IO ()
#ifndef mingw32_HOST_OS
fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding
#else
fileEncoding h = hSetEncoding h Encoding.utf8
#endif
withFilePath :: FilePath -> (CString -> IO a) -> IO a
withFilePath fp f = Encoding.getFileSystemEncoding
>>= \enc -> GHC.withCString enc fp f
{-# NOINLINE _encodeFilePath #-}
_encodeFilePath :: FilePath -> String
_encodeFilePath fp = unsafePerformIO $ do
enc <- Encoding.getFileSystemEncoding
GHC.withCString enc fp (GHC.peekCString Encoding.char8)
`catchNonAsync` (\_ -> return fp)
decodeBS :: L.ByteString -> FilePath
#ifndef mingw32_HOST_OS
decodeBS = encodeW8NUL . L.unpack
#else
decodeBS = L8.toString
#endif
encodeBS :: FilePath -> L.ByteString
#ifndef mingw32_HOST_OS
encodeBS = L.pack . decodeW8NUL
#else
encodeBS = L8.fromString
#endif
{-# NOINLINE encodeW8 #-}
encodeW8 :: [Word8] -> FilePath
encodeW8 w8 = unsafePerformIO $ do
enc <- Encoding.getFileSystemEncoding
GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc
decodeW8 :: FilePath -> [Word8]
decodeW8 = s2w8 . _encodeFilePath
encodeW8NUL :: [Word8] -> FilePath
encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)
where
nul = '\NUL'
decodeW8NUL :: FilePath -> [Word8]
decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul
where
nul = '\NUL'
c2w8 :: Char -> Word8
c2w8 = fromIntegral . fromEnum
w82c :: Word8 -> Char
w82c = toEnum . fromIntegral
s2w8 :: String -> [Word8]
s2w8 = map c2w8
w82s :: [Word8] -> String
w82s = map w82c
truncateFilePath :: Int -> FilePath -> FilePath
#ifndef mingw32_HOST_OS
truncateFilePath n = go . reverse
where
go f =
let bytes = decodeW8 f
in if length bytes <= n
then reverse f
else go (drop 1 f)
#else
truncateFilePath n = reverse . go [] n . L8.fromString
where
go coll cnt bs
| cnt <= 0 = coll
| otherwise = case L8.decode bs of
Just (c, x) | c /= L8.replacement_char ->
let x' = fromIntegral x
in if cnt - x' < 0
then coll
else go (c:coll) (cnt - x') (L8.drop 1 bs)
_ -> coll
#endif