@@ -29,14 +29,16 @@ import Data.Char
30-- This quasiquoter attempts to mimimize whitespace; otherwise the
30-- This quasiquoter attempts to mimimize whitespace; otherwise the
31-- above query would consist of approximately half whitespace when sent
31-- above query would consist of approximately half whitespace when sent
32−-- to the database backend.
32+-- to the database backend. It also recognizes and strips out standard
34-- The implementation of the whitespace reducer is currently incomplete.
35-- The implementation of the whitespace reducer is currently incomplete.
35-- Thus it can mess up your syntax in cases where whitespace should be
36-- Thus it can mess up your syntax in cases where whitespace should be
36-- preserved as-is. It does preserve whitespace inside standard SQL string
37-- preserved as-is. It does preserve whitespace inside standard SQL string
37-- literals. But it can get confused by the non-standard PostgreSQL string
38-- literals. But it can get confused by the non-standard PostgreSQL string
38-- literal syntax (which is the default setting in PostgreSQL 8 and below),
39-- literal syntax (which is the default setting in PostgreSQL 8 and below),
39−-- the extended escape string syntax, and other similar constructs.
40+-- the extended escape string syntax, quoted identifiers, and other similar
41-- Of course, this caveat only applies to text written inside the SQL
43-- Of course, this caveat only applies to text written inside the SQL
42-- quasiquoter; whitespace reduction is a compile-time computation and
44-- quasiquoter; whitespace reduction is a compile-time computation and
@@ -58,19 +60,28 @@ sql = QuasiQuoter
60sqlExp :: String -> Q Exp
62sqlExp :: String -> Q Exp
61−sqlExp = stringE . outstring . dropSpace
63+sqlExp = stringE . minimizeSpace
65+minimizeSpace :: String -> String
66+minimizeSpace = drop 1 . reduceSpace
68+ needsReduced [] = False
69+ needsReduced ('-':'-':_) = True
70+ needsReduced (x:_) = isSpace x
63− dropSpace = dropWhile isSpace
73+ case dropWhile isSpace xs of
75+ ('-':'-':ys) -> reduceSpace (dropWhile (/= '\n') ys)
65− outstring ('\'':xs) = '\'' : instring xs
78+ insql ('\'':xs) = '\'' : instring xs
66− outstring (x:xs) | isSpace x = case dropSpace xs of
79+ insql xs | needsReduced xs = reduceSpace xs
67− [] -> []
80+ insql (x:xs) = x : insql xs
68− ys -> ' ' : outstring ys
81+ insql [] = []
69− | otherwise = x : outstring xs
72 instring ('\'':'\'':xs) = '\'':'\'': instring xs
83 instring ('\'':'\'':xs) = '\'':'\'': instring xs
73− instring ('\'':xs) = '\'': outstring xs
84+ instring ('\'':xs) = '\'': insql xs
74 instring (x:xs) = x : instring xs
85 instring (x:xs) = x : instring xs
75 instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
86 instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
76 \ string literal not terminated"
87 \ string literal not terminated"