Checking TH to see if "-fno-code" can be used.

Cabal.hs

@@ -1,40 +1,24 @@
 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 
-module Cabal (initializeGHC, getDirs, fromCabal) where
+module Cabal (getDirs, fromCabal) where
 
 import CabalApi
 import Control.Applicative
 import Control.Exception
 import Control.Monad
-import CoreMonad
 import Data.List
 import Distribution.PackageDescription (BuildInfo(..), usedExtensions)
 import Distribution.Text (display)
-import ErrMsg
-import GHC
-import GHCApi
-import GHCChoice
 import System.Directory
 import System.FilePath
 import Types
 
 ----------------------------------------------------------------
 
-importDirs :: [String]
-importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
-
-initializeGHC :: Options -> FilePath -> [String] -> Bool -> Ghc LogReader
-initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
-  where
-    withoutCabal = do
-        logReader <- initSession opt ghcOptions importDirs Nothing logging
-        return logReader
-    withCabal = do
-        (gopts,idirs,depPkgs) <- liftIO $ fromCabal ghcOptions
-        logReader <- initSession opt gopts idirs (Just depPkgs) logging
-        return logReader
-
-fromCabal :: [String] -> IO ([String], [FilePath], [String])
+fromCabal :: [GHCOption] -> IO ([GHCOption]
+                               ,[IncludeDir]
+                               ,[Package]
+                               ,[LangExt])
 fromCabal ghcOptions = do
     (owdir,cdir,cfile) <- getDirs
     cabal <- cabalParseFile cfile
@@ -48,10 +32,11 @@ fromCabal ghcOptions = do
             []   -> [cdir,owdir]
             dirs -> map (cdir </>) dirs ++ [owdir]
     let depPkgs = removeMe cfile $ cabalAllDependPackages cabal
-    return (gopts,idirs,depPkgs)
+        hdrExts = cabalAllExtentions cabal
+    return (gopts,idirs,depPkgs,hdrExts)
 
 removeMe :: FilePath -> [String] -> [String]
-removeMe cabalfile depPkgs = filter (/= me) depPkgs
+removeMe cabalfile = filter (/= me)
   where
     me = dropExtension $ takeFileName cabalfile
 

CabalApi.hs

@@ -6,7 +6,7 @@ module CabalApi (
   ) where
 
 import Control.Applicative
-import Data.Maybe (fromJust, maybeToList, catMaybes)
+import Data.Maybe (fromJust, maybeToList, mapMaybe)
 import Data.Set (fromList, toList)
 import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
 import Distribution.PackageDescription
@@ -14,6 +14,7 @@ import Distribution.PackageDescription.Parse (readPackageDescription)
 import Distribution.Text (display)
 import Distribution.Verbosity (silent)
 import Language.Haskell.Extension (Extension(..))
+import Types
 
 ----------------------------------------------------------------
 
@@ -33,7 +34,7 @@ cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
 
 ----------------------------------------------------------------
 
-cabalAllDependPackages :: GenericPackageDescription -> [String]
+cabalAllDependPackages :: GenericPackageDescription -> [Package]
 cabalAllDependPackages pd = uniqueAndSort pkgs
   where
     pkgs = map getDependencyPackageName $ cabalAllDependency pd
@@ -44,20 +45,20 @@ cabalAllDependency = fromPackageDescription getDeps getDeps getDeps getDeps
     getDeps :: [Tree a] -> [Dependency]
     getDeps = concatMap condTreeConstraints
 
-getDependencyPackageName :: Dependency -> String
+getDependencyPackageName :: Dependency -> Package
 getDependencyPackageName (Dependency (PackageName nm) _) = nm
 
 ----------------------------------------------------------------
 
-cabalAllExtentions :: GenericPackageDescription -> [String]
+cabalAllExtentions :: GenericPackageDescription -> [LangExt]
 cabalAllExtentions pd = uniqueAndSort exts
   where
     buildInfos = cabalAllBuildInfos pd
     eexts = concatMap oldExtensions buildInfos
          ++ concatMap defaultExtensions buildInfos
-    exts  = catMaybes $ map getExtensionName eexts
+    exts  = mapMaybe getExtensionName eexts
 
-getExtensionName :: Extension -> Maybe String
+getExtensionName :: Extension -> Maybe LangExt
 getExtensionName (EnableExtension nm) = Just (display nm)
 getExtensionName _                    = Nothing
 

Check.hs

@@ -1,6 +1,5 @@
 module Check (checkSyntax) where
 
-import Cabal
 import Control.Applicative
 import CoreMonad
 import ErrMsg

GHCApi.hs

@@ -1,5 +1,6 @@
 module GHCApi where
 
+import Cabal
 import Control.Applicative
 import Control.Exception
 import CoreMonad
@@ -8,6 +9,8 @@ import ErrMsg
 import Exception
 import GHC
 import GHC.Paths (libdir)
+import GHCChoice
+import HeaderInfo
 import System.Exit
 import System.IO
 import Types
@@ -34,36 +37,65 @@ initSession0 :: Options -> Ghc [PackageId]
 initSession0 opt = getSessionDynFlags >>=
   (>>= setSessionDynFlags) . setGhcFlags opt
 
