{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
-- |
-- Copyright   : (c) 2011 Simon Meier
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Simon Meier <iridcode@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-- Hexadecimal encoding of nibbles (4-bit) and octets (8-bit) as ASCII
-- characters.
--
-- The current implementation is based on a table based encoding inspired by
-- the code in the 'base64-bytestring' library by Bryan O'Sullivan. In our
-- benchmarks on a 32-bit machine it turned out to be the fastest
-- implementation option.
--
module Data.ByteString.Builder.Prim.Internal.Base16 (
    EncodingTable
  , lowerTable
  , encode8_as_16h
  ) where

import qualified Data.ByteString          as S
import qualified Data.ByteString.Internal as S

#if MIN_VERSION_base(4,4,0)
#if MIN_VERSION_base(4,7,0)
import           Foreign
#else
import           Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)
#endif
import           Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import           System.IO.Unsafe (unsafePerformIO)
#else
import           Foreign
#endif

-- Creating the encoding table
------------------------------

-- TODO: Use table from C implementation.

-- | An encoding table for Base16 encoding.
newtype EncodingTable = EncodingTable (ForeignPtr Word8)

tableFromList :: [Word8] -> EncodingTable
tableFromList :: [Word8] -> EncodingTable
tableFromList [Word8]
xs = case [Word8] -> ByteString
S.pack [Word8]
xs of S.PS ForeignPtr Word8
fp Int
_ Int
_ -> ForeignPtr Word8 -> EncodingTable
EncodingTable ForeignPtr Word8
fp

unsafeIndex :: EncodingTable -> Int -> IO Word8
unsafeIndex :: EncodingTable -> Int -> IO Word8
unsafeIndex (EncodingTable ForeignPtr Word8
table) = Ptr Word8 -> Int -> IO Word8
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
table)

base16EncodingTable :: EncodingTable -> IO EncodingTable
base16EncodingTable :: EncodingTable -> IO EncodingTable
base16EncodingTable EncodingTable
alphabet = do
    [Word8]
xs <- [IO Word8] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO Word8] -> IO [Word8]) -> [IO Word8] -> IO [Word8]
forall a b. (a -> b) -> a -> b
$ [[IO Word8]] -> [IO Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[IO Word8]] -> [IO Word8]) -> [[IO Word8]] -> [IO Word8]
forall a b. (a -> b) -> a -> b
$ [ [Int -> IO Word8
ix Int
j, Int -> IO Word8
ix Int
k] | Int
j <- [Int
0..Int
15], Int
k <- [Int
0..Int
15] ]
    EncodingTable -> IO EncodingTable
forall (m :: * -> *) a. Monad m => a -> m a
return (EncodingTable -> IO EncodingTable)
-> EncodingTable -> IO EncodingTable
forall a b. (a -> b) -> a -> b
$ [Word8] -> EncodingTable
tableFromList [Word8]
xs
  where
    ix :: Int -> IO Word8
ix = EncodingTable -> Int -> IO Word8
unsafeIndex EncodingTable
alphabet

{-# NOINLINE lowerAlphabet #-}
lowerAlphabet :: EncodingTable
lowerAlphabet :: EncodingTable
lowerAlphabet =
    [Word8] -> EncodingTable
tableFromList ([Word8] -> EncodingTable) -> [Word8] -> EncodingTable
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum) ([Char] -> [Word8]) -> [Char] -> [Word8]
forall a b. (a -> b) -> a -> b
$ [Char
'0'..Char
'9'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'f']

-- | The encoding table for hexadecimal values with lower-case characters;
-- e.g., deadbeef.
{-# NOINLINE lowerTable #-}
lowerTable :: EncodingTable
lowerTable :: EncodingTable
lowerTable = IO EncodingTable -> EncodingTable
forall a. IO a -> a
unsafePerformIO (IO EncodingTable -> EncodingTable)
-> IO EncodingTable -> EncodingTable
forall a b. (a -> b) -> a -> b
$ EncodingTable -> IO EncodingTable
base16EncodingTable EncodingTable
lowerAlphabet

-- | Encode an octet as 16bit word comprising both encoded nibbles ordered
-- according to the host endianness. Writing these 16bit to memory will write
-- the nibbles in the correct order (i.e. big-endian).
{-# INLINE encode8_as_16h #-}
encode8_as_16h :: EncodingTable -> Word8 -> IO Word16
encode8_as_16h :: EncodingTable -> Word8 -> IO Word16
encode8_as_16h (EncodingTable ForeignPtr Word8
table) =
    Ptr Word16 -> Int -> IO Word16
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8 -> Ptr Word16) -> Ptr Word8 -> Ptr Word16
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
table) (Int -> IO Word16) -> (Word8 -> Int) -> Word8 -> IO Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral