{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Rank2Types #-}
module Data.Memory.Encoding.Base16
( showHexadecimal
, toHexadecimal
, fromHexadecimal
) where
import Data.Memory.Internal.Compat
import Data.Word
import Basement.Bits
import Basement.IntegralConv
import GHC.Prim
import GHC.Types
import GHC.Word
import GHC.Char (chr)
import Control.Monad
import Foreign.Storable
import Foreign.Ptr (Ptr)
showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a)
-> Int
-> String
showHexadecimal :: (forall a. (Ptr Word8 -> IO a) -> IO a) -> Int -> String
showHexadecimal forall a. (Ptr Word8 -> IO a) -> IO a
withPtr = Int -> Int -> String
forall t. (Ord t, Num t) => Int -> t -> String
doChunks Int
0
where
doChunks :: Int -> t -> String
doChunks Int
ofs t
len
| t
len t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
4 = Int -> t -> String
forall t. (Eq t, Num t) => Int -> t -> String
doUnique Int
ofs t
len
| Bool
otherwise = do
let !(Word8
a, Word8
b, Word8
c, Word8
d) = IO (Word8, Word8, Word8, Word8) -> (Word8, Word8, Word8, Word8)
forall a. IO a -> a
unsafeDoIO (IO (Word8, Word8, Word8, Word8) -> (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8) -> (Word8, Word8, Word8, Word8)
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> IO (Word8, Word8, Word8, Word8))
-> IO (Word8, Word8, Word8, Word8)
forall a. (Ptr Word8 -> IO a) -> IO a
withPtr (Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8)
read4 Int
ofs)
!(# Word8
w1, Word8
w2 #) = Word8 -> (# Word8, Word8 #)
convertByte Word8
a
!(# Word8
w3, Word8
w4 #) = Word8 -> (# Word8, Word8 #)
convertByte Word8
b
!(# Word8
w5, Word8
w6 #) = Word8 -> (# Word8, Word8 #)
convertByte Word8
c
!(# Word8
w7, Word8
w8 #) = Word8 -> (# Word8, Word8 #)
convertByte Word8
d
in Word8 -> Char
wToChar Word8
w1 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w2 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w3 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w4
Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w5 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w6 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w7 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w8
Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> t -> String
doChunks (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
4)
doUnique :: Int -> t -> String
doUnique Int
ofs t
len
| t
len t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = []
| Bool
otherwise =
let !b :: Word8
b = IO Word8 -> Word8
forall a. IO a -> a
unsafeDoIO (IO Word8 -> Word8) -> IO Word8 -> Word8
forall a b. (a -> b) -> a -> b
$ (Ptr Word8 -> IO Word8) -> IO Word8
forall a. (Ptr Word8 -> IO a) -> IO a
withPtr (Int -> Ptr Word8 -> IO Word8
byteIndex Int
ofs)
!(# Word8
w1, Word8
w2 #) = Word8 -> (# Word8, Word8 #)
convertByte Word8
b
in Word8 -> Char
wToChar Word8
w1 Char -> String -> String
forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w2 Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> t -> String
doUnique (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (t
len t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
read4 :: Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8)
read4 :: Int -> Ptr Word8 -> IO (Word8, Word8, Word8, Word8)
read4 Int
ofs Ptr Word8
p =
(Word8 -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8))
-> IO Word8
-> IO Word8
-> IO Word8
-> IO Word8
-> IO (Word8, Word8, Word8, Word8)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) (Int -> Ptr Word8 -> IO Word8
byteIndex Int
ofs Ptr Word8
p) (Int -> Ptr Word8 -> IO Word8
byteIndex (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Ptr Word8
p)
(Int -> Ptr Word8 -> IO Word8
byteIndex (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Ptr Word8
p) (Int -> Ptr Word8 -> IO Word8
byteIndex (Int
ofsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Ptr Word8
p)
wToChar :: Word8 -> Char
wToChar :: Word8 -> Char
wToChar Word8
w = Int -> Char
chr (Word8 -> Int
forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
w)
byteIndex :: Int -> Ptr Word8 -> IO Word8
byteIndex :: Int -> Ptr Word8 -> IO Word8
byteIndex Int
i Ptr Word8
p = Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
i
toHexadecimal :: Ptr Word8
-> Ptr Word8
-> Int
-> IO ()
toHexadecimal :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
toHexadecimal Ptr Word8
bout Ptr Word8
bin Int
n = Int -> IO ()
loop Int
0
where loop :: Int -> IO ()
loop Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
!Word8
w <- Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
bin Int
i
let !(# !Word8
w1, !Word8
w2 #) = Word8 -> (# Word8, Word8 #)
convertByte Word8
w
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
bout (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) Word8
w1
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
bout (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
w2
Int -> IO ()
loop (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
convertByte :: Word8 -> (# Word8, Word8 #)
convertByte :: Word8 -> (# Word8, Word8 #)
convertByte Word8
bwrap = (# Addr# -> Word# -> Word8
r Addr#
tableHi Word#
b, Addr# -> Word# -> Word8
r Addr#
tableLo Word#
b #)
where
!(W# Word#
b) = Word8 -> Word
forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
bwrap
r :: Addr# -> Word# -> Word8
r :: Addr# -> Word# -> Word8
r Addr#
table Word#
index = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
table (Word# -> Int#
word2Int# Word#
index))
!tableLo :: Addr#
tableLo =
Addr#
"0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef\
\0123456789abcdef0123456789abcdef"#
!tableHi :: Addr#
tableHi =
Addr#
"00000000000000001111111111111111\
\22222222222222223333333333333333\
\44444444444444445555555555555555\
\66666666666666667777777777777777\
\88888888888888889999999999999999\
\aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\
\ccccccccccccccccdddddddddddddddd\
\eeeeeeeeeeeeeeeeffffffffffffffff"#
{-# INLINE convertByte #-}
fromHexadecimal :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromHexadecimal :: Ptr Word8 -> Ptr Word8 -> Int -> IO (Maybe Int)
fromHexadecimal Ptr Word8
dst Ptr Word8
src Int
n
| Int -> Bool
forall a. Integral a => a -> Bool
odd Int
n = String -> IO (Maybe Int)
forall a. HasCallStack => String -> a
error String
"fromHexadecimal: invalid odd length."
| Bool
otherwise = Int -> Int -> IO (Maybe Int)
loop Int
0 Int
0
where loop :: Int -> Int -> IO (Maybe Int)
loop Int
di Int
i
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
| Bool
otherwise = do
Word8
a <- Word8 -> Word8
rHi (Word8 -> Word8) -> IO Word8 -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
Word8
b <- Word8 -> Word8
rLo (Word8 -> Word8) -> IO Word8 -> IO Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr Word8 -> Int -> IO Word8
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
if Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff
then Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
else Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di (Word8
a Word8 -> Word8 -> Word8
forall bits. BitOps bits => bits -> bits -> bits
.|. Word8
b) IO () -> IO (Maybe Int) -> IO (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO (Maybe Int)
loop (Int
diInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
rLo, rHi :: Word8 -> Word8
rLo :: Word8 -> Word8
rLo Word8
index = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
tableLo (Word# -> Int#
word2Int# Word#
widx))
where !(W# Word#
widx) = Word8 -> Word
forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
index
rHi :: Word8 -> Word8
rHi Word8
index = Word# -> Word8
W8# (Addr# -> Int# -> Word#
indexWord8OffAddr# Addr#
tableHi (Word# -> Int#
word2Int# Word#
widx))
where !(W# Word#
widx) = Word8 -> Word
forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
index
!tableLo :: Addr#
tableLo =
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"#
!tableHi :: Addr#
tableHi =
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"#