@@ -0,0 +1,52 @@
1+------------------------------------------------------------------------------
3+-- Module: Database.PostgreSQL.Simple.SqlQQ
4+-- Copyright: (c) 2011 Leon P Smith
6+-- Maintainer: Leon P Smith <leon@melding-monads.com>
7+-- Stability: experimental
9+------------------------------------------------------------------------------
11+module Database.PostgreSQL.Simple.SqlQQ (sql) where
13+import Language.Haskell.TH
14+import Language.Haskell.TH.Quote
17+-- | 'sql' is a quasiquoter that eases the syntactic burden
18+-- of writing big sql statements in Haskell source code. It attempts
19+-- to minimize whitespace. Note that this implementation is incomplete
20+-- and can mess up your syntax; it only really understands standard
21+-- sql string literals (default in PostgreSQL 9) and not the extended
22+-- escape syntax or other situations where white space should be
27+ { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
28+ \ quasiquoter used in pattern context"
29+ , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
30+ \ quasiquoter used in type context"
32+ , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
33+ \ quasiquoter used in declaration context"
36+sqlExp :: String -> Q Exp
37+sqlExp = stringE . outstring . dropSpace
39+ dropSpace = dropWhile isSpace
41+ outstring ('\'':xs) = '\'' : instring xs
42+ outstring (x:xs) | isSpace x = case dropSpace xs of
44+ ys -> ' ' : outstring ys
45+ | otherwise = x : outstring xs
48+ instring ('\'':'\'':xs) = '\'':'\'': instring xs
49+ instring ('\'':xs) = '\'': outstring xs
50+ instring (x:xs) = x : instring xs
51+ instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
52+ \ string literal not terminated"