Merge pull request #115 from eagletmt/quasi-quotes

Fix fast check about QuasiQuotes

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

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]

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`)

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"

test/data/Baz.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+module Baz (baz) where
+import Foo (fooQ)
+
+baz = [fooQ| foo bar baz |]

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