Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
90 lines (81 sloc) 3.5 KB
{-# LANGUAGE TemplateHaskell #-}
------------------------------------------------------------------------------
-- |
-- 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 Database.PostgreSQL.Simple.Types (Query)
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Data.Char
import Data.String
-- | '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 returns a literal string expression of type 'Query',
-- and attempts to mimimize whitespace; otherwise the above query would
-- consist of approximately half whitespace when sent to the database
-- backend. It also recognizes and strips out standard sql comments "--".
--
-- 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, quoted identifiers, 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 = appE [| fromString :: String -> Query |] . stringE . minimizeSpace
minimizeSpace :: String -> String
minimizeSpace = drop 1 . reduceSpace
where
needsReduced [] = False
needsReduced ('-':'-':_) = True
needsReduced (x:_) = isSpace x
reduceSpace xs =
case dropWhile isSpace xs of
[] -> []
('-':'-':ys) -> reduceSpace (dropWhile (/= '\n') ys)
ys -> ' ' : insql ys
insql ('\'':xs) = '\'' : instring xs
insql xs | needsReduced xs = reduceSpace xs
insql (x:xs) = x : insql xs
insql [] = []
instring ('\'':'\'':xs) = '\'':'\'': instring xs
instring ('\'':xs) = '\'': insql xs
instring (x:xs) = x : instring xs
instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
\ string literal not terminated"
Something went wrong with that request. Please try again.