Skip to content

Commit a2536fd

Browse files
Changed Vector to [] in Query and client messages
1 parent 2071eff commit a2536fd

File tree

8 files changed

+30
-36
lines changed

8 files changed

+30
-36
lines changed

bench/Codecs.hs

+2-3
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ import Data.ByteString (ByteString)
66
import Data.Monoid
77
import Data.Foldable
88
import System.IO.Unsafe
9-
import Data.Vector as V(fromList, empty)
109
import Criterion.Main
1110
import Data.Time
1211
import Data.UUID
@@ -82,7 +81,7 @@ encodeMessage params = runEncode $
8281
where
8382
bindMessage = Bind (PortalName "") stmtName Binary
8483
(encodedParams params) Binary
85-
encodedParams (a, b, c, d, e, f, g) = V.fromList
84+
encodedParams (a, b, c, d, e, f, g) =
8685
[ Just . runEncode $ PE.bool a
8786
, Just . runEncode $ PE.bytea b
8887
, Just . runEncode $ PE.float8 c
@@ -95,7 +94,7 @@ encodeMessage params = runEncode $
9594
stmtName = StatementName "_pw_statement_0010"
9695
stmt = StatementSQL
9796
"SELECT a, b, c FROM table_name WHERE name LIKE $1 AND a > $2"
98-
oids = V.fromList $ map PGT.oidType
97+
oids = map PGT.oidType
9998
[ PGT.bool
10099
, PGT.bytea
101100
, PGT.float8

src/Database/PostgreSQL/Driver/Query.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,7 @@ import Database.PostgreSQL.Driver.StatementStorage
3232
-- Public
3333
data Query = Query
3434
{ qStatement :: B.ByteString
35-
, qValues :: V.Vector (Oid, Maybe B.ByteString)
35+
, qValues :: [(Oid, Maybe B.ByteString)]
3636
, qParamsFormat :: Format
3737
, qResultFormat :: Format
3838
, qCachePolicy :: CachePolicy
@@ -126,7 +126,7 @@ describeStatement
126126
-> IO (Either Error (V.Vector Oid, V.Vector FieldDescription))
127127
describeStatement conn stmt = do
128128
sendEncode conn $
129-
encodeClientMessage (Parse sname (StatementSQL stmt) V.empty)
129+
encodeClientMessage (Parse sname (StatementSQL stmt) [])
130130
<> encodeClientMessage (DescribeStatement sname)
131131
<> encodeClientMessage Sync
132132
msgs <- collectUntilReadyForQuery conn

src/Database/PostgreSQL/Protocol/Encoders.hs

+2-3
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ module Database.PostgreSQL.Protocol.Encoders
66
import Data.Word (Word32)
77
import Data.Monoid ((<>))
88
import Data.Char (ord)
9-
import qualified Data.Vector as V
109
import qualified Data.ByteString as B
1110

1211
import Database.PostgreSQL.Protocol.Types
@@ -40,7 +39,7 @@ encodeClientMessage (Bind (PortalName portalName) (StatementName stmtName)
4039
-- `1` means that the specified format code is applied to all parameters
4140
putWord16BE 1 <>
4241
encodeFormat paramFormat <>
43-
putWord16BE (fromIntegral $ V.length values) <>
42+
putWord16BE (fromIntegral $ length values) <>
4443
foldMap encodeValue values <>
4544
-- `1` means that the specified format code is applied to all
4645
-- result columns (if any)
@@ -64,7 +63,7 @@ encodeClientMessage (Parse (StatementName stmtName) (StatementSQL stmt) oids)
6463
= prependHeader 'P' $
6564
putByteStringNull stmtName <>
6665
putByteStringNull stmt <>
67-
putWord16BE (fromIntegral $ V.length oids) <>
66+
putWord16BE (fromIntegral $ length oids) <>
6867
foldMap (putWord32BE . unOid) oids
6968
encodeClientMessage (PasswordMessage passtext)
7069
= prependHeader 'p' $ putByteStringNull $ getPassword passtext

src/Database/PostgreSQL/Protocol/Types.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -128,7 +128,7 @@ data AuthResponse
128128
data ClientMessage
129129
= Bind !PortalName !StatementName
130130
!Format -- parameter format code, one format for all
131-
!(Vector (Maybe ByteString)) -- the values of parameters, Nothing
131+
![Maybe ByteString] -- the values of parameters, Nothing
132132
-- is recognized as NULL
133133
!Format -- to apply code to all result columns
134134
-- Postgres use one command `close` for closing both statements and
@@ -141,7 +141,7 @@ data ClientMessage
141141
| DescribePortal !PortalName
142142
| Execute !PortalName !RowsToReceive
143143
| Flush
144-
| Parse !StatementName !StatementSQL !(Vector Oid)
144+
| Parse !StatementName !StatementSQL ![Oid]
145145
| PasswordMessage !PasswordText
146146
-- PostgreSQL names it `Query`
147147
| SimpleQuery !StatementSQL

tests/Codecs/QuickCheck.hs

+2-3
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@ import Data.UUID (UUID, fromWords)
1414
import Data.String (IsString)
1515
import qualified Data.ByteString as B
1616
import qualified Data.ByteString.Char8 as BC
17-
import qualified Data.Vector as V
1817

1918
import Database.PostgreSQL.Driver
2019
import Database.PostgreSQL.Protocol.DataRows
@@ -37,7 +36,7 @@ makeCodecProperty
3736
-> a -> Property
3837
makeCodecProperty c oid encoder fd v = monadicIO $ do
3938
let bs = runEncode $ encoder v
40-
q = Query "SELECT $1" (V.fromList [(oid, Just bs)])
39+
q = Query "SELECT $1" [(oid, Just bs)]
4140
Binary Binary AlwaysCache
4241
decoder = PD.dataRowHeader *> PD.getNonNullable fd
4342
r <- run $ do
@@ -60,7 +59,7 @@ makeCodecEncodeProperty
6059
-> a -> Property
6160
makeCodecEncodeProperty c oid queryString encoder fPrint v = monadicIO $ do
6261
let bs = runEncode $ encoder v
63-
q = Query queryString (V.fromList [(oid, Just bs)])
62+
q = Query queryString [(oid, Just bs)]
6463
Binary Text AlwaysCache
6564
decoder = PD.dataRowHeader *> PD.getNonNullable PD.bytea
6665
r <- run $ do

tests/Driver.hs

+14-15
Original file line numberDiff line numberDiff line change
@@ -45,12 +45,11 @@ testDriver = testGroup "Driver"
4545
]
4646

4747
makeQuery1 :: B.ByteString -> Query
48-
makeQuery1 n = Query "SELECT $1" (V.fromList [(Oid 23, Just n)])
49-
Text Text AlwaysCache
48+
makeQuery1 n = Query "SELECT $1" [(Oid 23, Just n)] Text Text AlwaysCache
5049

5150
makeQuery2 :: B.ByteString -> B.ByteString -> Query
5251
makeQuery2 n1 n2 = Query "SELECT $1 + $2"
53-
(V.fromList [(Oid 23, Just n1), (Oid 23, Just n2)]) Text Text AlwaysCache
52+
[(Oid 23, Just n1), (Oid 23, Just n2)] Text Text AlwaysCache
5453

5554
fromRight :: Either e a -> a
5655
fromRight (Right v) = v
@@ -108,12 +107,12 @@ testMultipleBatches = withConnection $ replicateM_ 10 . assertSingleBatch
108107
-- | Query is empty string.
109108
testEmptyQuery :: IO ()
110109
testEmptyQuery = assertQueryNoData $
111-
Query "" V.empty Text Text NeverCache
110+
Query "" [] Text Text NeverCache
112111

113112
-- | Query than returns no datarows.
114113
testQueryWithoutResult :: IO ()
115114
testQueryWithoutResult = assertQueryNoData $
116-
Query "SET client_encoding TO UTF8" V.empty Text Text NeverCache
115+
Query "SET client_encoding TO UTF8" [] Text Text NeverCache
117116

118117
-- | Asserts that query returns no data rows.
119118
assertQueryNoData :: Query -> IO ()
@@ -141,9 +140,9 @@ checkInvalidResult conn n = readNextData conn >>=
141140
testInvalidBatch :: IO ()
142141
testInvalidBatch = do
143142
let rightQuery = makeQuery1 "5"
144-
q1 = Query "SEL $1" (V.fromList [(Oid 23, Just "5")]) Text Text NeverCache
145-
q2 = Query "SELECT $1" (V.fromList [(Oid 23, Just "a")]) Text Text NeverCache
146-
q4 = Query "SELECT $1" (V.fromList []) Text Text NeverCache
143+
q1 = Query "SEL $1" [(Oid 23, Just "5")] Text Text NeverCache
144+
q2 = Query "SELECT $1" [(Oid 23, Just "a")] Text Text NeverCache
145+
q4 = Query "SELECT $1" [] Text Text NeverCache
147146

148147
assertInvalidBatch "Parse error" [q1]
149148
assertInvalidBatch "Invalid param" [ q2]
@@ -162,7 +161,7 @@ testValidAfterError :: IO ()
162161
testValidAfterError = withConnection $ \c -> do
163162
let a = "5"
164163
rightQuery = makeQuery1 a
165-
invalidQuery = Query "SELECT $1" (V.fromList []) Text Text NeverCache
164+
invalidQuery = Query "SELECT $1" [] Text Text NeverCache
166165
sendBatchAndSync c [invalidQuery]
167166
checkInvalidResult c 1
168167
waitReadyForQuery c
@@ -186,15 +185,15 @@ testDescribeStatement = withConnectionCommon $ \c -> do
186185
testDescribeStatementNoData :: IO ()
187186
testDescribeStatementNoData = withConnectionCommon $ \c -> do
188187
r <- fromRight <$> describeStatement c "SET client_encoding TO UTF8"
189-
assertBool "Should be empty" $ V.null (fst r)
190-
assertBool "Should be empty" $ V.null (snd r)
188+
assertBool "Should be empty" $ null (fst r)
189+
assertBool "Should be empty" $ null (snd r)
191190

192191
-- | Describes statement that is empty string.
193192
testDescribeStatementEmpty :: IO ()
194193
testDescribeStatementEmpty = withConnectionCommon $ \c -> do
195194
r <- fromRight <$> describeStatement c ""
196-
assertBool "Should be empty" $ V.null (fst r)
197-
assertBool "Should be empty" $ V.null (snd r)
195+
assertBool "Should be empty" $ null (fst r)
196+
assertBool "Should be empty" $ null (snd r)
198197

199198
-- | Query using simple query protocol.
200199
testSimpleQuery :: IO ()
@@ -231,7 +230,7 @@ testPreparedStatementCache = withConnection $ \c -> do
231230
-- | Test that large responses are properly handled
232231
testLargeQuery :: IO ()
233232
testLargeQuery = withConnection $ \c -> do
234-
sendBatchAndSync c [Query largeStmt V.empty Text Text NeverCache ]
233+
sendBatchAndSync c [Query largeStmt [] Text Text NeverCache ]
235234
r <- readNextData c
236235
waitReadyForQuery c
237236
assertBool "Should be Right" $ isRight r
@@ -243,7 +242,7 @@ testLargeQuery = withConnection $ \c -> do
243242
testCorrectDatarows :: IO ()
244243
testCorrectDatarows = withConnection $ \c -> do
245244
let stmt = "SELECT * FROM generate_series(1, 1000)"
246-
sendBatchAndSync c [Query stmt V.empty Text Text NeverCache]
245+
sendBatchAndSync c [Query stmt [] Text Text NeverCache]
247246
r <- readNextData c
248247
case r of
249248
Left e -> error $ show e

tests/Fault.hs

+1-2
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@ import Data.Maybe
77
import Data.Either
88
import qualified Data.ByteString as B
99
import qualified Data.ByteString.Char8 as BS
10-
import qualified Data.Vector as V
1110
import System.Socket (SocketException(..))
1211
import System.Mem.Weak (Weak, deRefWeak)
1312
import Control.Concurrent (throwTo, threadDelay, killThread)
@@ -27,7 +26,7 @@ import Database.PostgreSQL.Protocol.Types
2726
import Connection
2827

2928
longQuery :: Query
30-
longQuery = Query "SELECT pg_sleep(5)" V.empty Text Text NeverCache
29+
longQuery = Query "SELECT pg_sleep(5)" [] Text Text NeverCache
3130

3231
testFaults :: TestTree
3332
testFaults = testGroup "Faults"

tests/Protocol.hs

+5-6
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@ module Protocol where
33
import Data.Monoid ((<>))
44
import Data.Foldable
55
import Control.Monad
6-
import qualified Data.Vector as V
76

87
import Test.Tasty
98
import Test.Tasty.HUnit
@@ -49,9 +48,9 @@ testExtendedQuery = withConnectionCommonAll $ \c -> do
4948
sname = StatementName "statement"
5049
pname = PortalName "portal"
5150
statement = StatementSQL "SELECT $1 + $2"
52-
sendMessage rawConn $ Parse sname statement (V.fromList [Oid 23, Oid 23])
51+
sendMessage rawConn $ Parse sname statement [Oid 23, Oid 23]
5352
sendMessage rawConn $
54-
Bind pname sname Text (V.fromList [Just "1", Just "2"]) Text
53+
Bind pname sname Text [Just "1", Just "2"] Text
5554
sendMessage rawConn $ Execute pname noLimitToReceive
5655
sendMessage rawConn $ DescribeStatement sname
5756
sendMessage rawConn $ DescribePortal pname
@@ -93,9 +92,9 @@ testExtendedEmptyQuery = withConnectionCommonAll $ \c -> do
9392
sname = StatementName "statement"
9493
pname = PortalName ""
9594
statement = StatementSQL ""
96-
sendMessage rawConn $ Parse sname statement V.empty
95+
sendMessage rawConn $ Parse sname statement []
9796
sendMessage rawConn $
98-
Bind pname sname Text V.empty Text
97+
Bind pname sname Text [] Text
9998
sendMessage rawConn $ Execute pname noLimitToReceive
10099
sendMessage rawConn Sync
101100
msgs <- collectUntilReadyForQuery c
@@ -112,7 +111,7 @@ testExtendedQueryNoData = withConnectionCommonAll $ \c -> do
112111
let rawConn = connRawConnection c
113112
sname = StatementName "statement"
114113
statement = StatementSQL "SET client_encoding to UTF8"
115-
sendMessage rawConn $ Parse sname statement V.empty
114+
sendMessage rawConn $ Parse sname statement []
116115
sendMessage rawConn $ DescribeStatement sname
117116
sendMessage rawConn Sync
118117

0 commit comments

Comments
 (0)