@@ -0,0 +1,52 @@
1+------------------------------------------------------------------------------
2+-- |
3+-- Module: Database.PostgreSQL.Simple.SqlQQ
4+-- Copyright: (c) 2011 Leon P Smith
5+-- License: BSD3
6+-- Maintainer: Leon P Smith <leon@melding-monads.com>
7+-- Stability: experimental
8+--
9+------------------------------------------------------------------------------
10+
11+module Database.PostgreSQL.Simple.SqlQQ (sql) where
12+
13+import Language.Haskell.TH
14+import Language.Haskell.TH.Quote
15+import Data.Char
16+
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
23+-- preserved as is.
24+
25+sql :: QuasiQuoter
26+sql = QuasiQuoter
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"
31+ , quoteExp = sqlExp
32+ , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
33+ \ quasiquoter used in declaration context"
34+ }
35+
36+sqlExp :: String -> Q Exp
37+sqlExp = stringE . outstring . dropSpace
38+ where
39+ dropSpace = dropWhile isSpace
40+
41+ outstring ('\'':xs) = '\'' : instring xs
42+ outstring (x:xs) | isSpace x = case dropSpace xs of
43+ [] -> []
44+ ys -> ' ' : outstring ys
45+ | otherwise = x : outstring xs
46+ outstring [] = []
47+
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"