    -- |
    -- 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 = 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 b. Ptr b -> Int -> IO Word8
    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 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    n  = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                | Bool
    otherwise = do
                    !w <- Ptr Word8 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Word8
    bin Int
    i
                    let !(# !w1, !w2 #) = convertByte w
                    pokeByteOff bout (i * 2)     w1
                    pokeByteOff bout (i * 2 + 1) w2
                    loop (i+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) = 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 = 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
        | 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 a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Int
    forall a. Maybe a
    Nothing
                | Bool
    otherwise = do
                    a <- Word8 -> Word8
    rHi (Word8 -> Word8) -> IO Word8 -> IO Word8
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Ptr Word8 -> Int -> IO Word8
    forall b. Ptr b -> Int -> IO Word8
    forall a b. Storable a => Ptr b -> Int -> IO a
    peekByteOff Ptr Word8
    src Int
    i
                    b <- rLo `fmap` peekByteOff src (i+1)
                    if a == 0xff || b == 0xff
                        then return $ Just i
                        else pokeByteOff dst di (a .|. b) >> loop (di+1) (i+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) = Word8 -> Word
    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) = 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"#