{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.ClickHouseDriver.IO.BufferedWriter
( writeBinaryStr,
writeBinaryFixedLengthStr,
writeVarUInt,
c_write_varint,
writeBinaryInt8,
writeBinaryInt16,
writeBinaryInt32,
writeBinaryInt64,
writeBinaryUInt8,
writeBinaryUInt16,
writeBinaryUInt32,
writeBinaryUInt64,
writeBinaryUInt128,
writeIn,
transform,
Writer,
MonoidMap,
)
where
import Control.Monad.IO.Class ( MonadIO(liftIO) )
import Control.Monad.Writer (WriterT, tell)
import qualified Data.Binary as Binary
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder
( Builder, toLazyByteString, byteString )
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Builder (lazyByteString)
import Data.ByteString.Unsafe
( unsafePackCString, unsafePackCStringLen )
import Data.DoubleWord (Word128 (..))
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Word ( Word8, Word16, Word32, Word64 )
import Foreign.C ( CString )
class (Monoid w, Monoid m)=>MonoidMap w m where
transform :: w->m
instance MonoidMap ByteString L.ByteString where
transform :: ByteString -> ByteString
transform = ByteString -> ByteString
L.fromStrict
instance MonoidMap L.ByteString ByteString where
transform :: ByteString -> ByteString
transform = ByteString -> ByteString
L.toStrict
instance MonoidMap ByteString Builder where
transform :: ByteString -> Builder
transform = ByteString -> Builder
byteString
instance MonoidMap L.ByteString Builder where
transform :: ByteString -> Builder
transform = ByteString -> Builder
lazyByteString
instance MonoidMap Builder L.ByteString where
transform :: Builder -> ByteString
transform = Builder -> ByteString
toLazyByteString
instance MonoidMap Builder ByteString where
transform :: Builder -> ByteString
transform = ByteString -> ByteString
L.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString
instance (Monoid w)=>MonoidMap w w where
transform :: w -> w
transform = w -> w
forall a. a -> a
id
type Writer w = WriterT w IO ()
writeBinaryFixedLengthStr :: (MonoidMap ByteString w)=>Word->ByteString->Writer w
writeBinaryFixedLengthStr :: Word -> ByteString -> Writer w
writeBinaryFixedLengthStr Word
len ByteString
str = do
let l :: Word
l = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
str
if Word
len Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
l
then [Char] -> Writer w
forall a. HasCallStack => [Char] -> a
error [Char]
"Error: the length of the given bytestring does not equal to the given length"
else do
ByteString -> Writer w
forall m w. MonoidMap m w => m -> Writer w
writeIn ByteString
str
writeBinaryStr :: (MonoidMap ByteString w)=>ByteString->Writer w
writeBinaryStr :: ByteString -> Writer w
writeBinaryStr ByteString
str = do
let l :: Int
l = ByteString -> Int
BS.length ByteString
str
Word -> Writer w
forall w. MonoidMap ByteString w => Word -> Writer w
writeVarUInt (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
ByteString -> Writer w
forall m w. MonoidMap m w => m -> Writer w
writeIn ByteString
str
writeVarUInt ::(MonoidMap ByteString w)=>Word->Writer w
writeVarUInt :: Word -> Writer w
writeVarUInt Word
n = do
ByteString
varuint <- IO ByteString -> WriterT w IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> WriterT w IO ByteString)
-> IO ByteString -> WriterT w IO ByteString
forall a b. (a -> b) -> a -> b
$ Word -> IO ByteString
leb128 Word
n
ByteString -> Writer w
forall m w. MonoidMap m w => m -> Writer w
writeIn ByteString
varuint
where
leb128 :: Word->IO ByteString
leb128 :: Word -> IO ByteString
leb128 Word
0 = do
CString
ostr' <- Word -> IO CString
c_write_varint Word
0
CStringLen -> IO ByteString
unsafePackCStringLen (CString
ostr', Int
1)
leb128 Word
n = do
CString
ostr' <- Word -> IO CString
c_write_varint Word
n
CString -> IO ByteString
unsafePackCString CString
ostr'
writeBinaryUInt8 :: (MonoidMap L.ByteString w)=>Word8->Writer w
writeBinaryUInt8 :: Word8 -> Writer w
writeBinaryUInt8 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word8 -> w) -> Word8 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word8 -> ByteString) -> Word8 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word8 -> ByteString) -> Word8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryInt8 :: (MonoidMap L.ByteString w)=>Int8->Writer w
writeBinaryInt8 :: Int8 -> Writer w
writeBinaryInt8 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int8 -> w) -> Int8 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int8 -> ByteString) -> Int8 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int8 -> ByteString) -> Int8 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryInt16 :: (MonoidMap L.ByteString w)=>Int16->Writer w
writeBinaryInt16 :: Int16 -> Writer w
writeBinaryInt16 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int16 -> w) -> Int16 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int16 -> ByteString) -> Int16 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int16 -> ByteString) -> Int16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryInt32 :: (MonoidMap L.ByteString w)=>Int32->Writer w
writeBinaryInt32 :: Int32 -> Writer w
writeBinaryInt32 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int32 -> w) -> Int32 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int32 -> ByteString) -> Int32 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int32 -> ByteString) -> Int32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryInt64 :: (MonoidMap L.ByteString w)=>Int64->Writer w
writeBinaryInt64 :: Int64 -> Writer w
writeBinaryInt64 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Int64 -> w) -> Int64 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Int64 -> ByteString) -> Int64 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Int64 -> ByteString) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryUInt16 :: (MonoidMap L.ByteString w)=>Word16->Writer w
writeBinaryUInt16 :: Word16 -> Writer w
writeBinaryUInt16 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word16 -> w) -> Word16 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word16 -> ByteString) -> Word16 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word16 -> ByteString) -> Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryUInt32 :: (MonoidMap L.ByteString w)=>Word32->Writer w
writeBinaryUInt32 :: Word32 -> Writer w
writeBinaryUInt32 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word32 -> w) -> Word32 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word32 -> ByteString) -> Word32 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word32 -> ByteString) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryUInt64 :: (MonoidMap L.ByteString w)=>Word64->Writer w
writeBinaryUInt64 :: Word64 -> Writer w
writeBinaryUInt64 = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (Word64 -> w) -> Word64 -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> w
forall w m. MonoidMap w m => w -> m
transform (ByteString -> w) -> (Word64 -> ByteString) -> Word64 -> w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.reverse (ByteString -> ByteString)
-> (Word64 -> ByteString) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode
writeBinaryUInt128 :: (MonoidMap L.ByteString w)=>Word128->Writer w
writeBinaryUInt128 :: Word128 -> Writer w
writeBinaryUInt128 (Word128 Word64
hi Word64
lo) = do
Word64 -> Writer w
forall w. MonoidMap ByteString w => Word64 -> Writer w
writeBinaryUInt64 Word64
hi
Word64 -> Writer w
forall w. MonoidMap ByteString w => Word64 -> Writer w
writeBinaryUInt64 Word64
lo
writeIn :: (MonoidMap m w)=>m->Writer w
writeIn :: m -> Writer w
writeIn = w -> Writer w
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (w -> Writer w) -> (m -> w) -> m -> Writer w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> w
forall w m. MonoidMap w m => w -> m
transform
foreign import ccall unsafe "varuint.h write_varint" c_write_varint :: Word -> IO CString