diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,11 @@
 # Changelog for persistent-qq
 
+## 2.12.0.4
+
+* Improve compile-time performance of generated code, especially when building with -O2.
+  Previously, the test suite took 1:16 to build with -O2, and after this patch,
+  it only takes 5s. [#1434](https://github.com/yesodweb/persistent/pull/1434)
+
 ## 2.12.0.3
 
 * Require `persistent-2.14` in tests
diff --git a/persistent-qq.cabal b/persistent-qq.cabal
--- a/persistent-qq.cabal
+++ b/persistent-qq.cabal
@@ -1,6 +1,6 @@
 cabal-version: 1.12
 name:           persistent-qq
-version:        2.12.0.3
+version:        2.12.0.4
 synopsis:       Provides a quasi-quoter for raw SQL for persistent
 description:    Please see README and API docs at <http://www.stackage.org/package/persistent>.
 category:       Database, Yesod
@@ -43,6 +43,7 @@
       PersistentTestModels
       PersistTestPetCollarType
       PersistTestPetType
+      CodeGenTest
   hs-source-dirs:
       test
   ghc-options: -Wall
diff --git a/src/Database/Persist/Sql/Raw/QQ.hs b/src/Database/Persist/Sql/Raw/QQ.hs
--- a/src/Database/Persist/Sql/Raw/QQ.hs
+++ b/src/Database/Persist/Sql/Raw/QQ.hs
@@ -34,7 +34,9 @@
 import           Data.List.NonEmpty (NonEmpty(..), (<|))
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.List as List
-import Data.Text (Text, pack, unpack, intercalate)
+import Data.Text (Text)
+import qualified Data.Text as Text
+import Data.List (replicate, intercalate)
 import Data.Maybe (fromMaybe, Maybe(..))
 import Data.Monoid (mempty, (<>))
 import qualified Language.Haskell.TH as TH
@@ -90,19 +92,20 @@
 parseStr a ('*':'{':xs) = Literal (reverse a) : parseHaskell Rows       [] xs
 parseStr a ('^':'{':xs) = Literal (reverse a) : parseHaskell TableName  [] xs
 parseStr a ('@':'{':xs) = Literal (reverse a) : parseHaskell ColumnName [] xs
+parseStr a (' ':' ': xs)= parseStr a (' ' : xs)
+parseStr a ('\n' : xs)  = parseStr a xs
 parseStr a (x:xs)       = parseStr (x:a) xs
 
-interpolateValues :: PersistField a => NonEmpty a -> (Text, [[PersistValue]]) -> (Text, [[PersistValue]])
+interpolateValues :: PersistField a => NonEmpty a -> (String, [[PersistValue]]) -> (String, [[PersistValue]])
 interpolateValues xs =
     first (mkPlaceholders values <>) .
     second (NonEmpty.toList values :)
   where
     values = NonEmpty.map toPersistValue xs
 
-interpolateRows :: ToRow a => NonEmpty a -> (Text, [[PersistValue]]) -> (Text, [[PersistValue]])
-interpolateRows xs =
-    first (placeholders <>)
-  . second (values :)
+interpolateRows :: ToRow a => NonEmpty a -> (String, [[PersistValue]]) -> (String, [[PersistValue]])
+interpolateRows xs (sql, vals) =
+    (placeholders <> sql, values : vals)
   where
     rows :: NonEmpty (NonEmpty PersistValue)
     rows = NonEmpty.map toRow xs
@@ -111,66 +114,37 @@
     placeholders = n `timesCommaSeparated` mkPlaceholders (NonEmpty.head rows)
     values = List.concatMap NonEmpty.toList $ NonEmpty.toList rows
 
-mkPlaceholders :: NonEmpty a -> Text
+mkPlaceholders :: NonEmpty a -> String
 mkPlaceholders values = "(" <> n `timesCommaSeparated` "?" <> ")"
   where
     n = NonEmpty.length values
 
-timesCommaSeparated :: Int -> Text -> Text
+timesCommaSeparated :: Int -> String -> String
 timesCommaSeparated n = intercalate "," . replicate n
 
 makeExpr :: TH.ExpQ -> [Token] -> TH.ExpQ
 makeExpr fun toks = do
-    TH.infixE
-        (Just [| uncurry $(fun) . second concat |])
-        ([| (=<<) |])
-        (Just $ go toks)
-
+    [| do
+        (sql, vals) <- $(go toks)
+        $(fun) (Text.pack sql) (concat vals) |]
   where
     go :: [Token] -> TH.ExpQ
-    go [] = [| return (mempty, []) |]
+    go [] =
+        [| return (mempty :: String, []) |]
     go (Literal a:xs) =
-        TH.appE
-            [| fmap $ first (pack a <>) |]
-            (go xs)
-    go (Value a:xs) =
-        TH.appE
-            [| fmap $ first ("?" <>) . second ([toPersistValue $(reifyExp a)] :) |]
-            (go xs)
+        [| first (a <>) <$> $(go xs) |]
+    go (Value a:xs) = do
+        [| (\(str, vals) -> ("?" <> str, [toPersistValue $(reifyExp a)] : vals)) <$> ($(go xs)) |]
     go (Values a:xs) =
-        TH.appE
-            [| fmap $ interpolateValues $(reifyExp a) |]
-            (go xs)
+        [| interpolateValues $(reifyExp a) <$> $(go xs) |]
     go (Rows a:xs) =
-        TH.appE
-            [| fmap $ interpolateRows $(reifyExp a) |]
-            (go xs)
-    go (ColumnName a:xs) = do
-        colN <- TH.newName "field"
-        TH.infixE
-            (Just [| getFieldName $(reifyExp a) |])
-            [| (>>=) |]
-            (Just $ TH.lamE [ TH.varP colN ] $
-                TH.appE
-                    [| fmap $ first ($(TH.varE colN) <>) |]
-                    (go xs))
+        [| interpolateRows $(reifyExp a) <$> $(go xs) |]
+    go (ColumnName a:xs) =
+        [| getFieldName $(reifyExp a) >>= \field ->
+            first (Text.unpack field <>) <$> $(go xs) |]
     go (TableName a:xs) = do
-        typeN <- TH.lookupTypeName a >>= \case
-                Just t  -> return t
-                Nothing -> fail $ "Type not in scope: " ++ show a
-        tableN <- TH.newName "table"
-        TH.infixE
-            (Just $
-                TH.appE
-                    [| getTableName |]
-                    (TH.sigE
-                        [| error "record" |] $
-                        (TH.conT typeN)))
-            [| (>>=) |]
-            (Just $ TH.lamE [ TH.varP tableN ] $
-                TH.appE
-                    [| fmap $ first ($(TH.varE tableN) <>) |]
-                    (go xs))
+        [| getTableName (error "record" :: $(TH.conT (TH.mkName a))) >>= \table ->
+            first (Text.unpack table <>) <$> $(go xs) |]
 
 reifyExp :: String -> TH.Q TH.Exp
 reifyExp s =
diff --git a/test/CodeGenTest.hs b/test/CodeGenTest.hs
new file mode 100644
--- /dev/null
+++ b/test/CodeGenTest.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module CodeGenTest (query0, spec) where
+
+import Database.Persist.Sql
+import Test.Hspec
+import Database.Persist.Sql.Raw.QQ
+import PersistentTestModels
+import Control.Monad.Logger (LoggingT)
+import Control.Monad.Trans.Resource
+import Data.Text (Text)
+import Control.Monad.Reader
+
+spec :: (forall a. SqlPersistT (LoggingT (ResourceT IO)) a -> IO a) -> Spec
+spec db = describe "CodeGenTest" $ do
+    it "works" $ do
+        _ <- db $ mapReaderT liftIO query0
+        pure ()
+
+query0 :: SqlPersistT IO [(Single Text, Single Int, Single (Maybe Text))]
+query0 = --
+    [sqlQQ|
+        select
+            ^{Person}.@{PersonName}, ^{Person}.@{PersonAge}, ^{Person}.@{PersonColor}
+        from ^{Person}
+        where @{PersonAge} =
+            #{int} +
+            #{int} +
+            #{int} +
+            #{int} +
+            #{int} +
+            #{int} +
+                0
+    |]
+  where
+    int = 1 :: Int
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -19,6 +19,7 @@
 import Database.Persist.Sqlite
 import PersistTestPetType
 import PersistentTestModels
+import qualified CodeGenTest
 
 main :: IO ()
 main = hspec spec
@@ -40,6 +41,7 @@
 
 spec :: Spec
 spec = describe "persistent-qq" $ do
+    CodeGenTest.spec db
     it "sqlQQ/?-?" $ db $ do
         ret <- [sqlQQ| SELECT #{2 :: Int}+#{2 :: Int} |]
         liftIO $ ret @?= [Single (4::Int)]