{-# 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 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 :: forall a. FilePath -> (CString -> IO a) -> IO a
withFilePath FilePath
fp CString -> IO a
f = IO TextEncoding
Encoding.getFileSystemEncoding
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> 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 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
TextEncoding
enc <- IO TextEncoding
Encoding.getFileSystemEncoding
forall a. TextEncoding -> FilePath -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
enc FilePath
fp (TextEncoding -> CString -> IO FilePath
GHC.peekCString TextEncoding
Encoding.char8)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchNonAsync` (\SomeException
_ -> 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 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 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [Word8]
decodeW8
{-# NOINLINE encodeW8 #-}
encodeW8 :: [Word8] -> FilePath
encodeW8 :: [Word8] -> FilePath
encodeW8 [Word8]
w8 = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
TextEncoding
enc <- IO TextEncoding
Encoding.getFileSystemEncoding
forall a. TextEncoding -> FilePath -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
Encoding.char8 ([Word8] -> FilePath
w82s [Word8]
w8) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
_encodeFilePath
encodeW8NUL :: [Word8] -> FilePath
encodeW8NUL :: [Word8] -> FilePath
encodeW8NUL = forall a. [a] -> [[a]] -> [a]
intercalate [Char
nul] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> FilePath
encodeW8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. [a] -> [[a]] -> [a]
intercalate [Char -> Word8
c2w8 Char
nul] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> [Word8]
decodeW8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Eq c => c -> [c] -> [[c]]
splitc Char
nul
where
nul :: Char
nul = Char
'\NUL'
c2w8 :: Char -> Word8
c2w8 :: Char -> Word8
c2w8 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
w82c :: Word8 -> Char
w82c :: Word8 -> Char
w82c = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
s2w8 :: String -> [Word8]
s2w8 :: FilePath -> [Word8]
s2w8 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w8
w82s :: [Word8] -> String
w82s :: [Word8] -> FilePath
w82s = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
where
go :: FilePath -> FilePath
go FilePath
f =
let bytes :: [Word8]
bytes = FilePath -> [Word8]
decodeW8 FilePath
f
in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
bytes forall a. Ord a => a -> a -> Bool
<= Int
n
then forall a. [a] -> [a]
reverse FilePath
f
else FilePath -> FilePath
go (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