{-# LANGUAGE NoImplicitPrelude
, BangPatterns
, TypeApplications
, MultiWayIf
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module System.OsPath.Encoding.Internal where
import qualified System.OsPath.Data.ByteString.Short as BS8
import qualified System.OsPath.Data.ByteString.Short.Word16 as BS16
import GHC.Base
import GHC.Real
import GHC.Num
import GHC.IO.Buffer
import GHC.IO.Encoding.Failure
import GHC.IO.Encoding.Types
import Data.Bits
import Control.Exception (SomeException, try, Exception (displayException), evaluate)
import qualified GHC.Foreign as GHC
import Data.Either (Either)
import GHC.IO (unsafePerformIO)
import Control.DeepSeq (force, NFData (rnf))
import Data.Bifunctor (first)
import Data.Data (Typeable)
import GHC.Show (Show (show))
import Numeric (showHex)
import Foreign.C (CStringLen)
import Data.Char (chr)
import Foreign
import Prelude (FilePath)
import GHC.IO.Encoding (getFileSystemEncoding)
ucs2le :: TextEncoding
ucs2le :: TextEncoding
ucs2le = CodingFailureMode -> TextEncoding
mkUcs2le CodingFailureMode
ErrorOnCodingFailure
mkUcs2le :: CodingFailureMode -> TextEncoding
mkUcs2le :: CodingFailureMode -> TextEncoding
mkUcs2le CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = String
"UCS-2LE",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
ucs2le_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
ucs2le_EF CodingFailureMode
cfm }
ucs2le_DF :: CodingFailureMode -> IO (TextDecoder ())
ucs2le_DF :: CodingFailureMode -> IO (TextDecoder ())
ucs2le_DF CodingFailureMode
cfm =
TextDecoder () -> IO (TextDecoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Word8 Char
encode = CodeBuffer Word8 Char
ucs2le_decode,
recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recover = CodingFailureMode
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recoverDecode CodingFailureMode
cfm,
close :: IO ()
close = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO ()
getState = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState :: () -> IO ()
setState = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
ucs2le_EF :: CodingFailureMode -> IO (TextEncoder ())
ucs2le_EF :: CodingFailureMode -> IO (TextEncoder ())
ucs2le_EF CodingFailureMode
cfm =
TextEncoder () -> IO (TextEncoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Char Word8
encode = CodeBuffer Char Word8
ucs2le_encode,
recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recover = CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
cfm,
close :: IO ()
close = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO ()
getState = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState :: () -> IO ()
setState = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
ucs2le_decode :: DecodeBuffer
ucs2le_decode :: CodeBuffer Word8 Char
ucs2le_decode
input :: Buffer Word8
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Char
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
= let
loop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop !Int
ir !Int
ow
| Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
os = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
OutputUnderflow Int
ir Int
ow
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
| Int
ir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
| Bool
otherwise = do
Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
let x1 :: Int
x1 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr Int
x1)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow'
done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done a
why !Int
ir !Int
ow = (a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Word8
input{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
else Buffer Word8
input{ bufL :: Int
bufL=Int
ir },
Buffer Char
output{ bufR :: Int
bufR=Int
ow })
in
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop Int
ir0 Int
ow0
ucs2le_encode :: EncodeBuffer
ucs2le_encode :: CodeBuffer Char Word8
ucs2le_encode
input :: Buffer Char
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Word8
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
= let
done :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done a
why !Int
ir !Int
ow = (a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Char
input{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
else Buffer Char
input{ bufL :: Int
bufL=Int
ir },
Buffer Word8
output{ bufR :: Int
bufR=Int
ow })
loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop !Int
ir !Int
ow
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InputUnderflow Int
ir Int
ow
| Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow
| Bool
otherwise = do
(Char
c,Int
ir') <- RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir
case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> do
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
| Bool
otherwise -> CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InvalidSequence Int
ir Int
ow
in
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir0 Int
ow0
utf16le_b :: TextEncoding
utf16le_b :: TextEncoding
utf16le_b = CodingFailureMode -> TextEncoding
mkUTF16le_b CodingFailureMode
ErrorOnCodingFailure
mkUTF16le_b :: CodingFailureMode -> TextEncoding
mkUTF16le_b :: CodingFailureMode -> TextEncoding
mkUTF16le_b CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-16LE_b",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf16le_b_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf16le_b_EF CodingFailureMode
cfm }
utf16le_b_DF :: CodingFailureMode -> IO (TextDecoder ())
utf16le_b_DF :: CodingFailureMode -> IO (TextDecoder ())
utf16le_b_DF CodingFailureMode
cfm =
TextDecoder () -> IO (TextDecoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Word8 Char
encode = CodeBuffer Word8 Char
utf16le_b_decode,
recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recover = CodingFailureMode
-> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
recoverDecode CodingFailureMode
cfm,
close :: IO ()
close = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO ()
getState = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState :: () -> IO ()
setState = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf16le_b_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16le_b_EF :: CodingFailureMode -> IO (TextEncoder ())
utf16le_b_EF CodingFailureMode
cfm =
TextEncoder () -> IO (TextEncoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Char Word8
encode = CodeBuffer Char Word8
utf16le_b_encode,
recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recover = CodingFailureMode
-> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
recoverEncode CodingFailureMode
cfm,
close :: IO ()
close = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO ()
getState = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState :: () -> IO ()
setState = IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf16le_b_decode :: DecodeBuffer
utf16le_b_decode :: CodeBuffer Word8 Char
utf16le_b_decode
input :: Buffer Word8
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Char
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
= let
loop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop !Int
ir !Int
ow
| Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
os = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
OutputUnderflow Int
ir Int
ow
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
| Int
ir Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
| Bool
otherwise = do
Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
let x1 :: Int
x1 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0
if | Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 -> do
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
Word8
c3 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
let x2 :: Int
x2 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c3 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c2
if | Int
0xd800 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x1 Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdbff
, Int
0xdc00 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x2 Bool -> Bool -> Bool
&& Int
x2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdfff -> do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr ((Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xd800)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xdc00) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x10000))
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow'
| Bool
otherwise -> do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr Int
x1)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow'
| Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 -> do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr Int
x1)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow'
| Bool
otherwise -> CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done a
why !Int
ir !Int
ow = (a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Word8
input{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
else Buffer Word8
input{ bufL :: Int
bufL=Int
ir },
Buffer Char
output{ bufR :: Int
bufR=Int
ow })
in
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop Int
ir0 Int
ow0
utf16le_b_encode :: EncodeBuffer
utf16le_b_encode :: CodeBuffer Char Word8
utf16le_b_encode
input :: Buffer Char
input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Char
iraw, bufL :: forall e. Buffer e -> Int
bufL=Int
ir0, bufR :: forall e. Buffer e -> Int
bufR=Int
iw, bufSize :: forall e. Buffer e -> Int
bufSize=Int
_ }
output :: Buffer Word8
output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
bufRaw=RawBuffer Word8
oraw, bufL :: forall e. Buffer e -> Int
bufL=Int
_, bufR :: forall e. Buffer e -> Int
bufR=Int
ow0, bufSize :: forall e. Buffer e -> Int
bufSize=Int
os }
= let
done :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done a
why !Int
ir !Int
ow = (a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
if Int
ir Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
iw then Buffer Char
input{ bufL :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
else Buffer Char
input{ bufL :: Int
bufL=Int
ir },
Buffer Word8
output{ bufR :: Int
bufR=Int
ow })
loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop !Int
ir !Int
ow
| Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
iw = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InputUnderflow Int
ir Int
ow
| Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow
| Bool
otherwise = do
(Char
c,Int
ir') <- RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir
case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> do
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
| Bool
otherwise ->
if Int
os Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then CodingProgress
-> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
forall (m :: * -> *) a.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow else do
let x' :: Int
x' = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
w1 :: Int
w1 = Int
x' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xd800
w2 :: Int
w2 = Int
x' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xdc00
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w1)
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w2)
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
w2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
8))
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4)
in
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir0 Int
ow0
cWcharsToChars_UCS2 :: [Word16] -> [Char]
cWcharsToChars_UCS2 :: [Word16] -> String
cWcharsToChars_UCS2 = (Word16 -> Char) -> [Word16] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word16 -> Int) -> Word16 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
cWcharsToChars :: [Word16] -> [Char]
cWcharsToChars :: [Word16] -> String
cWcharsToChars = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr ([Int] -> String) -> ([Word16] -> [Int]) -> [Word16] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
fromUTF16 ([Int] -> [Int]) -> ([Word16] -> [Int]) -> [Word16] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int) -> [Word16] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
where
fromUTF16 :: [Int] -> [Int]
fromUTF16 :: [Int] -> [Int]
fromUTF16 (Int
c1:Int
c2:[Int]
wcs)
| Int
0xd800 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c1 Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdbff Bool -> Bool -> Bool
&& Int
0xdc00 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
c2 Bool -> Bool -> Bool
&& Int
c2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xdfff =
((Int
c1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xd800)Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
c2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0xdc00) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x10000) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int]
fromUTF16 [Int]
wcs
fromUTF16 (Int
c:[Int]
wcs) = Int
c Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int]
fromUTF16 [Int]
wcs
fromUTF16 [] = []
charsToCWchars :: [Char] -> [Word16]
charsToCWchars :: String -> [Word16]
charsToCWchars = (Char -> [Word16] -> [Word16]) -> [Word16] -> String -> [Word16]
forall a b. (a -> b -> b) -> b -> [a] -> b
foldr (Int -> [Word16] -> [Word16]
utf16Char (Int -> [Word16] -> [Word16])
-> (Char -> Int) -> Char -> [Word16] -> [Word16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) []
where
utf16Char :: Int -> [Word16] -> [Word16]
utf16Char :: Int -> [Word16] -> [Word16]
utf16Char Int
c [Word16]
wcs
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
: [Word16]
wcs
| Bool
otherwise = let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000 in
Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xd800) Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
:
Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x400 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xdc00) Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
: [Word16]
wcs
withFilePathWin :: FilePath -> (Int -> Ptr Word16 -> IO a) -> IO a
withFilePathWin :: String -> (Int -> Ptr Word16 -> IO a) -> IO a
withFilePathWin = [Word16] -> (Int -> Ptr Word16 -> IO a) -> IO a
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen ([Word16] -> (Int -> Ptr Word16 -> IO a) -> IO a)
-> (String -> [Word16])
-> String
-> (Int -> Ptr Word16 -> IO a)
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Word16]
charsToCWchars
peekFilePathWin :: (Ptr Word16, Int) -> IO FilePath
peekFilePathWin :: (Ptr Word16, Int) -> IO String
peekFilePathWin (Ptr Word16
cp, Int
l) = do
[Word16]
cs <- Int -> Ptr Word16 -> IO [Word16]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
l Ptr Word16
cp
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word16] -> String
cWcharsToChars [Word16]
cs)
withFilePathPosix :: FilePath -> (CStringLen -> IO a) -> IO a
withFilePathPosix :: String -> (CStringLen -> IO a) -> IO a
withFilePathPosix String
fp CStringLen -> IO a
f = IO TextEncoding
getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> String -> (CStringLen -> IO a) -> IO a
forall a. TextEncoding -> String -> (CStringLen -> IO a) -> IO a
GHC.withCStringLen TextEncoding
enc String
fp CStringLen -> IO a
f
peekFilePathPosix :: CStringLen -> IO FilePath
peekFilePathPosix :: CStringLen -> IO String
peekFilePathPosix CStringLen
fp = IO TextEncoding
getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \TextEncoding
enc -> TextEncoding -> CStringLen -> IO String
GHC.peekCStringLen TextEncoding
enc CStringLen
fp
decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String
decodeWithTE :: TextEncoding -> ShortByteString -> Either EncodingException String
decodeWithTE TextEncoding
enc ShortByteString
ba = IO (Either EncodingException String)
-> Either EncodingException String
forall a. IO a -> a
unsafePerformIO (IO (Either EncodingException String)
-> Either EncodingException String)
-> IO (Either EncodingException String)
-> Either EncodingException String
forall a b. (a -> b) -> a -> b
$ do
Either SomeException String
r <- forall a.
Exception SomeException =>
IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (IO String -> IO (Either SomeException String))
-> IO String -> IO (Either SomeException String)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> (CStringLen -> IO String) -> IO String
forall a. ShortByteString -> (CStringLen -> IO a) -> IO a
BS8.useAsCStringLen ShortByteString
ba ((CStringLen -> IO String) -> IO String)
-> (CStringLen -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CStringLen
fp -> TextEncoding -> CStringLen -> IO String
GHC.peekCStringLen TextEncoding
enc CStringLen
fp
Either EncodingException String
-> IO (Either EncodingException String)
forall a. a -> IO a
evaluate (Either EncodingException String
-> IO (Either EncodingException String))
-> Either EncodingException String
-> IO (Either EncodingException String)
forall a b. (a -> b) -> a -> b
$ Either EncodingException String -> Either EncodingException String
forall a. NFData a => a -> a
force (Either EncodingException String
-> Either EncodingException String)
-> Either EncodingException String
-> Either EncodingException String
forall a b. (a -> b) -> a -> b
$ (SomeException -> EncodingException)
-> Either SomeException String -> Either EncodingException String
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String -> Maybe Word8 -> EncodingException)
-> Maybe Word8 -> String -> EncodingException
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Maybe Word8 -> EncodingException
EncodingError Maybe Word8
forall a. Maybe a
Nothing (String -> EncodingException)
-> (SomeException -> String) -> SomeException -> EncodingException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) Either SomeException String
r
encodeWithTE :: TextEncoding -> String -> Either EncodingException BS8.ShortByteString
encodeWithTE :: TextEncoding -> String -> Either EncodingException ShortByteString
encodeWithTE TextEncoding
enc String
str = IO (Either EncodingException ShortByteString)
-> Either EncodingException ShortByteString
forall a. IO a -> a
unsafePerformIO (IO (Either EncodingException ShortByteString)
-> Either EncodingException ShortByteString)
-> IO (Either EncodingException ShortByteString)
-> Either EncodingException ShortByteString
forall a b. (a -> b) -> a -> b
$ do
Either SomeException ShortByteString
r <- forall a.
Exception SomeException =>
IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (IO ShortByteString -> IO (Either SomeException ShortByteString))
-> IO ShortByteString -> IO (Either SomeException ShortByteString)
forall a b. (a -> b) -> a -> b
$ TextEncoding
-> String
-> (CStringLen -> IO ShortByteString)
-> IO ShortByteString
forall a. TextEncoding -> String -> (CStringLen -> IO a) -> IO a
GHC.withCStringLen TextEncoding
enc String
str ((CStringLen -> IO ShortByteString) -> IO ShortByteString)
-> (CStringLen -> IO ShortByteString) -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \CStringLen
cstr -> CStringLen -> IO ShortByteString
BS8.packCStringLen CStringLen
cstr
Either EncodingException ShortByteString
-> IO (Either EncodingException ShortByteString)
forall a. a -> IO a
evaluate (Either EncodingException ShortByteString
-> IO (Either EncodingException ShortByteString))
-> Either EncodingException ShortByteString
-> IO (Either EncodingException ShortByteString)
forall a b. (a -> b) -> a -> b
$ Either EncodingException ShortByteString
-> Either EncodingException ShortByteString
forall a. NFData a => a -> a
force (Either EncodingException ShortByteString
-> Either EncodingException ShortByteString)
-> Either EncodingException ShortByteString
-> Either EncodingException ShortByteString
forall a b. (a -> b) -> a -> b
$ (SomeException -> EncodingException)
-> Either SomeException ShortByteString
-> Either EncodingException ShortByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((String -> Maybe Word8 -> EncodingException)
-> Maybe Word8 -> String -> EncodingException
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Maybe Word8 -> EncodingException
EncodingError Maybe Word8
forall a. Maybe a
Nothing (String -> EncodingException)
-> (SomeException -> String) -> SomeException -> EncodingException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException) Either SomeException ShortByteString
r
decodeWithBasePosix :: BS8.ShortByteString -> IO String
decodeWithBasePosix :: ShortByteString -> IO String
decodeWithBasePosix ShortByteString
ba = ShortByteString -> (CStringLen -> IO String) -> IO String
forall a. ShortByteString -> (CStringLen -> IO a) -> IO a
BS8.useAsCStringLen ShortByteString
ba ((CStringLen -> IO String) -> IO String)
-> (CStringLen -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \CStringLen
fp -> CStringLen -> IO String
peekFilePathPosix CStringLen
fp
encodeWithBasePosix :: String -> IO BS8.ShortByteString
encodeWithBasePosix :: String -> IO ShortByteString
encodeWithBasePosix String
str = String -> (CStringLen -> IO ShortByteString) -> IO ShortByteString
forall a. String -> (CStringLen -> IO a) -> IO a
withFilePathPosix String
str ((CStringLen -> IO ShortByteString) -> IO ShortByteString)
-> (CStringLen -> IO ShortByteString) -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \CStringLen
cstr -> CStringLen -> IO ShortByteString
BS8.packCStringLen CStringLen
cstr
decodeWithBaseWindows :: BS16.ShortByteString -> IO String
decodeWithBaseWindows :: ShortByteString -> IO String
decodeWithBaseWindows ShortByteString
ba = ShortByteString -> ((Ptr Word16, Int) -> IO String) -> IO String
forall a. ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a
BS16.useAsCWStringLen ShortByteString
ba (((Ptr Word16, Int) -> IO String) -> IO String)
-> ((Ptr Word16, Int) -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \(Ptr Word16, Int)
fp -> (Ptr Word16, Int) -> IO String
peekFilePathWin (Ptr Word16, Int)
fp
encodeWithBaseWindows :: String -> IO BS16.ShortByteString
encodeWithBaseWindows :: String -> IO ShortByteString
encodeWithBaseWindows String
str = String
-> (Int -> Ptr Word16 -> IO ShortByteString) -> IO ShortByteString
forall a. String -> (Int -> Ptr Word16 -> IO a) -> IO a
withFilePathWin String
str ((Int -> Ptr Word16 -> IO ShortByteString) -> IO ShortByteString)
-> (Int -> Ptr Word16 -> IO ShortByteString) -> IO ShortByteString
forall a b. (a -> b) -> a -> b
$ \Int
l Ptr Word16
cstr -> (Ptr Word16, Int) -> IO ShortByteString
BS16.packCWStringLen (Ptr Word16
cstr, Int
l)
data EncodingException =
EncodingError String (Maybe Word8)
deriving (EncodingException -> EncodingException -> Bool
(EncodingException -> EncodingException -> Bool)
-> (EncodingException -> EncodingException -> Bool)
-> Eq EncodingException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingException -> EncodingException -> Bool
$c/= :: EncodingException -> EncodingException -> Bool
== :: EncodingException -> EncodingException -> Bool
$c== :: EncodingException -> EncodingException -> Bool
Eq, Typeable)
showEncodingException :: EncodingException -> String
showEncodingException :: EncodingException -> String
showEncodingException (EncodingError String
desc (Just Word8
w))
= String
"Cannot decode byte '\\x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
w (String
"': " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc)
showEncodingException (EncodingError String
desc Maybe Word8
Nothing)
= String
"Cannot decode input: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc
instance Show EncodingException where
show :: EncodingException -> String
show = EncodingException -> String
showEncodingException
instance Exception EncodingException
instance NFData EncodingException where
rnf :: EncodingException -> ()
rnf (EncodingError String
desc Maybe Word8
w) = String -> ()
forall a. NFData a => a -> ()
rnf String
desc () -> () -> ()
`seq` Maybe Word8 -> ()
forall a. NFData a => a -> ()
rnf Maybe Word8
w
wNUL :: Word16
wNUL :: Word16
wNUL = Word16
0x00