8000 Primitive decoders · postgres-haskell/postgres-wire@a5a3f7c · GitHub
[go: up one dir, main page]
Skip to content
8000

Commit a5a3f7c

Browse files
VyacheslavHashovVyacheslavHashov
committed
Primitive decoders
1 parent 5732f4c commit a5a3f7c

File tree

3 files changed

+49
-58
lines changed

3 files changed

+49
-58
lines changed

‎src/Database/PostgreSQL/Protocol/Codecs/Decoders.hs

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Database.PostgreSQL.Protocol.Codecs.Decoders where
22

33
import Data.Word
4+
import Data.Int
45
import Data.Char
56
import Control.Monad
67
import qualified Data.ByteString as B
@@ -14,14 +15,14 @@ skipHeader = skipBytes 7
1415
{-# INLINE getNullable #-}
1516
getNullable :: Decode a -> Decode (Maybe a)
1617
getNullable dec = do
17-
len <- getWord32BE
18+
len <- getInt32BE
1819
if len == -1
1920
then pure Nothing
2021
else Just <$!> dec
2122

2223
{-# INLINE getString #-}
2324
getString :: Decode (Maybe B.ByteString)
24-
getString = getWord32BE >>= (Just <$!>) . getByteString . fromIntegral
25+
getString = getInt32BE >>= (Just <$!>) . getByteString . fromIntegral
2526

2627
{-# INLINE getBool #-}
2728
getBool :: Decode Bool
@@ -32,23 +33,23 @@ getCh :: Decode Char
3233
getCh = (chr . fromIntegral) <$> getWord8
3334

3435

35-
getCustom :: Decode (Maybe B.ByteString, Maybe Word32, Maybe Word32,
36-
Maybe Word16, Maybe Bool, Maybe Char, Maybe Bool,
37-
Maybe Bool, Maybe Char, Maybe Word32, Maybe Word32,
38-
Maybe Word32)
36+
getCustom :: Decode (Maybe B.ByteString, Maybe Int32, Maybe Int32,
37+
Maybe Int16, Maybe Bool, Maybe Char, Maybe Bool,
38+
Maybe Bool, Maybe Char, Maybe Int32, Maybe Int32,
39+
Maybe Int32)
3940
getCustom = (,,,,,,,,,,,) <$>
4041
getString <*>
41-
(getNullable getWord32BE) <*>
42-
(getNullable getWord32BE) <*>
43-
(getNullable getWord16BE) <*>
42+
(getNullable getInt32BE) <*>
43+
(getNullable getInt32BE) <*>
44+
(getNullable getInt16BE) <*>
4445
(getNullable getBool) <*>
4546
(getNullable getCh) <*>
4647
(getNullable getBool) <*>
4748
(getNullable getBool) <*>
4849
(getNullable getCh) <*>
49-
(getNullable getWord32BE) <*>
50-
(getNullable getWord32BE) <*>
51-
(getNullable getWord32BE)
50+
(getNullable getInt32BE) <*>
51+
(getNullable getInt32BE) <*>
52+
(getNullable getInt32BE)
5253

5354
getCustomRow = skipHeader *> getCustom
5455

‎src/Database/PostgreSQL/Protocol/ExtractDataRows.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,6 @@ loopExtractDataRows readMoreAction callback = go "" ""
7373
-- On ErrorResponse we should discard all the collected datarows.
7474
69 -> do
7575
(b, newBs) <- readAtLeast bs len
76-
-- TODO handle errors
7776
desc <- eitherToProtocolEx $ parseErrorDesc b
7877
callback (DataError desc)
7978

‎src/Database/PostgreSQL/Protocol/Store/Decode.hs

Lines changed: 36 additions & 45 deletions
B41A
Original file line numberDiff line numberDiff line change
@@ -17,79 +17,70 @@ import qualified Data.ByteString.Internal as B
1717
newtype Decode a = Decode (Peek a)
1818
deriving (Functor, Applicative, Monad)
1919

20+
{-# INLINE runDecode #-}
2021
runDecode :: Decode a -> B.ByteString -> (B.ByteString, a)
2122
runDecode (Decode dec) bs =
2223
let (offset,v ) = decodeExPortionWith dec bs
2324
in (B.drop offset bs, v)
24-
{-# INLINE runDecode #-}
2525

26-
fixed :: Int -> (Ptr Word8 -> IO a) -> Decode a
27-
fixed len f = Decode $ Peek $ \ps ptr -> do
26+
{-# INLINE prim #-}
27+
prim :: Int -> (Ptr Word8 -> IO a) -> Decode a
28+
prim len f = Decode $ Peek $ \ps ptr -> do
2829
!v <- f ptr
2930
let !newPtr = ptr `plusPtr` len
3031
return (newPtr, v)
3132
-- return $ PeekResult newPtr v
32-
{-# INLINE fixed #-}
33-
34-
getByte :: Decode Word8
35-
getByte = fixed 1 peek
36-
{-# INLINE getByte #-}
37-
38-
getTwoBytes :: Decode (Word8, Word8)
39-
getTwoBytes = fixed 2 $ \ptr -> do
40-
b1 <- peek ptr
41-
b2 <- peekByteOff ptr 1
42-
return (b1, b2)
43-
{-# INLINE getTwoBytes #-}
44-
45-
getFourBytes :: Decode (Word8, Word8, Word8, Word8)
46-
getFourBytes = fixed 4 $ \ptr -> do
47-
b1 <- peek ptr
48-
b2 <- peekByteOff ptr 1
49-
b3 <- peekByteOff ptr 2
50-
b4 <- peekByteOff ptr 3
51-
return (b1, b2, b3, b4)
52-
{-# INLINE getFourBytes #-}
5333

54-
skipBytes :: Int -> Decode ()
55-
skipBytes n = fixed n $ const $ pure ()
56-
57-
-----------
5834
-- Public
5935

36+
{-# INLINE skipBytes #-}
37+
skipBytes :: Int -> Decode ()
38+
skipBytes n = prim n $ const $ pure ()
39+
40+
{-# INLINE getByteString #-}
6041
getByteString :: Int -> Decode B.ByteString
6142
getByteString len = Decode $ Peek $ \ps ptr -> do
6243
bs <- B.packCStringLen (castPtr ptr, len)
6344
let !newPtr = ptr `plusPtr` len
6445
-- return $ PeekResult newPtr bs
6546
return (newPtr, bs)
66-
{-# INLINE getByteString #-}
6747

48+
{-# INLINE getByteStringNull #-}
6849
getByteStringNull :: Decode B.ByteString
6950
getByteStringNull = Decode $ Peek $ \ps ptr -> do
7051
bs <- B.packCString (castPtr ptr)
7152
let !newPtr = ptr `plusPtr` (B.length bs + 1)
7253
-- return $ PeekResult newPtr bs
7354
return (newPtr, bs)
74-
{-# INLINE getByteStringNull #-}
7555

76-
getWord8 :: Decode Word8
77-
getWord8 = getByte
7856
{-# INLINE getWord8 #-}
57+
getWord8 :: Decode Word8
58+
getWord8 = prim 1 peek
7959

80-
getWord16BE :: Decode Word16
81-
getWord16BE = fixed 2 $ \ptr -> byteSwap16 <$> peek (castPtr ptr)
82-
{-# INLINE getWord16BE #-}
83-
84-
getWord32BE :: Decode Word32
85-
getWord32BE = fixed 4 $ \ptr -> byteSwap32 <$> peek (castPtr ptr)
86-
{-# INLINE getWord32BE #-}
87-
88-
getInt16BE :: Decode Int16
89-
getInt16BE = fromIntegral <$> getWord16BE
9060
{-# INLINE getInt16BE #-}
61+
getInt16BE :: Decode Int16
62+
getInt16BE = prim 2 $ \ptr -> fromIntegral . byteSwap16 <$> peek (castPtr ptr)
9163

92-
getInt32BE :: Decode Int32
93-
getInt32BE = fromIntegral <$> getWord32BE
9464
{-# INLINE getInt32BE #-}
95-
65+
getInt32BE :: Decode Int32
66+
getInt32BE = prim 4 $ \ptr -> fromIntegral . byteSwap32 <$> peek (castPtr ptr)
67+
68+
{-# INLINE getInt64BE #-}
69+
getInt64BE :: Decode Int64
70+
getInt64BE = prim 8 $ \ptr -> fromIntegral . byteSwap64 <$> peek (castPtr ptr)
71+
72+
{-# INLINE getFloat32BE #-}
73+
getFloat32BE :: Decode Float
74+
getFloat32BE = prim 4 $ \ptr -> byteSwap32 <$> peek (castPtr ptr)
75+
>>= wordToFloat
76+
77+
{-# INLINE getFloat64BE #-}
78+
getFloat64BE :: Decode Double
79+
getFloat64BE = prim 8 $ \ptr -> byteSwap64 <$> peek (castPtr ptr)
80+
>>= wordToFloat
81+
82+
{-# INLINE wordToFloat #-}
83+
wordToFloat :: (Storable word, Storable float) => word -> IO float
84+
wordToFloat word = alloca $ \buf -> do
85+
poke (castPtr buf) word
86+
peek buf

0 commit comments

Comments
 (0)
0