{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}
module Utility.FileSystemEncoding (
useFileSystemEncoding,
fileEncoding,
withFilePath,
RawFilePath,
fromRawFilePath,
toRawFilePath,
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 as S
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 :: IO ()
useFileSystemEncoding = do
#ifndef mingw32_HOST_OS
TextEncoding
e <- IO TextEncoding
Encoding.getFileSystemEncoding
#else
let e = Encoding.utf8
#endif
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdin TextEncoding
e
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stdout TextEncoding
e
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
stderr TextEncoding
e
TextEncoding -> IO ()
Encoding.setLocaleEncoding TextEncoding
e
fileEncoding :: Handle -> IO ()
#ifndef mingw32_HOST_OS
fileEncoding :: Handle -> IO ()
fileEncoding Handle
h = Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h (TextEncoding -> IO ()) -> IO TextEncoding -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO TextEncoding
Encoding.getFileSystemEncoding
#else
fileEncoding h = hSetEncoding h Encoding.utf8
#endif
withFilePath :: FilePath -> (CString -> IO a) -> IO a
withFilePath :: FilePath -> (CString -> IO a) -> IO a
withFilePath FilePath
fp CString -> IO a
f = IO TextEncoding
Encoding.getFileSystemEncoding
IO TextEncoding -> (TextEncoding -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> FilePath -> (CString -> IO a) -> IO a
forall a. TextEncoding -> FilePath -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
enc FilePath
fp CString -> IO a
f
{-# NOINLINE _encodeFilePath #-}
_encodeFilePath :: FilePath -> String
_encodeFilePath :: FilePath -> FilePath
_encodeFilePath FilePath
fp = IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ do
TextEncoding
enc <- IO TextEncoding
Encoding.getFileSystemEncoding
TextEncoding -> FilePath -> (CString -> IO FilePath) -> IO FilePath
forall a. TextEncoding -> FilePath -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
enc FilePath
fp (TextEncoding -> CString -> IO FilePath
GHC.peekCString TextEncoding
Encoding.char8)
IO FilePath -> (SomeException -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchNonAsync` (\SomeException
_ -> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
fp)
decodeBS :: L.ByteString -> FilePath
#ifndef mingw32_HOST_OS
decodeBS :: ByteString -> FilePath
decodeBS = [Word8] -> FilePath
encodeW8NUL ([Word8] -> FilePath)
-> (ByteString -> [Word8]) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
L.unpack
#else
decodeBS = L8.toString
#endif
encodeBS :: FilePath -> L.ByteString
#ifndef mingw32_HOST_OS
encodeBS :: FilePath -> ByteString
encodeBS = [Word8] -> ByteString
L.pack ([Word8] -> ByteString)
-> (FilePath -> [Word8]) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Word8]
decodeW8NUL
#else
encodeBS = L8.fromString
#endif
type RawFilePath = S.ByteString
fromRawFilePath :: RawFilePath -> FilePath
fromRawFilePath :: RawFilePath -> FilePath
fromRawFilePath = [Word8] -> FilePath
encodeW8 ([Word8] -> FilePath)
-> (RawFilePath -> [Word8]) -> RawFilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> [Word8]
S.unpack
toRawFilePath :: FilePath -> RawFilePath
toRawFilePath :: FilePath -> RawFilePath
toRawFilePath = [Word8] -> RawFilePath
S.pack ([Word8] -> RawFilePath)
-> (FilePath -> [Word8]) -> FilePath -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Word8]
decodeW8
{-# NOINLINE encodeW8 #-}
encodeW8 :: [Word8] -> FilePath
encodeW8 :: [Word8] -> FilePath
encodeW8 [Word8]
w8 = IO FilePath -> FilePath
forall a. IO a -> a
unsafePerformIO (IO FilePath -> FilePath) -> IO FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ do
TextEncoding
enc <- IO TextEncoding
Encoding.getFileSystemEncoding
TextEncoding -> FilePath -> (CString -> IO FilePath) -> IO FilePath
forall a. TextEncoding -> FilePath -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
Encoding.char8 ([Word8] -> FilePath
w82s [Word8]
w8) ((CString -> IO FilePath) -> IO FilePath)
-> (CString -> IO FilePath) -> IO FilePath
forall a b. (a -> b) -> a -> b
$ TextEncoding -> CString -> IO FilePath
GHC.peekCString TextEncoding
enc
decodeW8 :: FilePath -> [Word8]
decodeW8 :: FilePath -> [Word8]
decodeW8 = FilePath -> [Word8]
s2w8 (FilePath -> [Word8])
-> (FilePath -> FilePath) -> FilePath -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
_encodeFilePath
encodeW8NUL :: [Word8] -> FilePath
encodeW8NUL :: [Word8] -> FilePath
encodeW8NUL = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate [Char
nul] ([FilePath] -> FilePath)
-> ([Word8] -> [FilePath]) -> [Word8] -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Word8] -> FilePath) -> [[Word8]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> FilePath
encodeW8 ([[Word8]] -> [FilePath])
-> ([Word8] -> [[Word8]]) -> [Word8] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> [Word8] -> [[Word8]]
forall c. Eq c => c -> [c] -> [[c]]
splitc (Char -> Word8
c2w8 Char
nul)
where
nul :: Char
nul = Char
'\NUL'
decodeW8NUL :: FilePath -> [Word8]
decodeW8NUL :: FilePath -> [Word8]
decodeW8NUL = [Word8] -> [[Word8]] -> [Word8]
forall a. [a] -> [[a]] -> [a]
intercalate [Char -> Word8
c2w8 Char
nul] ([[Word8]] -> [Word8])
-> (FilePath -> [[Word8]]) -> FilePath -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [Word8]) -> [FilePath] -> [[Word8]]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [Word8]
decodeW8 ([FilePath] -> [[Word8]])
-> (FilePath -> [FilePath]) -> FilePath -> [[Word8]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> FilePath -> [FilePath]
forall c. Eq c => c -> [c] -> [[c]]
splitc Char
nul
where
nul :: Char
nul = Char
'\NUL'
c2w8 :: Char -> Word8
c2w8 :: Char -> Word8
c2w8 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
w82c :: Word8 -> Char
w82c :: Word8 -> Char
w82c = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
s2w8 :: String -> [Word8]
s2w8 :: FilePath -> [Word8]
s2w8 = (Char -> Word8) -> FilePath -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w8
w82s :: [Word8] -> String
w82s :: [Word8] -> FilePath
w82s = (Word8 -> Char) -> [Word8] -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
w82c
truncateFilePath :: Int -> FilePath -> FilePath
#ifndef mingw32_HOST_OS
truncateFilePath :: Int -> FilePath -> FilePath
truncateFilePath Int
n = FilePath -> FilePath
go (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse
where
go :: FilePath -> FilePath
go FilePath
f =
let bytes :: [Word8]
bytes = FilePath -> [Word8]
decodeW8 FilePath
f
in if [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
then FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
f
else FilePath -> FilePath
go (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
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