-- |
-- Module      : Data.Memory.Encoding.Base16
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- Low-level Base16 encoding and decoding.
--
-- If you just want to encode or decode some bytes, you probably want to use
-- the "Data.ByteArray.Encoding" module.
--
{-# 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)

-- | Transform a raw memory to an hexadecimal 'String'
-- 
-- user beware, no checks are made
showHexadecimal :: (forall a . (Ptr Word8 -> IO a) -> IO a) -- ^ a 'with' type of function to hold reference to the object
                -> Int    -- ^ length in bytes
                -> String
showHexadecimal :: (forall a. (Ptr Word8 -> IO a) -> IO a) -> Int -> String
showHexadecimal forall a. (Ptr Word8 -> IO a) -> IO a
withPtr = forall {t}. (Ord t, Num t) => Int -> t -> String
doChunks Int
0
  where
        doChunks :: Int -> t -> String
doChunks Int
ofs t
len
            | t
len forall a. Ord a => a -> a -> Bool
< t
4   = 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) = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ 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 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w2 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w3 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w4
                  forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w5 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w6 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w7 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w8
                  forall a. a -> [a] -> [a]
: Int -> t -> String
doChunks (Int
ofs forall a. Num a => a -> a -> a
+ Int
4) (t
len forall a. Num a => a -> a -> a
- t
4)

        doUnique :: Int -> t -> String
doUnique Int
ofs t
len
            | t
len forall a. Eq a => a -> a -> Bool
== t
0  = []
            | Bool
otherwise =
                let !b :: Word8
b            = forall a. IO a -> a
unsafeDoIO forall a b. (a -> b) -> a -> b
$ 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 forall a. a -> [a] -> [a]
: Word8 -> Char
wToChar Word8
w2 forall a. a -> [a] -> [a]
: Int -> t -> String
doUnique (Int
ofs forall a. Num a => a -> a -> a
+ Int
1) (t
len 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 =
            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
ofsforall a. Num a => a -> a -> a
+Int
1) Ptr Word8
p)
                         (Int -> Ptr Word8 -> IO Word8
byteIndex (Int
ofsforall a. Num a => a -> a -> a
+Int
2) Ptr Word8
p) (Int -> Ptr Word8 -> IO Word8
byteIndex (Int
ofsforall a. Num a => a -> a -> a
+Int
3) Ptr Word8
p)

        wToChar :: Word8 -> Char
        wToChar :: Word8 -> Char
wToChar Word8
w = Int -> Char
chr (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 = forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
p Int
i

-- | Transform a number of bytes pointed by.@src in the hexadecimal binary representation in @dst
--
-- destination memory need to be of correct size, otherwise it will lead
-- to really bad things.
toHexadecimal :: Ptr Word8 -- ^ destination memory
              -> Ptr Word8 -- ^ source memory
              -> Int       -- ^ number of bytes
              -> 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 forall a. Eq a => a -> a -> Bool
== Int
n  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
            | Bool
otherwise = do
                !Word8
w <- 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
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
bout (Int
i forall a. Num a => a -> a -> a
* Int
2)     Word8
w1
                forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
bout (Int
i forall a. Num a => a -> a -> a
* Int
2 forall a. Num a => a -> a -> a
+ Int
1) Word8
w2
                Int -> IO ()
loop (Int
iforall a. Num a => a -> a -> a
+Int
1)

-- | Convert a value Word# to two Word#s containing
-- the hexadecimal representation of the Word#
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) = forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
bwrap
        r :: Addr# -> Word# -> Word8
        r :: Addr# -> Word# -> Word8
r Addr#
table Word#
index = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
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 #-}

-- | convert a base16 @src in @dst.
--
-- n need to even
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
    | forall a. Integral a => a -> Bool
odd Int
n     = 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 forall a. Eq a => a -> a -> Bool
== Int
n    = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            | Bool
otherwise = do
                Word8
a <- Word8 -> Word8
rHi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src Int
i
                Word8
b <- Word8 -> Word8
rLo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
src (Int
iforall a. Num a => a -> a -> a
+Int
1)
                if Word8
a forall a. Eq a => a -> a -> Bool
== Word8
0xff Bool -> Bool -> Bool
|| Word8
b forall a. Eq a => a -> a -> Bool
== Word8
0xff
                    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Int
i
                    else forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
dst Int
di (Word8
a forall bits. BitOps bits => bits -> bits -> bits
.|. Word8
b) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Int -> IO (Maybe Int)
loop (Int
diforall a. Num a => a -> a -> a
+Int
1) (Int
iforall a. Num a => a -> a -> a
+Int
2)

        rLo, rHi :: Word8 -> Word8
        rLo :: Word8 -> Word8
rLo Word8
index = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
tableLo (Word# -> Int#
word2Int# Word#
widx))
          where !(W# Word#
widx) = forall a b. IntegralUpsize a b => a -> b
integralUpsize Word8
index
        rHi :: Word8 -> Word8
rHi Word8
index = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
tableHi (Word# -> Int#
word2Int# Word#
widx))
          where !(W# Word#
widx) = 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"#