@@ -1,4 +1,9 @@
1−{-# LANGUAGE DeriveDataTypeable, RecordWildCards, NamedFieldPuns #-}
1+{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE NamedFieldPuns #-}
3+{-# LANGUAGE OverloadedStrings #-}
4+{-# LANGUAGE PatternGuards #-}
5+{-# LANGUAGE RecordWildCards #-}
6+{-# LANGUAGE ViewPatterns #-}
27
38------------------------------------------------------------------------------
49-- |
@@ -131,7 +136,6 @@ import Database.PostgreSQL.Simple.Types
131136 ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )
132137import Database.PostgreSQL.Simple.Internal as Base
133138import qualified Database.PostgreSQL.LibPQ as PQ
134−import Text.Regex.PCRE.Light (compile, caseless, match)
135139import qualified Data.ByteString.Char8 as B
136140import qualified Data.Text as T
137141import qualified Data.Text.Encoding as TE
@@ -182,18 +186,108 @@ formatQuery conn q@(Query template) qs
182186formatMany :: (ToRow q) => Connection -> Query -> [q] -> IO ByteString
183187formatMany _ q [] = fmtError "no rows supplied" q []
184188formatMany conn q@(Query template) qs = do
185− case match re template [] of
186− Just [_,before,qbits,after] -> do
189+ case parseTemplate template of
190+ Just (before, qbits, after) -> do
187191 bs <- mapM (buildQuery conn q qbits . toRow) qs
188192 return . toByteString . mconcat $ fromByteString before :
189193 intersperse (fromChar ',') bs ++
190194 [fromByteString after]
191− _ -> error "foo"
195+ Nothing -> fmtError "syntax error in query template for executeMany" q []
196+
197+-- Split the input string into three pieces, @before@, @qbits@, and @after@,
198+-- following this grammar:
199+--
200+-- start: ^ before qbits after $
201+-- before: ([^?]* [^?\w])? 'VALUES' \s*
202+-- qbits: '(' \s* '?' \s* (',' \s* '?' \s*)* ')'
203+-- after: [^?]*
204+--
205+-- \s: [ \t\n\r\f]
206+-- \w: [A-Z] | [a-z] | [\x80-\xFF] | '_' | '$' | [0-9]
207+--
208+-- This would be much more concise with some sort of regex engine.
209+-- 'formatMany' used to use pcre-light instead of this hand-written parser,
210+-- but pcre is a hassle to install on Windows.
211+parseTemplate :: ByteString -> Maybe (ByteString, ByteString, ByteString)
212+parseTemplate template =
213+ -- Convert input string to uppercase, to facilitate searching.
214+ search $ B.map toUpper_ascii template
192215 where
193− re = compile "^([^?]+\\bvalues\\s*)\
194− \(\\(\\s*[?](?:\\s*,\\s*[?])*\\s*\\))\
195− \([^?]*)$"
196− [caseless]
216+ -- Search for the next occurrence of "VALUES"
217+ search bs =
218+ case B.breakSubstring "VALUES" bs of
219+ (x, y)
220+ -- If "VALUES" is not present in the string, or any '?' characters
221+ -- were encountered prior to it, fail.
222+ | B.null y || ('?' `B.elem` x)
223+ -> Nothing
224+
225+ -- If "VALUES" is preceded by an identifier character (a.k.a. \w),
226+ -- try the next occurrence.
227+ | not (B.null x) && isIdent (B.last x)
228+ -> search $ B.drop 6 y
229+
230+ -- Otherwise, we have a legitimate "VALUES" token.
231+ | otherwise
232+ -> parseQueryBits $ skipSpace $ B.drop 6 y
233+
234+ -- Parse '(' \s* '?' \s* . If this doesn't match
235+ -- (and we don't consume a '?'), look for another "VALUES".
236+ --
237+ -- qb points to the open paren (if present), meaning it points to the
238+ -- beginning of the "qbits" production described above. This is why we
239+ -- pass it down to finishQueryBits.
240+ parseQueryBits qb
241+ | Just ('(', skipSpace -> bs1) <- B.uncons qb
242+ , Just ('?', skipSpace -> bs2) <- B.uncons bs1
243+ = finishQueryBits qb bs2
244+ | otherwise
245+ = search qb
246+
247+ -- Parse (',' \s* '?' \s*)* ')' [^?]* .
248+ --
249+ -- Since we've already consumed at least one '?', there's no turning back.
250+ -- The parse has to succeed here, or the whole thing fails
251+ -- (because we don't allow '?' to appear outside of the VALUES list).
252+ finishQueryBits qb bs0
253+ | Just (')', bs1) <- B.uncons bs0
254+ = if '?' `B.elem` bs1
255+ then Nothing
256+ else Just $ slice3 template qb bs1
257+ | Just (',', skipSpace -> bs1) <- B.uncons bs0
258+ , Just ('?', skipSpace -> bs2) <- B.uncons bs1
259+ = finishQueryBits qb bs2
260+ | otherwise
261+ = Nothing
262+
263+ -- Slice a string into three pieces, given the start offset of the second
264+ -- and third pieces. Each "offset" is actually a tail of the uppercase
265+ -- version of the template string. Its length is used to infer the offset.
266+ --
267+ -- It is important to note that we only slice the original template.
268+ -- We don't want our all-caps trick messing up the actual query string.
269+ slice3 source p1 p2 =
270+ (s1, s2, source'')
271+ where
272+ (s1, source') = B.splitAt (B.length source - B.length p1) source
273+ (s2, source'') = B.splitAt (B.length p1 - B.length p2) source'
274+
275+ toUpper_ascii c | c >= 'a' && c <= 'z' = toEnum (fromEnum c - 32)
276+ | otherwise = c
277+
278+ -- Based on the definition of {ident_cont} in src/backend/parser/scan.l
279+ -- in the PostgreSQL source. No need to check [a-z], since we converted
280+ -- the whole string to uppercase.
281+ isIdent c = (c >= '0' && c <= '9')
282+ || (c >= 'A' && c <= 'Z')
283+ || (c >= '\x80' && c <= '\xFF')
284+ || c == '_'
285+ || c == '$'
286+
287+ -- Based on {space} in scan.l
288+ isSpace_ascii c = (c == ' ') || (c >= '\t' && c <= '\r')
289+
290+ skipSpace = B.dropWhile isSpace_ascii
197291
198292escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
199293escapeStringConn conn s =