{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}

{-# OPTIONS_GHC -Wall -funbox-strict-fields #-}

{-| For concatenating fixed-width strings that are only a few
    characters each, this can be six times faster than the builder
    that ships with @bytestring@.
-}
module Data.ByteString.Builder.Fixed
  ( Builder
  , fromByteString
  , run
  , contramapBuilder
  , char8
  , word8
  , word8HexFixedLower
  , word8HexFixedUpper
  , word12HexFixedLower
  , word12HexFixedUpper
  ) where

#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
import Data.Word
import Data.Word.Synthetic.Word12 (Word12)
import Data.Bits
import Data.Char (ord)
import Text.Printf
import Data.ByteString.Internal (ByteString(..))
import Foreign
import Data.ByteString.Short (ShortByteString)
import qualified Data.Semigroup as Semigroup
import qualified Data.ByteString.Internal as BI
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Short.Internal as SBS

data Builder a where
  BuilderStatic :: !ByteString -> Builder a
  BuilderFunction :: !ByteString -> !(Int -> Ptr Word8 -> a -> IO ()) -> Builder a

{-# INLINE appendBuilder #-}
appendBuilder :: Builder a -> Builder a -> Builder a
appendBuilder :: Builder a -> Builder a -> Builder a
appendBuilder Builder a
x Builder a
y = case Builder a
x of
  BuilderStatic t1 :: ByteString
t1@(PS ForeignPtr Word8
_ Int
_ Int
len1) -> case Builder a
y of
    BuilderStatic ByteString
t2 -> ByteString -> Builder a
forall a. ByteString -> Builder a
BuilderStatic (ByteString
t1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t2)
    BuilderFunction ByteString
t2 Int -> Ptr Word8 -> a -> IO ()
f -> ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (ByteString
t1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t2) (\Int
ix Ptr Word8
marr a
a -> Int -> Ptr Word8 -> a -> IO ()
f (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1) Ptr Word8
marr a
a)
  BuilderFunction t1 :: ByteString
t1@(PS ForeignPtr Word8
_ Int
_ Int
len1) Int -> Ptr Word8 -> a -> IO ()
f1 -> case Builder a
y of
    BuilderStatic ByteString
t2 -> ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (ByteString
t1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t2) Int -> Ptr Word8 -> a -> IO ()
f1
    BuilderFunction ByteString
t2 Int -> Ptr Word8 -> a -> IO ()
f2 -> ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (ByteString
t1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t2) (\Int
ix Ptr Word8
marr a
a -> Int -> Ptr Word8 -> a -> IO ()
f1 Int
ix Ptr Word8
marr a
a IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Ptr Word8 -> a -> IO ()
f2 (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len1) Ptr Word8
marr a
a)

instance Semigroup.Semigroup (Builder a) where
  {-# INLINE (<>) #-}
  <> :: Builder a -> Builder a -> Builder a
(<>) = Builder a -> Builder a -> Builder a
forall a. Builder a -> Builder a -> Builder a
appendBuilder

instance Monoid (Builder a) where
  {-# INLINE mempty #-}
  mempty :: Builder a
mempty = ByteString -> Builder a
forall a. ByteString -> Builder a
BuilderStatic ByteString
ByteString.empty
  {-# INLINE mappend #-}
  mappend :: Builder a -> Builder a -> Builder a
mappend = Builder a -> Builder a -> Builder a
forall a. Semigroup a => a -> a -> a
(Semigroup.<>)

contramapBuilder :: (b -> a) -> Builder a -> Builder b
contramapBuilder :: (b -> a) -> Builder a -> Builder b
contramapBuilder b -> a
f Builder a
x = case Builder a
x of
  BuilderStatic ByteString
t -> ByteString -> Builder b
forall a. ByteString -> Builder a
BuilderStatic ByteString
t
  BuilderFunction ByteString
t Int -> Ptr Word8 -> a -> IO ()
g -> ByteString -> (Int -> Ptr Word8 -> b -> IO ()) -> Builder b
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction ByteString
t (\Int
ix Ptr Word8
marr b
b -> Int -> Ptr Word8 -> a -> IO ()
g Int
ix Ptr Word8
marr (b -> a
f b
b))
{-# INLINE contramapBuilder #-}

fromByteString :: ByteString -> Builder a
fromByteString :: ByteString -> Builder a
fromByteString = ByteString -> Builder a
forall a. ByteString -> Builder a
BuilderStatic
{-# INLINE fromByteString #-}

run :: Builder a -> a -> ByteString
run :: Builder a -> a -> ByteString
run Builder a
x a
a = case Builder a
x of
  BuilderStatic ByteString
t -> ByteString
t
  BuilderFunction (PS ForeignPtr Word8
inArr Int
off Int
len) Int -> Ptr Word8 -> a -> IO ()
f ->
    Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
len ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
inArr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
inPtr -> do
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Storable a => Ptr a -> Ptr a -> Int -> IO ()
copyArray Ptr Word8
ptr (Ptr Word8 -> Int -> Ptr Word8
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr Word8
inPtr Int
off) Int
len
      Int -> Ptr Word8 -> a -> IO ()
f Int
0 Ptr Word8
ptr a
a

word12HexFixedGeneral :: Bool -> Builder Word12
word12HexFixedGeneral :: Bool -> Builder Word12
word12HexFixedGeneral Bool
upper = ByteString
-> (Int -> Ptr Word8 -> Word12 -> IO ()) -> Builder Word12
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (String -> ByteString
BC8.pack String
"---") ((Int -> Ptr Word8 -> Word12 -> IO ()) -> Builder Word12)
-> (Int -> Ptr Word8 -> Word12 -> IO ()) -> Builder Word12
forall a b. (a -> b) -> a -> b
$ \Int
i Ptr Word8
marr Word12
w -> do
  let !wInt :: Int
wInt = Word12 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word12
w
      !ix :: Int
ix = Int
wInt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wInt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wInt
      !arr :: ShortByteString
arr = if Bool
upper then ShortByteString
hexValuesWord12Upper else ShortByteString
hexValuesWord12Lower
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr Int
i (ShortByteString -> Int -> Word8
SBS.unsafeIndex ShortByteString
arr Int
ix)
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ShortByteString -> Int -> Word8
SBS.unsafeIndex ShortByteString
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (ShortByteString -> Int -> Word8
SBS.unsafeIndex ShortByteString
arr (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2))
{-# INLINE word12HexFixedGeneral #-}

word12HexFixedUpper :: Builder Word12
word12HexFixedUpper :: Builder Word12
word12HexFixedUpper = Bool -> Builder Word12
word12HexFixedGeneral Bool
True
{-# INLINE word12HexFixedUpper #-}

word12HexFixedLower :: Builder Word12
word12HexFixedLower :: Builder Word12
word12HexFixedLower = Bool -> Builder Word12
word12HexFixedGeneral Bool
False
{-# INLINE word12HexFixedLower #-}

hexValuesWord12Upper :: ShortByteString
hexValuesWord12Upper :: ShortByteString
hexValuesWord12Upper =
  [Word8] -> ShortByteString
SBS.pack ([Word8] -> ShortByteString) -> [Word8] -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [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
ord) (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03X") [Int
0 :: Int ..Int
4095]
{-# NOINLINE hexValuesWord12Upper #-}

hexValuesWord12Lower :: ShortByteString
hexValuesWord12Lower :: ShortByteString
hexValuesWord12Lower =
  [Word8] -> ShortByteString
SBS.pack ([Word8] -> ShortByteString) -> [Word8] -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [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
ord) (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%03x") [Int
0 :: Int ..Int
4095]
{-# NOINLINE hexValuesWord12Lower #-}

word8HexFixedUpper :: Builder Word8
word8HexFixedUpper :: Builder Word8
word8HexFixedUpper = Bool -> Builder Word8
word8HexFixedGeneral Bool
True
{-# INLINE word8HexFixedUpper #-}

word8HexFixedLower :: Builder Word8
word8HexFixedLower :: Builder Word8
word8HexFixedLower = Bool -> Builder Word8
word8HexFixedGeneral Bool
False
{-# INLINE word8HexFixedLower #-}

-- The Bool is True if the hex digits are upper case.
word8HexFixedGeneral :: Bool -> Builder Word8
word8HexFixedGeneral :: Bool -> Builder Word8
word8HexFixedGeneral Bool
upper = ByteString -> (Int -> Ptr Word8 -> Word8 -> IO ()) -> Builder Word8
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (String -> ByteString
BC8.pack String
"--") ((Int -> Ptr Word8 -> Word8 -> IO ()) -> Builder Word8)
-> (Int -> Ptr Word8 -> Word8 -> IO ()) -> Builder Word8
forall a b. (a -> b) -> a -> b
$ \Int
i Ptr Word8
marr Word8
w -> do
  let !ix :: Int
ix = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w) Int
1
      !ix2 :: Int
ix2 = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      !arr :: ShortByteString
arr = if Bool
upper then ShortByteString
hexValuesWord8Upper else ShortByteString
hexValuesWord8Lower
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr Int
i (ShortByteString -> Int -> Word8
SBS.unsafeIndex ShortByteString
arr Int
ix)
  Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (ShortByteString -> Int -> Word8
SBS.unsafeIndex ShortByteString
arr Int
ix2)
{-# INLINE word8HexFixedGeneral #-}

hexValuesWord8Upper :: ShortByteString
hexValuesWord8Upper :: ShortByteString
hexValuesWord8Upper =
  [Word8] -> ShortByteString
SBS.pack ([Word8] -> ShortByteString) -> [Word8] -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [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
ord) (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02X") [Int
0 :: Int ..Int
255]
{-# NOINLINE hexValuesWord8Upper #-}

hexValuesWord8Lower :: ShortByteString
hexValuesWord8Lower :: ShortByteString
hexValuesWord8Lower =
  [Word8] -> ShortByteString
SBS.pack ([Word8] -> ShortByteString) -> [Word8] -> ShortByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> String -> [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
ord) (String -> [Word8]) -> String -> [Word8]
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%02x") [Int
0 :: Int ..Int
255]
{-# NOINLINE hexValuesWord8Lower #-}

char8 :: Builder Char
char8 :: Builder Char
char8 = ByteString -> (Int -> Ptr Word8 -> Char -> IO ()) -> Builder Char
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (String -> ByteString
BC8.pack String
"-") ((Int -> Ptr Word8 -> Char -> IO ()) -> Builder Char)
-> (Int -> Ptr Word8 -> Char -> IO ()) -> Builder Char
forall a b. (a -> b) -> a -> b
$ \Int
i Ptr Word8
marr Char
c -> Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr Int
i (Char -> Word8
c2w Char
c)
{-# INLINE char8 #-}

word8 :: Builder Word8
word8 :: Builder Word8
word8 = ByteString -> (Int -> Ptr Word8 -> Word8 -> IO ()) -> Builder Word8
forall a.
ByteString -> (Int -> Ptr Word8 -> a -> IO ()) -> Builder a
BuilderFunction (String -> ByteString
BC8.pack String
"-") ((Int -> Ptr Word8 -> Word8 -> IO ()) -> Builder Word8)
-> (Int -> Ptr Word8 -> Word8 -> IO ()) -> Builder Word8
forall a b. (a -> b) -> a -> b
$ \Int
i Ptr Word8
marr Word8
w -> Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
marr Int
i Word8
w
{-# INLINE word8 #-}

-- | Taken from @Data.ByteString.Internal@. The same warnings
--   apply here.
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = 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
ord
{-# INLINE c2w #-}

-- macBuilder :: Builder Word64
-- macBuilder =
--      contramapBuilder (word8At 40) twoDigitWord8Hex
--   <> BuilderStatic ":"
--   <> contramapBuilder (word8At 32) twoDigitWord8Hex
--   <> BuilderStatic ":"
--   <> contramapBuilder (word8At 24) twoDigitWord8Hex
--   <> BuilderStatic ":"
--   <> contramapBuilder (word8At 16) twoDigitWord8Hex
--   <> BuilderStatic ":"
--   <> contramapBuilder (word8At 8) twoDigitWord8Hex
--   <> BuilderStatic ":"
--   <> contramapBuilder (word8At 0) twoDigitWord8Hex