-
Notifications
You must be signed in to change notification settings - Fork 71
/
SqlQQ.hs
76 lines (69 loc) · 3.01 KB
/
SqlQQ.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
------------------------------------------------------------------------------
-- |
-- Module: Database.PostgreSQL.Simple.SqlQQ
-- Copyright: (c) 2011-2012 Leon P Smith
-- License: BSD3
-- Maintainer: Leon P Smith <leon@melding-monads.com>
-- Stability: experimental
--
------------------------------------------------------------------------------
module Database.PostgreSQL.Simple.SqlQQ (sql) where
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Data.Char
-- | 'sql' is a quasiquoter that eases the syntactic burden
-- of writing big sql statements in Haskell source code. For example:
--
-- > {-# LANGUAGE QuasiQuotes #-}
-- >
-- > query conn [sql| SELECT column_a, column_b
-- > FROM table1 NATURAL JOIN table2
-- > WHERE ? <= time AND time < ?
-- > AND name LIKE ?
-- > ORDER BY size DESC
-- > LIMIT 100 |]
-- > (beginTime,endTime,string)
--
-- This quasiquoter attempts to mimimize whitespace; otherwise the
-- above query would consist of approximately half whitespace when sent
-- to the database backend.
--
-- The implementation of the whitespace reducer is currently incomplete.
-- Thus it can mess up your syntax in cases where whitespace should be
-- preserved as-is. It does preserve whitespace inside standard SQL string
-- literals. But it can get confused by the non-standard PostgreSQL string
-- literal syntax (which is the default setting in PostgreSQL 8 and below),
-- the extended escape string syntax, and other similar constructs.
--
-- Of course, this caveat only applies to text written inside the SQL
-- quasiquoter; whitespace reduction is a compile-time computation and
-- thus will not touch the @string@ parameter above, which is a run-time
-- value.
--
-- Also note that this will not work if the substring @|]@ is contained
-- in the query.
sql :: QuasiQuoter
sql = QuasiQuoter
{ quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
\ quasiquoter used in pattern context"
, quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
\ quasiquoter used in type context"
, quoteExp = sqlExp
, quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
\ quasiquoter used in declaration context"
}
sqlExp :: String -> Q Exp
sqlExp = stringE . outstring . dropSpace
where
dropSpace = dropWhile isSpace
outstring ('\'':xs) = '\'' : instring xs
outstring (x:xs) | isSpace x = case dropSpace xs of
[] -> []
ys -> ' ' : outstring ys
| otherwise = x : outstring xs
outstring [] = []
instring ('\'':'\'':xs) = '\'':'\'': instring xs
instring ('\'':xs) = '\'': outstring xs
instring (x:xs) = x : instring xs
instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
\ string literal not terminated"