{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
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
newtype EncodingTable = EncodingTable (ForeignPtr Word8)
tableFromList :: [Word8] -> EncodingTable
tableFromList xs = case S.pack xs of S.PS fp _ _ -> EncodingTable fp
unsafeIndex :: EncodingTable -> Int -> IO Word8
unsafeIndex (EncodingTable table) = peekElemOff (unsafeForeignPtrToPtr table)
base16EncodingTable :: EncodingTable -> IO EncodingTable
base16EncodingTable alphabet = do
xs <- sequence $ concat $ [ [ix j, ix k] | j <- [0..15], k <- [0..15] ]
return $ tableFromList xs
where
ix = unsafeIndex alphabet
{-# NOINLINE lowerAlphabet #-}
lowerAlphabet :: EncodingTable
lowerAlphabet =
tableFromList $ map (fromIntegral . fromEnum) $ ['0'..'9'] ++ ['a'..'f']
{-# NOINLINE lowerTable #-}
lowerTable :: EncodingTable
lowerTable = unsafePerformIO $ base16EncodingTable lowerAlphabet
{-# INLINE encode8_as_16h #-}
encode8_as_16h :: EncodingTable -> Word8 -> IO Word16
encode8_as_16h (EncodingTable table) =
peekElemOff (castPtr $ unsafeForeignPtrToPtr table) . fromIntegral