-initSession :: Options -> [String] -> [FilePath] -> Maybe [String] -> Bool -> Ghc LogReader
-initSession opt cmdOpts idirs mayPkgs logging = do
+----------------------------------------------------------------
+
+importDirs :: [IncludeDir]
+importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
+
+initializeGHC :: Options -> FilePath -> [GHCOption] -> Bool -> Ghc LogReader
+initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
+  where
+    withoutCabal = initSession opt ghcOptions importDirs Nothing Nothing logging fileName
+    withCabal = do
+        (gopts,idirs,depPkgs,hdrExts) <- liftIO $ fromCabal ghcOptions
+        initSession opt gopts idirs (Just depPkgs) (Just hdrExts) logging fileName
+
+initSession :: Options
+            -> [GHCOption]
+            -> [IncludeDir]
+            -> Maybe [Package]
+            -> Maybe [LangExt]
+            -> Bool
+            -> FilePath
+            -> Ghc LogReader
+initSession opt cmdOpts idirs mDepPkgs mLangExts logging file = do
     dflags <- getSessionDynFlags
-    let opts = map noLoc cmdOpts
+    hdrExts <- liftIO $ map unLoc <$> getOptionsFromFile dflags file
+    let th = useTemplateHaskell mLangExts hdrExts
+        opts = map noLoc cmdOpts
     (dflags',_,_) <- parseDynamicFlags dflags opts
     (dflags'',readLog) <- liftIO . (>>= setLogger logging)
-                          . setGhcFlags opt . setFlags opt dflags' idirs $ mayPkgs
+                          . setGhcFlags opt . setFlags opt dflags' idirs mDepPkgs $ th
     _ <- setSessionDynFlags dflags''
     return readLog
 
+useTemplateHaskell :: Maybe [LangExt] -> [HeaderExt] -> Bool
+useTemplateHaskell mLangExts hdrExts = th1 || th2
+  where
+    th1 = "-XTemplateHaskell" `elem` hdrExts
+    th2 = maybe False ("TemplateHaskell" `elem`) mLangExts
+
 ----------------------------------------------------------------
 
-setFlags :: Options -> DynFlags -> [FilePath] -> Maybe [String] -> DynFlags
-setFlags opt d idirs mayPkgs
+setFlags :: Options -> DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> DynFlags
+setFlags opt d idirs mDepPkgs th
   | expandSplice opt = dopt_set d' Opt_D_dump_splices
   | otherwise        = d'
   where
-    d' = maySetExpose $ d {
+    d' = addDevPkgs mDepPkgs $ d {
         importPaths = idirs
-      , ghcLink = LinkInMemory
-      , hscTarget = HscInterpreted
-      , flags = flags d
+      , ghcLink     = if th then LinkInMemory else NoLink
+      , hscTarget   = if th then HscInterpreted else HscNothing
+      , flags       = flags d
       }
-    -- Do hide-all only when depend packages specified
-    maySetExpose df = maybe df (\x -> (dopt_set df Opt_HideAllPackages) {
-                                   packageFlags = map ExposePackage x ++ packageFlags df
-                                   }) mayPkgs
 
-ghcPackage :: PackageFlag
-ghcPackage = ExposePackage "ghc"
+addDevPkgs :: Maybe [Package] -> DynFlags -> DynFlags
+addDevPkgs Nothing df     = df
+addDevPkgs (Just pkgs) df = df' {
+    packageFlags = map ExposePackage pkgs ++ packageFlags df
+  }
+  where
+    df' = dopt_set df Opt_HideAllPackages
 
 setGhcFlags :: Monad m => Options -> DynFlags -> m DynFlags
 setGhcFlags opt flagset =

Info.hs

@@ -3,7 +3,6 @@
 
 module Info (infoExpr, typeExpr) where
 
-import Cabal
 import Control.Applicative
 import CoreUtils
 import Data.Function
@@ -23,8 +22,8 @@ import NameSet
 import Outputable
 import PprTyThing
 import Pretty (showDocWith, Mode(OneLineMode))
-import TcRnTypes
 import TcHsSyn (hsPatType)
+import TcRnTypes
 import Types
 
 ----------------------------------------------------------------

Types.hs

@@ -61,3 +61,9 @@ quote x = "\"" ++ x ++ "\""
 
 addNewLine :: String -> String
 addNewLine = (++ "\n")
+
+type GHCOption  = String
+type IncludeDir = FilePath
+type Package    = String
+type LangExt    = String
+type HeaderExt  = String

test/CabalSpec.hs

@@ -19,5 +19,5 @@ spec = do
         it "obtains two directories and a cabal file" $ do
             len <- length <$> getCurrentDirectory
             withDirectory "test/data/subdir1/subdir2" $ do
-                (x,y,z) <- fromCabal []
-                (x, map (drop len) y, z) `shouldBe` (["-XHaskell98"],["/test/data","/test/data/subdir1/subdir2"],["Cabal","base","containers","convertible","directory","filepath","ghc","ghc-paths","ghc-syb-utils","hlint","hspec","io-choice","old-time","process","regex-posix","syb","time","transformers"])
+                (x,y,z,w) <- fromCabal []
+                (x, map (drop len) y, z, w) `shouldBe` (["-XHaskell98"],["/test/data","/test/data/subdir1/subdir2"],["Cabal","base","containers","convertible","directory","filepath","ghc","ghc-paths","ghc-syb-utils","hlint","hspec","io-choice","old-time","process","regex-posix","syb","time","transformers"], [])