content: {-# 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"
  