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] 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