Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add a rudimentary SQL quasiquoter

  • Loading branch information...
commit 4451159ae6fb9ead3797d4a0362efbab1126f510 1 parent 1d5a622
@lpsmith authored
View
4 postgresql-simple.cabal
@@ -27,9 +27,10 @@ Library
Database.PostgreSQL.Simple.LargeObjects
Database.PostgreSQL.Simple.Notification
Database.PostgreSQL.Simple.Param
- Database.PostgreSQL.Simple.Result
Database.PostgreSQL.Simple.QueryParams
Database.PostgreSQL.Simple.QueryResults
+ Database.PostgreSQL.Simple.Result
+ Database.PostgreSQL.Simple.SqlQQ
Database.PostgreSQL.Simple.Types
-- Other-modules:
Database.PostgreSQL.Simple.Internal
@@ -45,6 +46,7 @@ Library
postgresql-libpq >= 0.6,
pcre-light,
old-locale,
+ template-haskell,
text >= 0.11.0.2,
time
-- Modules not exported by this package.
View
52 src/Database/PostgreSQL/Simple/SqlQQ.hs
@@ -0,0 +1,52 @@
+------------------------------------------------------------------------------
+-- |
+-- Module: Database.PostgreSQL.Simple.SqlQQ
+-- Copyright: (c) 2011 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. It attempts
+-- to minimize whitespace. Note that this implementation is incomplete
+-- and can mess up your syntax; it only really understands standard
+-- sql string literals (default in PostgreSQL 9) and not the extended
+-- escape syntax or other situations where white space should be
+-- preserved as is.
+
+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"
Please sign in to comment.
Something went wrong with that request. Please try again.