Moved out high-lever from bench and tests

This commit is contained in:
VyacheslavHashov 2017-03-01 19:31:42 +03:00
parent d4cb44390a
commit 85fb669e5b
2 changed files with 6 additions and 76 deletions

View File

@ -54,39 +54,13 @@ main = defaultMain
-- bench "parser" $ nf parse bs
-- ]
-- ]
[ bgroup "Decoder"
[ env (pure dec) $ \p -> bench "datarow" $ nf (benchDataRowDecoder p) bs]
]
-- main = benchMultiPw
dec :: Decode (Maybe B.ByteString, Maybe Int32, Maybe Int32,
Maybe Int16, Maybe Bool, Maybe B.ByteString,
Maybe Bool, Maybe Bool, Maybe B.ByteString,
Maybe Int32, Maybe Int32, Maybe Int32)
dec = rowDecoder
parser = skipDataRowHeader *> p
where
p = (,,,,,,,,,,,)
<$> fn getByteString
<*> fn int4
<*> fn int4
<*> fn int2
<*> fn bool
<*> fn getByteString
<*> fn bool
<*> fn bool
<*> fn getByteString
<*> fn int4
<*> fn int4
<*> fn int4
fn = getNullable
benchDataRowDecoder d bs = decodeManyRows d $
DataRows (DataChunk 380 bs) Empty
where
decodeDataRow = do
(Header _ len) <- decodeHeader
getByteString len
-- benchDataRowDecoder d bs = decodeManyRows d $
-- DataRows (DataChunk 380 bs) Empty
-- where
-- decodeDataRow = do
-- (Header _ len) <- decodeHeader
-- getByteString len
{-# NOINLINE bs #-}
bs :: B.ByteString
@ -155,20 +129,12 @@ benchMultiPw = benchRequests createConnection $ \c -> do
sendBatchAndSync c [q]
d <- readNextData c
waitReadyForQuery c
-- case d of
-- Left _ -> undefined
-- Right rows -> pure $ decodeManyRows dec rows
where
q = Query largeStmt V.empty Binary Binary AlwaysCache
largeStmt = "SELECT * from _bytes_300_of_100"
-- largeStmt = "select typname, typnamespace, typowner, typlen, typbyval,"
-- <> "typcategory, typispreferred, typisdefined, typdelim,"
-- <> "typrelid, typelem, typarray from pg_type"
dec :: Decode (Maybe B.ByteString, Maybe Int32, Maybe Int32,
Maybe Int16, Maybe Bool, Maybe B.ByteString,
Maybe Bool, Maybe Bool, Maybe B.ByteString,
Maybe Int32, Maybe Int32, Maybe Int32)
dec = rowDecoder
benchLibpq :: IO ()
benchLibpq = benchRequests libpqConnection $ \c -> do

View File

@ -240,39 +240,3 @@ testCorrectDatarows = withConnection $ \c -> do
decodeHeader
getInt16BE
getByteString . fromIntegral =<< getInt32BE
testDecoder :: IO ()
testDecoder = withConnection $ \c -> do
let stmt = "SELECT '{{1,2},{Null,4}}'::int[][]"
sendBatchAndSync c [Query stmt V.empty Binary Binary NeverCache]
r <- readNextData c
waitReadyForQuery c
case r of
Left e -> error $ show e
Right rows -> do
-- print rows
print $ decodeManyRows dec rows
where
-- dec :: Decode (Int32, (Maybe Int32, Int32, Int32), Int32)
-- dec = rowDecoder
largeStmt = "select typname, typnamespace, typowner, typlen, typbyval,"
<> "typcategory, typispreferred, typisdefined, typdelim,"
<> "typrelid, typelem, typarray from pg_type"
-- dec :: Decode (Maybe B.ByteString, Maybe Int32, Maybe Int32,
-- Maybe Int16, Maybe Bool, Maybe B.ByteString,
-- Maybe Bool, Maybe Bool, Maybe B.ByteString,
-- Maybe Int32, Maybe Int32, Maybe Int32)
dec :: Decode (V.Vector (V.Vector (Maybe Int32)))
dec = rowDecoder
-- <$> fn getByteString
-- <*> fn int4
-- <*> fn int4
-- <*> fn int2
-- <*> fn bool
-- <*> fn getByteString
-- <*> fn bool
-- <*> fn bool
-- <*> fn getByteString
-- <*> fn int4
-- <*> fn int4
-- <*> fn int4