From 4b77af102bdb3ba3ac97e092bfe5885972433540 Mon Sep 17 00:00:00 2001
From: eagletmt <eagletmt@gmail.com>
Date: Mon, 1 Apr 2013 15:55:29 +0900
Subject: [PATCH 1/2] Add a test case for checking QuasiQuotes module

---
 test/CheckSpec.hs | 8 +++++++-
 test/DebugSpec.hs | 3 +++
 test/data/Baz.hs  | 5 +++++
 test/data/Foo.hs  | 6 +++++-
 4 files changed, 20 insertions(+), 2 deletions(-)
 create mode 100644 test/data/Baz.hs

diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs
index 8c1bf70..c27cee5 100644
--- a/test/CheckSpec.hs
+++ b/test/CheckSpec.hs
@@ -3,7 +3,7 @@ module CheckSpec where
 import CabalApi
 import Check
 import Cradle
-import Data.List (isSuffixOf, isInfixOf)
+import Data.List (isSuffixOf, isInfixOf, isPrefixOf)
 import Expectation
 import Test.Hspec
 import Types
@@ -31,3 +31,9 @@ spec = do
                 cradle <- findCradle Nothing strVer
                 res <- checkSyntax defaultOptions cradle "Mutual1.hs"
                 res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
+
+        it "can check a module using QuasiQuotes" $ do
+            withDirectory_ "test/data" $ do
+                cradle <- getGHCVersion >>= findCradle Nothing . fst
+                res <- checkSyntax defaultOptions cradle "Baz.hs"
+                res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
diff --git a/test/DebugSpec.hs b/test/DebugSpec.hs
index 143ac8c..e348087 100644
--- a/test/DebugSpec.hs
+++ b/test/DebugSpec.hs
@@ -21,3 +21,6 @@ spec = do
             checkFast "Main.hs" "Fast check:          No"
             checkFast "Foo.hs"  "Fast check:          Yes"
             checkFast "Bar.hs"  "Fast check:          No"
+
+        it "can check QuasiQuotes" $ do
+            checkFast "Baz.hs"  "Fast check:          No"
diff --git a/test/data/Baz.hs b/test/data/Baz.hs
new file mode 100644
index 0000000..b199a24
--- /dev/null
+++ b/test/data/Baz.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Baz (baz) where
+import Foo (fooQ)
+
+baz = [fooQ| foo bar baz |]
diff --git a/test/data/Foo.hs b/test/data/Foo.hs
index 225c640..3b1bb2f 100644
--- a/test/data/Foo.hs
+++ b/test/data/Foo.hs
@@ -1,5 +1,9 @@
-module Foo (foo) where
+module Foo (foo, fooQ) where
 import Language.Haskell.TH
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
 
 foo :: ExpQ
 foo = stringE "foo"
+
+fooQ :: QuasiQuoter
+fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined

From e55e9561b51bd525cf5f97f8dc2053ba7f2aecf4 Mon Sep 17 00:00:00 2001
From: eagletmt <eagletmt@gmail.com>
Date: Mon, 1 Apr 2013 15:59:53 +0900
Subject: [PATCH 2/2] Disable fast check when QuasiQuotes is used

---
 Debug.hs  |  3 +--
 GHCApi.hs | 11 +++++++++--
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/Debug.hs b/Debug.hs
index b7280f6..2f28235 100644
--- a/Debug.hs
+++ b/Debug.hs
@@ -25,8 +25,7 @@ debug opt cradle ver fileName = do
     [fast] <- withGHC fileName $ do
         void $ initializeFlagsWithCradle opt cradle gopts True
         setTargetFile fileName
-        slow <- needsTemplateHaskell <$> depanal [] False
-        return [not slow]
+        pure . canCheckFast <$> depanal [] False
     return [
         "GHC version:         " ++ ver
       , "Current directory:   " ++ currentDir
diff --git a/GHCApi.hs b/GHCApi.hs
index 35d2529..da87ef7 100644
--- a/GHCApi.hs
+++ b/GHCApi.hs
@@ -7,6 +7,7 @@ module GHCApi (
   , getDynamicFlags
   , setSlowDynFlags
   , checkSlowAndSet
+  , canCheckFast
   ) where
 
 import CabalApi
@@ -128,8 +129,8 @@ setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags)
 -- So, this is necessary redundancy.
 checkSlowAndSet :: Ghc ()
 checkSlowAndSet = do
-    slow <- needsTemplateHaskell <$> depanal [] False
-    when slow setSlowDynFlags
+    fast <- canCheckFast <$> depanal [] False
+    unless fast setSlowDynFlags
 
 ----------------------------------------------------------------
 
@@ -150,3 +151,9 @@ setTargetFile file = do
 
 getDynamicFlags :: IO DynFlags
 getDynamicFlags = runGhc (Just libdir) getSessionDynFlags
+
+canCheckFast :: ModuleGraph -> Bool
+canCheckFast = not . any (hasTHorQQ . ms_hspp_opts)
+  where
+    hasTHorQQ :: DynFlags -> Bool
+    hasTHorQQ dflags = any (\opt -> xopt opt dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]