    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 800
    {-# LANGUAGE TemplateHaskellQuotes #-}
    #else
    {-# LANGUAGE TemplateHaskell #-}
    #endif
    ------------------------------------------------------------------------------
    -- |
    -- 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 minimize 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
    sql = QuasiQuoter
        { quotePat :: String -> Q Pat
    quotePat  = String -> String -> Q Pat
    forall a. HasCallStack => String -> a
    error String
    "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in pattern context"
        , quoteType :: String -> Q Type
    quoteType = String -> String -> Q Type
    forall a. HasCallStack => String -> a
    error String
    "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in type context"
        , quoteExp :: String -> Q Exp
    quoteExp  = String -> Q Exp
    sqlExp
        , quoteDec :: String -> Q [Dec]
    quoteDec  = String -> String -> Q [Dec]
    forall a. HasCallStack => String -> a
    error String
    "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in declaration context"
        }

    sqlExp :: String -> Q Exp
    sqlExp :: String -> Q Exp
    sqlExp = Q Exp -> Q Exp -> Q Exp
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    appE [| fromString :: String -> Query |] (Q Exp -> Q Exp) -> (String -> Q Exp) -> String -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Q Exp
    forall (m :: * -> *). Quote m => String -> m Exp
    stringE (String -> Q Exp) -> (String -> String) -> String -> Q Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    minimizeSpace

    minimizeSpace :: String -> String
    minimizeSpace :: String -> String
    minimizeSpace = Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    1 (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    reduceSpace
      where
        needsReduced :: String -> Bool
    needsReduced []          = Bool
    False
        needsReduced (Char
    '-':Char
    '-':String
    _) = Bool
    True
        needsReduced (Char
    x:String
    _)       = Char -> Bool
    isSpace Char
    x

        reduceSpace :: String -> String
    reduceSpace String
    xs =
            case (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace String
    xs of
              [] -> []
              (Char
    '-':Char
    '-':String
    ys) -> String -> String
    reduceSpace ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') String
    ys)
              String
    ys -> Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    insql String
    ys

        insql :: String -> String
    insql (Char
    '\'':String
    xs)            = Char
    '\'' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    instring String
    xs
        insql String
    xs | String -> Bool
    needsReduced String
    xs = String -> String
    reduceSpace String
    xs
        insql (Char
    x:String
    xs)               = Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    insql String
    xs
        insql []                   = []

        instring :: String -> String
    instring (Char
    '\'':Char
    '\'':String
    xs) = Char
    '\''Char -> String -> String
    forall a. a -> [a] -> [a]
    :Char
    '\''Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    instring String
    xs
        instring (Char
    '\'':String
    xs)      = Char
    '\''Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    insql String
    xs
        instring (Char
    x:String
    xs)         = Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    instring String
    xs
        instring []             = String -> String
    forall a. HasCallStack => String -> a
    error String
    "Database.PostgreSQL.Simple.SqlQQ.sql: string literal not terminated"