{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
module Data.ByteString.Base16.Internal
(
encodeLoop
, decodeLoop
, lenientLoop
, c2w
, aix
, reChunk
, withBS
, mkBS
) where
import Data.Bits ((.&.), (.|.), unsafeShiftR)
import qualified Data.ByteString as B
import Data.ByteString.Internal (ByteString(..))
import Data.Char (ord)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (Ptr, minusPtr, plusPtr)
import Foreign.Storable (Storable(poke, peek))
import GHC.Word (Word8(..))
import GHC.Exts (Int(I#), Addr#, indexWord8OffAddr#)
#if __GLASGOW_HASKELL__ >= 702
import System.IO.Unsafe (unsafeDupablePerformIO)
#else
import GHC.IO (unsafeDupablePerformIO)
#endif
encodeLoop
:: Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ()
encodeLoop :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()
encodeLoop !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> IO ()
go Ptr Word8
dptr Ptr Word8
sptr
where
!hex :: Addr#
hex = Addr#
"0123456789abcdef"#
go :: Ptr Word8 -> Ptr Word8 -> IO ()
go !Ptr Word8
dst !Ptr Word8
src
| Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
!Word8
t <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8 -> Addr# -> Word8
aix (forall a. Bits a => a -> Int -> a
unsafeShiftR Word8
t Int
4) Addr#
hex)
forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (Word8 -> Addr# -> Word8
aix (Word8
t forall a. Bits a => a -> a -> a
.&. Word8
0x0f) Addr#
hex)
Ptr Word8 -> Ptr Word8 -> IO ()
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
2) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
{-# INLINE encodeLoop #-}
decodeLoop
:: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO (Either String ByteString)
decodeLoop :: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO (Either String ByteString)
decodeLoop !ForeignPtr Word8
dfp !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> IO (Either String ByteString)
go Ptr Word8
dptr Ptr Word8
sptr
where
err :: Ptr a -> m (Either String b)
err !Ptr a
src = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
forall a b. (a -> b) -> a -> b
$ String
"invalid character at offset: "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Ptr a
src forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
sptr)
!lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
!hi :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
go :: Ptr Word8 -> Ptr Word8 -> IO (Either String ByteString)
go !Ptr Word8
dst !Ptr Word8
src
| Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
dfp (Ptr Word8
dst forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
dptr)))
| Bool
otherwise = do
!Word8
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
!Word8
y <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
let !a :: Word8
a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi
!b :: Word8
b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo
if Word8
a forall a. Eq a => a -> a -> Bool
== Word8
0xff
then forall {m :: * -> *} {a} {b}.
Monad m =>
Ptr a -> m (Either String b)
err Ptr Word8
src
else
if Word8
b forall a. Eq a => a -> a -> Bool
== Word8
0xff
then forall {m :: * -> *} {a} {b}.
Monad m =>
Ptr a -> m (Either String b)
err (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1)
else do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8
a forall a. Bits a => a -> a -> a
.|. Word8
b)
Ptr Word8 -> Ptr Word8 -> IO (Either String ByteString)
go (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
2)
{-# INLINE decodeLoop #-}
lenientLoop
:: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> IO ByteString
lenientLoop :: ForeignPtr Word8
-> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ByteString
lenientLoop !ForeignPtr Word8
dfp !Ptr Word8
dptr !Ptr Word8
sptr !Ptr Word8
end = Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi Ptr Word8
dptr Ptr Word8
sptr Int
0
where
!lo :: Addr#
lo = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
!hi :: Addr#
hi = Addr#
"\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
goHi :: Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi !Ptr Word8
dst !Ptr Word8
src !Int
n
| Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
dfp Int
n)
| Bool
otherwise = do
!Word8
x <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
let !a :: Word8
a = Word8 -> Addr# -> Word8
aix Word8
x Addr#
hi
if Word8
a forall a. Eq a => a -> a -> Bool
== Word8
0xff
then Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi Ptr Word8
dst (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) Int
n
else Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ByteString
goLo Ptr Word8
dst (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) Word8
a Int
n
goLo :: Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ByteString
goLo !Ptr Word8
dst !Ptr Word8
src !Word8
a !Int
n
| Ptr Word8
src forall a. Eq a => a -> a -> Bool
== Ptr Word8
end = forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
dfp Int
n)
| Bool
otherwise = do
!Word8
y <- forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
src
let !b :: Word8
b = Word8 -> Addr# -> Word8
aix Word8
y Addr#
lo
if Word8
b forall a. Eq a => a -> a -> Bool
== Word8
0xff
then Ptr Word8 -> Ptr Word8 -> Word8 -> Int -> IO ByteString
goLo Ptr Word8
dst (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) Word8
a Int
n
else do
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
dst (Word8
a forall a. Bits a => a -> a -> a
.|. Word8
b)
Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString
goHi (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
dst Int
1) (forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr Word8
src Int
1) (Int
n forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE lenientLoop #-}
aix :: Word8 -> Addr# -> Word8
aix :: Word8 -> Addr# -> Word8
aix Word8
w Addr#
table = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
table Int#
i)
where
!(I# Int#
i) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w
{-# INLINE aix #-}
reChunk :: [ByteString] -> [ByteString]
reChunk :: [ByteString] -> [ByteString]
reChunk [] = []
reChunk (ByteString
c:[ByteString]
cs) = case ByteString -> Int
B.length ByteString
c forall a. Integral a => a -> a -> (a, a)
`divMod` Int
2 of
(Int
_, Int
0) -> ByteString
c forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
reChunk [ByteString]
cs
(Int
n, Int
_) -> case Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
n forall a. Num a => a -> a -> a
* Int
2) ByteString
c of
~(ByteString
m, ByteString
q) -> ByteString
m forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
cont_ ByteString
q [ByteString]
cs
where
cont_ :: ByteString -> [ByteString] -> [ByteString]
cont_ ByteString
q [] = [ByteString
q]
cont_ ByteString
q (ByteString
a:[ByteString]
as) = case Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
1 ByteString
a of
~(ByteString
x, ByteString
y) -> let q' :: ByteString
q' = ByteString -> ByteString -> ByteString
B.append ByteString
q ByteString
x
in if ByteString -> Int
B.length ByteString
q' forall a. Eq a => a -> a -> Bool
== Int
2
then
let as' :: [ByteString]
as' = if ByteString -> Bool
B.null ByteString
y then [ByteString]
as else ByteString
yforall a. a -> [a] -> [a]
:[ByteString]
as
in ByteString
q' forall a. a -> [a] -> [a]
: [ByteString] -> [ByteString]
reChunk [ByteString]
as'
else ByteString -> [ByteString] -> [ByteString]
cont_ ByteString
q' [ByteString]
as
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}
mkBS :: ForeignPtr Word8 -> Int -> ByteString
#if MIN_VERSION_bytestring(0,11,0)
mkBS :: ForeignPtr Word8 -> Int -> ByteString
mkBS ForeignPtr Word8
dfp Int
n = ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
dfp Int
n
#else
mkBS dfp n = PS dfp 0 n
#endif
{-# INLINE mkBS #-}
withBS :: ByteString -> (Ptr Word8 -> Int -> IO a) -> a
#if MIN_VERSION_bytestring(0,11,0)
withBS :: forall a. ByteString -> (Ptr Word8 -> Int -> IO a) -> a
withBS (BS !ForeignPtr Word8
sfp !Int
slen) Ptr Word8 -> Int -> IO a
f = forall a. IO a -> a
unsafeDupablePerformIO forall a b. (a -> b) -> a -> b
$
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
sfp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> Int -> IO a
f Ptr Word8
p Int
slen
#else
withBS (PS !sfp !soff !slen) f = unsafeDupablePerformIO $
withForeignPtr sfp $ \p -> f (plusPtr p soff) slen
#endif
{-# INLINE withBS #-}